[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
03/05: store: 'requisites' now takes a list of store items.
From: |
Ludovic Courtès |
Subject: |
03/05: store: 'requisites' now takes a list of store items. |
Date: |
Tue, 24 May 2016 21:53:34 +0000 (UTC) |
civodul pushed a commit to branch master
in repository guix.
commit f6fee16e9370bdc9e912878706f69355fc40a472
Author: Ludovic Courtès <address@hidden>
Date: Tue May 24 23:27:07 2016 +0200
store: 'requisites' now takes a list of store items.
* guix/store.scm (fold-path): Change 'path' to 'paths' and adjust body
accordingly.
(requisites): Likewise.
* guix/scripts/environment.scm (inputs->requisites): Adjust
user accordingly.
* guix/scripts/size.scm (requisites*): Likewise.
* guix/scripts/gc.scm (guix-gc): Likewise.
* tests/store.scm ("requisites"): Likewise.
---
guix/scripts/environment.scm | 6 +++---
guix/scripts/gc.scm | 3 ++-
guix/scripts/size.scm | 2 +-
guix/store.scm | 14 +++++++-------
tests/store.scm | 10 ++++++----
5 files changed, 19 insertions(+), 16 deletions(-)
diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index 9ba487d..ebe966f 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -333,11 +333,11 @@ requisite store items i.e. the union closure of all the
inputs."
(requisites*
(match input
((drv output)
- (derivation->output-path drv output))
+ (list (derivation->output-path drv output)))
((drv)
- (derivation->output-path drv))
+ (list (derivation->output-path drv)))
((? direct-store-path? path)
- path))))
+ (list path)))))
(mlet %store-monad ((reqs (sequence %store-monad
(map input->requisites inputs))))
diff --git a/guix/scripts/gc.scm b/guix/scripts/gc.scm
index 4ec9ff9..8db2813 100644
--- a/guix/scripts/gc.scm
+++ b/guix/scripts/gc.scm
@@ -229,7 +229,8 @@ Invoke the garbage collector.\n"))
((list-references)
(list-relatives references))
((list-requisites)
- (list-relatives requisites))
+ (list-relatives (lambda (store item)
+ (requisites store (list item)))))
((list-referrers)
(list-relatives referrers))
((optimize)
diff --git a/guix/scripts/size.scm b/guix/scripts/size.scm
index 8432138..c9725ae 100644
--- a/guix/scripts/size.scm
+++ b/guix/scripts/size.scm
@@ -122,7 +122,7 @@ substitutes."
(guard (c ((nix-protocol-error? c)
(values (substitutable-requisites store item)
store)))
- (values (requisites store item) store))))
+ (values (requisites store (list item)) store))))
(define (mappend-map mproc lst)
"Apply MPROC to each item of LST and concatenate the resulting list."
diff --git a/guix/store.scm b/guix/store.scm
index 4d89f4a..e3033ee 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -803,12 +803,12 @@ the list of references")
(loop items tail
(cons head result)))))))))
-(define* (fold-path store proc seed path
+(define* (fold-path store proc seed paths
#:optional (relatives (cut references store <>)))
- "Call PROC for each of the RELATIVES of PATH, exactly once, and return the
+ "Call PROC for each of the RELATIVES of PATHS, 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))
+ (let loop ((paths paths)
(result seed)
(seen vlist-null))
(match paths
@@ -822,10 +822,10 @@ SEED."
(()
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 (requisites store paths)
+ "Return the requisites of PATHS, including PATHS---i.e., their closures (all
+its references, recursively)."
+ (fold-path store cons '() paths))
(define (topologically-sorted store paths)
"Return a list containing PATHS and all their references sorted in
diff --git a/tests/store.scm b/tests/store.scm
index eeadcb9..3c2c247 100644
--- a/tests/store.scm
+++ b/tests/store.scm
@@ -244,10 +244,12 @@
(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)))))
+ (and (same? (requisites %store (list t1)) (list t1))
+ (same? (requisites %store (list t2)) (list t1 t2))
+ (same? (requisites %store (list t3)) (list t1 t2 t3))
+ (same? (requisites %store (list t4)) (list t1 t2 t3 t4))
+ (same? (requisites %store (list t1 t2 t3 t4))
+ (list t1 t2 t3 t4)))))
(test-assert "derivers"
(let* ((b (add-text-to-store %store "build" "echo $foo > $out" '()))