diff options
author | Ludovic Courtès <ludo@gnu.org> | 2013-06-13 22:03:42 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2013-06-13 22:03:42 +0200 |
commit | 3f1e69395cbfaad80710bdfbef433c26aa216271 (patch) | |
tree | 4937f847fc6c22f5595f6d75d9e7b1f15cbf8a7c | |
parent | d4c748607995bec8a13f058bdeba89e41ff6539c (diff) | |
download | guix-3f1e69395cbfaad80710bdfbef433c26aa216271.tar.gz guix-3f1e69395cbfaad80710bdfbef433c26aa216271.zip |
store: Add `requisites'.
* guix/store.scm (fold-path, requisites): New procedures.
* tests/store.scm ("requisites"): New test.
-rw-r--r-- | guix/store.scm | 26 | ||||
-rw-r--r-- | tests/store.scm | 18 |
2 files changed, 44 insertions, 0 deletions
diff --git a/guix/store.scm b/guix/store.scm index d15ba1275f..57e1ca06aa 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -31,6 +31,7 @@ #:use-module (srfi srfi-39) #:use-module (ice-9 match) #:use-module (ice-9 regex) + #:use-module (ice-9 vlist) #:export (%daemon-socket-file nix-server? @@ -70,6 +71,7 @@ substitutable-path-info references + requisites referrers valid-derivers query-derivation-outputs @@ -493,6 +495,30 @@ file name. Return #t on success." "Return the list of references of PATH." store-path-list)) +(define* (fold-path store proc seed path + #:optional (relatives (cut references store <>))) + "Call PROC for each of the RELATIVES of PATH, exactly once, and return the +result formed from the successive calls to PROC, the first of which is passed +SEED." + (let loop ((paths (list path)) + (result seed) + (seen vlist-null)) + (match paths + ((path rest ...) + (if (vhash-assoc path seen) + (loop rest result seen) + (let ((seen (vhash-cons path #t seen)) + (rest (append rest (relatives path))) + (result (proc path result))) + (loop rest result seen)))) + (() + result)))) + +(define (requisites store path) + "Return the requisites of PATH, including PATH---i.e., its closure (all its +references, recursively)." + (fold-path store cons '() path)) + (define referrers (operation (query-referrers (store-path path)) "Return the list of path that refer to PATH." diff --git a/tests/store.scm b/tests/store.scm index c0126ce335..b42bc97017 100644 --- a/tests/store.scm +++ b/tests/store.scm @@ -106,6 +106,24 @@ (null? (references %store t1)) (null? (referrers %store t2))))) +(test-assert "requisites" + (let* ((t1 (add-text-to-store %store "random1" + (random-text) '())) + (t2 (add-text-to-store %store "random2" + (random-text) (list t1))) + (t3 (add-text-to-store %store "random3" + (random-text) (list t2))) + (t4 (add-text-to-store %store "random4" + (random-text) (list t1 t3)))) + (define (same? x y) + (and (= (length x) (length y)) + (lset= equal? x y))) + + (and (same? (requisites %store t1) (list t1)) + (same? (requisites %store t2) (list t1 t2)) + (same? (requisites %store t3) (list t1 t2 t3)) + (same? (requisites %store t4) (list t1 t2 t3 t4))))) + (test-assert "derivers" (let* ((b (add-text-to-store %store "build" "echo $foo > $out" '())) (s (add-to-store %store "bash" #t "sha256" |