From f77bcbc374bb94272c57508dc04fb8599b56a9d8 Mon Sep 17 00:00:00 2001
From: Eric Bavier <bavier@member.fsf.org>
Date: Fri, 24 Apr 2015 07:57:51 -0500
Subject: guix: packages: Add package-direct-sources and
 package-transitive-sources.

* guix/tests.scm (dummy-origin): New syntax.
* guix/packages.scm (package-direct-sources)
  (package-transitive-sources): New procedures.
* tests/packages.scm ("package-direct-sources, no source")
  ("package-direct-sources, #f source")
  ("package-direct-sources, not input source", "package-direct-sources")
  ("package-transitive-sources"): Test them.
---
 guix/packages.scm | 24 ++++++++++++++++++++++++
 guix/tests.scm    | 10 +++++++++-
 2 files changed, 33 insertions(+), 1 deletion(-)

(limited to 'guix')

diff --git a/guix/packages.scm b/guix/packages.scm
index b7a1979a7d..d7fced8384 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -83,6 +83,8 @@
             package-location
             package-field-location
 
+            package-direct-sources
+            package-transitive-sources
             package-direct-inputs
             package-transitive-inputs
             package-transitive-target-inputs
@@ -540,6 +542,28 @@ IMPORTED-MODULES specify modules to use/import for use by SNIPPET."
       ((input rest ...)
        (loop rest (cons input result))))))
 
+(define (package-direct-sources package)
+  "Return all source origins associated with PACKAGE; including origins in
+PACKAGE's inputs."
+  `(,@(or (and=> (package-source package) list) '())
+    ,@(filter-map (match-lambda
+                   ((_ (? origin? orig) _ ...)
+                    orig)
+                   (_ #f))
+                  (package-direct-inputs package))))
+
+(define (package-transitive-sources package)
+  "Return PACKAGE's direct sources, and their direct sources, recursively."
+  (delete-duplicates
+   (concatenate (filter-map (match-lambda
+                             ((_ (? origin? orig) _ ...)
+                              (list orig))
+                             ((_ (? package? p) _ ...)
+                              (package-direct-sources p))
+                             (_ #f))
+                            (bag-transitive-inputs
+                             (package->bag package))))))
+
 (define (package-direct-inputs package)
   "Return all the direct inputs of PACKAGE---i.e, its direct inputs along
 with their propagated inputs."
diff --git a/guix/tests.scm b/guix/tests.scm
index 080ee9cc74..87e6cc2830 100644
--- a/guix/tests.scm
+++ b/guix/tests.scm
@@ -37,7 +37,8 @@
             %substitute-directory
             with-derivation-narinfo
             with-derivation-substitute
-            dummy-package))
+            dummy-package
+            dummy-origin))
 
 ;;; Commentary:
 ;;;
@@ -219,6 +220,13 @@ initialized with default values, and with EXTRA-FIELDS set as specified."
            (synopsis #f) (description #f)
            (home-page #f) (license #f)))
 
+(define-syntax-rule (dummy-origin extra-fields ...)
+  "Return a \"dummy\" origin, with all its compulsory fields initialized with
+default values, and with EXTRA-FIELDS set as specified."
+  (origin extra-fields ...
+          (method #f) (uri "http://www.example.com")
+          (sha256 (base32 (make-string 52 #\x)))))
+
 ;; Local Variables:
 ;; eval: (put 'call-with-derivation-narinfo 'scheme-indent-function 1)
 ;; eval: (put 'call-with-derivation-substitute 'scheme-indent-function 2)
-- 
cgit v1.2.3