guix: packages: Add transitive-input-references.

* guix/packages.scm (transitive-input-references): New procedure.
* gnu/packages/version-control.scm (package-transitive-propagated-labels*)
  (package-propagated-input-refs): Delete.
  (git)[arguments]: Adjust to transitive-input-references.

3 files changed, 38 insertions, 22 deletions

diff --git a/gnu/packages/version-control.scm b/gnu/packages/version-control.scm
index 8d8003fe4c..3c0571bac6 100644
--- a/gnu/packages/version-control.scm
+++ b/gnu/packages/version-control.scm
@@ -98,24 +98,6 @@ changes to project files over time.  It supports both a distributed workflow
 as well as the classic centralized workflow.")
     (license gpl2+)))
 
-(define (package-transitive-propagated-labels* package)
-  "Return a list of the input labels of PACKAGE and its transitive inputs."
-  (let ((name (package-name package)))
-    `(,name
-      ,@(map (match-lambda
-               ((label (? package? _) . _)
-                label))
-             (package-transitive-propagated-inputs package)))))
-
-(define (package-propagated-input-refs inputs packages)
-  "Return a list of (assoc-ref INPUTS <package-name>) for each package in
-PACKAGES and their propagated inputs."
-  (map (lambda (l)
-         `(assoc-ref ,inputs ,l))
-       (delete-duplicates                  ;XXX: efficiency
-        (append-map package-transitive-propagated-labels*
-                    packages))))
-
 (define-public git
   ;; Keep in sync with 'git-manpages'!
   (package
@@ -238,11 +220,13 @@ PACKAGES and their propagated inputs."
                 `("PERL5LIB" ":" prefix
                   ,(map (lambda (o) (string-append o "/lib/perl5/site_perl"))
                         (list
-                         ,@(package-propagated-input-refs
+                         ,@(transitive-input-references
                             'inputs
-                            (list perl-authen-sasl
-                                  perl-net-smtp-ssl
-                                  perl-io-socket-ssl))))))
+                            (map (lambda (l)
+                                   (assoc l (inputs)))
+                                 '("perl-authen-sasl"
+                                   "perl-net-smtp-ssl"
+                                   "perl-io-socket-ssl")))))))
 
               ;; Tell 'git-submodule' where Perl is.
               (wrap-program git-sm
diff --git a/guix/packages.scm b/guix/packages.scm
index 3983d1409a..e466ffeda0 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2014, 2015 Mark H Weaver <mhw@netris.org>
+;;; Copyright © 2015 Eric Bavier <bavier@member.fsf.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -93,6 +94,8 @@
             package-output
             package-grafts
 
+            transitive-input-references
+
             %supported-systems
             %hydra-supported-systems
             supported-package?
@@ -579,6 +582,18 @@ for the host system (\"native inputs\"), and not target inputs."
 recursively."
   (transitive-inputs (package-propagated-inputs package)))
 
+(define (transitive-input-references alist inputs)
+  "Return a list of (assoc-ref ALIST <label>) for each (<label> <package> . _)
+in INPUTS and their transitive propagated inputs."
+  (define label
+    (match-lambda
+      ((label . _)
+       label)))
+
+  (map (lambda (input)
+         `(assoc-ref ,alist ,(label input)))
+       (transitive-inputs inputs)))
+
 (define-syntax define-memoized/v
   (lambda (form)
     "Define a memoized single-valued unary procedure with docstring.
diff --git a/tests/packages.scm b/tests/packages.scm
index 3cb532df1a..00a0998b4c 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -207,6 +207,23 @@
            (member i s)
            (member u s)))))
 
+(test-assert "transitive-input-references"
+  (let* ((a (dummy-package "a"))
+         (b (dummy-package "b"))
+         (c (dummy-package "c"
+              (inputs `(("a" ,a)))
+              (propagated-inputs `(("boo" ,b)))))
+         (d (dummy-package "d"
+              (inputs `(("c*" ,c)))))
+         (keys (map (match-lambda
+                      (('assoc-ref 'l key)
+                       key))
+                    (pk 'refs (transitive-input-references
+                               'l (package-inputs d))))))
+    (and (= (length keys) 2)
+         (member "c*" keys)
+         (member "boo" keys))))
+
 (test-equal "package-transitive-supported-systems, implicit inputs"
   %supported-systems