From 3f1e69395cbfaad80710bdfbef433c26aa216271 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Thu, 13 Jun 2013 22:03:42 +0200
Subject: [PATCH] store: Add `requisites'.

* guix/store.scm (fold-path, requisites): New procedures.
* tests/store.scm ("requisites"): New test.
---
 guix/store.scm  | 26 ++++++++++++++++++++++++++
 tests/store.scm | 18 ++++++++++++++++++
 2 files changed, 44 insertions(+)

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"