From a3d73f59e35e19561afde1bf60ef881a4e8db0e7 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Sat, 7 Jul 2012 20:14:20 +0200
Subject: Add `package-transitive-inputs'; use it to honor propagated inputs.

* guix/packages.scm (package-transitive-inputs): New procedure.
  (package-derivation): Use it to compute INPUTS.

* tests/packages.scm (dummy-package): New macro.
  ("package-transitive-inputs"): New test.
---
 guix/packages.scm | 25 +++++++++++++++++++++++--
 1 file changed, 23 insertions(+), 2 deletions(-)

(limited to 'guix/packages.scm')

diff --git a/guix/packages.scm b/guix/packages.scm
index 2d269ad339..c835e92815 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -57,6 +57,7 @@ (define-module (guix packages)
             package-properties
             package-location
 
+            package-transitive-inputs
             package-source-derivation
             package-derivation
             package-cross-derivation))
@@ -161,6 +162,27 @@ (define (package-source-derivation store source)
     (($ <origin> uri method sha256 name)
      (method store uri 'sha256 sha256 name))))
 
+(define (package-transitive-inputs package)
+  "Return the transitive inputs of PACKAGE---i.e., its direct inputs along
+with their propagated inputs, recursively."
+  (let loop ((inputs (concatenate (list (package-native-inputs package)
+                                        (package-inputs package)
+                                        (package-propagated-inputs package))))
+             (result '()))
+    (match inputs
+      (()
+       (delete-duplicates (reverse result)))      ; XXX: efficiency
+      (((and i (name (? package? p) sub ...)) rest ...)
+       (let ((t (map (match-lambda
+                      ((dep-name derivation ...)
+                       (cons (string-append name "/" dep-name)
+                             derivation)))
+                     (package-propagated-inputs p))))
+         (loop (append t rest)
+               (append t (cons i result)))))
+      ((input rest ...)
+       (loop rest (cons input result))))))
+
 (define* (package-derivation store package
                              #:optional (system (%current-system)))
   "Return the derivation of PACKAGE for SYSTEM."
@@ -186,8 +208,7 @@ (define* (package-derivation store package
                           (list name
                                 (add-to-store store (basename file)
                                               #t #f "sha256" file))))
-                        (concatenate (list native-inputs inputs
-                                           propagated-inputs)))))
+                        (package-transitive-inputs package))))
        (apply builder
               store (string-append name "-" version)
               (package-source-derivation store source)
-- 
cgit v1.2.3