From fae31edcec43c93a996a1872c68d1c540af0068f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Wed, 27 Feb 2013 22:40:35 +0100
Subject: [PATCH] store: Add queries for references & co.

* guix/store.scm (operation-id)[query-valid-derivers]: New value.
  (references, referrers, valid-derivers, query-derivation-outputs): New
  procedures.
* tests/store.scm ("references", "derivers"): New tests.
---
 guix/store.scm  | 28 +++++++++++++++++++++++++++-
 tests/store.scm | 26 ++++++++++++++++++++++++++
 2 files changed, 53 insertions(+), 1 deletion(-)

diff --git a/guix/store.scm b/guix/store.scm
index 3627d5be04..80b36daf93 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -66,6 +66,10 @@
             substitutable-paths
             substitutable-path-info
 
+            references
+            referrers
+            valid-derivers
+            query-derivation-outputs
             live-paths
             dead-paths
             collect-garbage
@@ -126,7 +130,8 @@
   (query-path-from-hash-part 29)
   (query-substitutable-path-infos 30)
   (query-valid-paths 31)
-  (query-substitutable-paths 32))
+  (query-substitutable-paths 32)
+  (query-valid-derivers 33))
 
 (define-enumerate-type hash-algo
   ;; hash.hh
@@ -597,6 +602,27 @@ name--it is the caller's responsibility to ensure that it is an absolute
 file name.  Return #t on success."
   boolean)
 
+(define references
+  (operation (query-references (store-path path))
+             "Return the list of references of PATH."
+             store-path-list))
+
+(define referrers
+  (operation (query-referrers (store-path path))
+             "Return the list of path that refer to PATH."
+             store-path-list))
+
+(define valid-derivers
+  (operation (query-valid-derivers (store-path path))
+             "Return the list of valid \"derivers\" of PATH---i.e., all the
+.drv present in the store that have PATH among their outputs."
+             store-path-list))
+
+(define query-derivation-outputs  ; avoid name clash with `derivation-outputs'
+  (operation (query-derivation-outputs (store-path path))
+             "Return the list of outputs of PATH, a .drv file."
+             store-path-list))
+
 (define-operation (has-substitutes? (store-path path))
   "Return #t if binary substitutes are available for PATH, and #f otherwise."
   boolean)
diff --git a/tests/store.scm b/tests/store.scm
index c90fd3fed9..c2de99e160 100644
--- a/tests/store.scm
+++ b/tests/store.scm
@@ -23,6 +23,7 @@
   #:use-module (guix base32)
   #:use-module (guix packages)
   #:use-module (guix derivations)
+  #:use-module (gnu packages)
   #:use-module (gnu packages bootstrap)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
@@ -79,6 +80,31 @@
            (> freed 0)
            (not (file-exists? p))))))
 
+(test-assert "references"
+  (let* ((t1 (add-text-to-store %store "random1"
+                                (random-text) '()))
+         (t2 (add-text-to-store %store "random2"
+                                (random-text) (list t1))))
+    (and (equal? (list t1) (references %store t2))
+         (equal? (list t2) (referrers %store t1))
+         (null? (references %store t1))
+         (null? (referrers %store t2)))))
+
+(test-assert "derivers"
+  (let* ((b (add-text-to-store %store "build" "echo $foo > $out" '()))
+         (s (add-to-store %store "bash" #t "sha256"
+                          (search-bootstrap-binary "bash"
+                                                   (%current-system))))
+         (d (derivation %store "the-thing" (%current-system)
+                        s `("-e" ,b) `(("foo" . ,(random-text)))
+                        `((,b) (,s))))
+         (o (derivation-path->output-path d)))
+    (and (build-derivations %store (list d))
+         (equal? (query-derivation-outputs %store d)
+                 (list o))
+         (equal? (valid-derivers %store o)
+                 (list d)))))
+
 (test-assert "no substitutes"
   (let* ((s  (open-connection))
          (d1 (package-derivation s %bootstrap-guile (%current-system)))