aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--guix/store.scm26
-rw-r--r--tests/store.scm18
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"