guix-package: Install propagated inputs.

* guix-package.in (profile-manifest): Return "version 1" manifests.
  (manifest-packages): Likewise.  When MANIFEST is "version 0", add
  '() as the list of "propagated inputs" of each package.
  (profile-derivation): Produce "version 1" manifests.  Pass each
  PACKAGES item's propagated inputs as an input for BUILDER.
  (input->name+path): New procedure.
  (guix-package)[find-package]: Add the transitive propagated inputs of
  each selected package as the last item of the tuple.
  [canonicalize-deps]: New procedure.
  [process-actions]: Adjust to support propagated inputs as the last item.
  [process-query]: Likewise.

1 files changed, 55 insertions, 15 deletions

diff --git a/guix-package.in b/guix-package.in
index d7b1270255..ae3d2cd70e 100644
--- a/guix-package.in
+++ b/guix-package.in
@@ -80,13 +80,22 @@ exec ${GUILE-@GUILE@} -L "@guilemoduledir@" -l "$0"    \
   (let ((manifest (string-append profile "/manifest")))
     (if (file-exists? manifest)
         (call-with-input-file manifest read)
-        '(manifest (version 0) (packages ())))))
+        '(manifest (version 1) (packages ())))))
 
 (define (manifest-packages manifest)
   "Return the packages listed in MANIFEST."
   (match manifest
-    (('manifest ('version 0) ('packages packages))
+    (('manifest ('version 0)
+                ('packages ((name version output path) ...)))
+     (zip name version output path
+          (make-list (length name) '())))
+
+    ;; Version 1 adds a list of propagated inputs to the
+    ;; name/version/output/path tuples.
+    (('manifest ('version 1)
+                ('packages (packages ...)))
      packages)
+
     (_
      (error "unsupported manifest format" manifest))))
 
@@ -157,7 +166,7 @@ case when generations have been deleted (there are \"holes\")."
 
 (define (profile-derivation store packages)
   "Return a derivation that builds a profile (a user environment) with
-all of PACKAGES, a list of name/version/output/path tuples."
+all of PACKAGES, a list of name/version/output/path/deps tuples."
   (define builder
     `(begin
        (use-modules (ice-9 pretty-print)
@@ -173,17 +182,18 @@ all of PACKAGES, a list of name/version/output/path tuples."
          (union-build output inputs)
          (call-with-output-file (string-append output "/manifest")
            (lambda (p)
-             (pretty-print '(manifest (version 0)
+             (pretty-print '(manifest (version 1)
                                       (packages ,packages))
                            p))))))
 
   (build-expression->derivation store "user-environment"
                                 (%current-system)
                                 builder
-                                (map (match-lambda
-                                      ((name version output path)
-                                       `(,name ,path)))
-                                     packages)
+                                (append-map (match-lambda
+                                             ((name version output path deps)
+                                              `((,name ,path)
+                                                ,@deps)))
+                                            packages)
                                 #:modules '((guix build union))))
 
 (define (profile-number profile)
@@ -260,6 +270,20 @@ matching packages."
                 (package-name p2))))
    same-location?))
 
+(define (input->name+path input)
+  "Convert the name/package/sub-drv tuple INPUT to a name/store-path tuple."
+  (let loop ((input input))
+    (match input
+      ((name package)
+       (loop `(,name ,package "out")))
+      ((name package sub-drv)
+       (let*-values (((_ drv)
+                      (package-derivation (%store) package))
+                     ((out)
+                      (derivation-output-path
+                       (assoc-ref (derivation-outputs drv) sub-drv))))
+         `(,name ,out))))))
+
 
 ;;;
 ;;; Command-line options.
@@ -419,7 +443,8 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
                    (package-name->name+version name)))
       (match (find-packages-by-name name version)
         ((p)
-         (list name (package-version p) sub-drv (ensure-output p sub-drv)))
+         (list name (package-version p) sub-drv (ensure-output p sub-drv)
+               (package-transitive-propagated-inputs p)))
         ((p p* ...)
          (format (current-error-port)
                  (_ "warning: ambiguous package specification `~a'~%")
@@ -428,7 +453,8 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
                  (_ "warning: choosing ~a from ~a~%")
                  (package-full-name p)
                  (location->string (package-location p)))
-         (list name (package-version p) sub-drv (ensure-output p sub-drv)))
+         (list name (package-version p) sub-drv (ensure-output p sub-drv)
+               (package-transitive-propagated-inputs p)))
         (()
          (leave (_ "~a: package not found~%") request)))))
 
@@ -467,6 +493,18 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
     (define verbose? (assoc-ref opts 'verbose?))
     (define profile  (assoc-ref opts 'profile))
 
+    (define (canonicalize-deps deps)
+      ;; Remove duplicate entries from DEPS, a list of propagated inputs,
+      ;; where each input is a name/path tuple.
+      (define (same? d1 d2)
+        (match d1
+          ((_ path1)
+           (match d2
+             ((_ path2)
+              (string=? path1 path2))))))
+
+      (delete-duplicates (map input->name+path deps) same?))
+
     ;; First roll back if asked to.
     (if (and (assoc-ref opts 'roll-back?) (not dry-run?))
         (begin
@@ -481,7 +519,8 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
                                      opts))
                (drv      (filter-map (match-lambda
                                       ((name version sub-drv
-                                             (? package? package))
+                                             (? package? package)
+                                             (deps ...))
                                        (package-derivation (%store) package))
                                       (_ #f))
                                      install))
@@ -492,16 +531,17 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
                                                       (package-name->name+version
                                                        (store-path-package-name
                                                         path))))
-                                          `(,name ,version #f ,path)))
+                                          `(,name ,version #f ,path ())))
                                        (_ #f))
                                       opts)
                           (map (lambda (tuple drv)
                                  (match tuple
-                                   ((name version sub-drv _)
+                                   ((name version sub-drv _ (deps ...))
                                     (let ((output-path
                                            (derivation-path->output-path
                                             drv sub-drv)))
-                                      `(,name ,version ,sub-drv ,output-path)))))
+                                      `(,name ,version ,sub-drv ,output-path
+                                              ,(canonicalize-deps deps))))))
                                install drv)))
                (remove   (filter-map (match-lambda
                                       (('remove . package)
@@ -564,7 +604,7 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
                 (manifest  (profile-manifest profile))
                 (installed (manifest-packages manifest)))
            (for-each (match-lambda
-                      ((name version output path)
+                      ((name version output path _)
                        (when (or (not regexp)
                                  (regexp-exec regexp name))
                          (format #t "~a\t~a\t~a\t~a~%"