store: Add `requisites'.
* guix/store.scm (fold-path, requisites): New procedures. * tests/store.scm ("requisites"): New test.
This commit is contained in:
parent
d4c7486079
commit
3f1e69395c
|
@ -31,6 +31,7 @@
|
||||||
#:use-module (srfi srfi-39)
|
#:use-module (srfi srfi-39)
|
||||||
#:use-module (ice-9 match)
|
#:use-module (ice-9 match)
|
||||||
#:use-module (ice-9 regex)
|
#:use-module (ice-9 regex)
|
||||||
|
#:use-module (ice-9 vlist)
|
||||||
#:export (%daemon-socket-file
|
#:export (%daemon-socket-file
|
||||||
|
|
||||||
nix-server?
|
nix-server?
|
||||||
|
@ -70,6 +71,7 @@
|
||||||
substitutable-path-info
|
substitutable-path-info
|
||||||
|
|
||||||
references
|
references
|
||||||
|
requisites
|
||||||
referrers
|
referrers
|
||||||
valid-derivers
|
valid-derivers
|
||||||
query-derivation-outputs
|
query-derivation-outputs
|
||||||
|
@ -493,6 +495,30 @@ file name. Return #t on success."
|
||||||
"Return the list of references of PATH."
|
"Return the list of references of PATH."
|
||||||
store-path-list))
|
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
|
(define referrers
|
||||||
(operation (query-referrers (store-path path))
|
(operation (query-referrers (store-path path))
|
||||||
"Return the list of path that refer to PATH."
|
"Return the list of path that refer to PATH."
|
||||||
|
|
|
@ -106,6 +106,24 @@
|
||||||
(null? (references %store t1))
|
(null? (references %store t1))
|
||||||
(null? (referrers %store t2)))))
|
(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"
|
(test-assert "derivers"
|
||||||
(let* ((b (add-text-to-store %store "build" "echo $foo > $out" '()))
|
(let* ((b (add-text-to-store %store "build" "echo $foo > $out" '()))
|
||||||
(s (add-to-store %store "bash" #t "sha256"
|
(s (add-to-store %store "bash" #t "sha256"
|
||||||
|
|
Loading…
Reference in New Issue