guix package: Specify inputs for each manifest entry.

* guix/scripts/package.scm (<manifest-entry>): Add 'inputs' field.
  (manifest=?, lower-input): New procedure.
  (profile-derivation)[builder]: Add #:log-port argument to
  'union-build'.
  [ensure-valid-input]: Remove.
  Add each entry's inputs to the input list.
  (options->installable): Return just the list of entries.
  [package->manifest-entry]: Set 'inputs' field.
  [canonicalize-deps]: Rename to...
  [deduplicate]: ... this.  Remove input fiddling.
  (guix-package)[process-actions]: Use 'manifest=?' to compare the new
  and old manifests.  Pass directly PROF-DRV to 'show-what-to-build'.
  Pass #:print-build-trace #f to 'set-build-options'.

1 files changed, 96 insertions, 106 deletions

diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 750b69beba..339d1afd36 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -91,7 +91,9 @@
                 (default "out"))
   (path         manifest-entry-path)              ; store path
   (dependencies manifest-entry-dependencies       ; list of store paths
-                (default '())))
+                (default '()))
+  (inputs       manifest-entry-inputs             ; list of inputs to build
+                (default '())))                   ; this entry
 
 (define (profile-manifest profile)
   "Return the PROFILE's manifest."
@@ -174,6 +176,13 @@
                   (string=? entry-name name)))
                 (manifest-entries manifest))))
 
+(define (manifest=? m1 m2)
+  "Return #t if manifests M1 and M2 are equal.  This differs from 'equal?' in
+that the 'inputs' field is ignored for the comparison, since it is know to
+have no effect on the manifest contents."
+  (equal? (manifest->sexp m1)
+          (manifest->sexp m2)))
+
 
 ;;;
 ;;; Profiles.
@@ -258,31 +267,28 @@ the given MANIFEST."
 
        (let ((output (assoc-ref %outputs "out"))
              (inputs (map cdr %build-inputs)))
-         (format #t "building profile `~a' with ~a packages...~%"
+         (format #t "building profile '~a' with ~a packages...~%"
                  output (length inputs))
-         (union-build output inputs)
+         (union-build output inputs
+                      #:log-port (%make-void-port "w"))
          (call-with-output-file (string-append output "/manifest")
            (lambda (p)
              (pretty-print ',(manifest->sexp manifest) p))))))
 
-  (define ensure-valid-input
-    ;; If a package object appears in the given input, turn it into a
-    ;; derivation path.
-    (match-lambda
-     ((name (? package? p) sub-drv ...)
-      `(,name ,(package-derivation (%store) p) ,@sub-drv))
-     (input
-      input)))
-
   (build-expression->derivation store "profile"
                                 (%current-system)
                                 builder
                                 (append-map (match-lambda
                                              (($ <manifest-entry> name version
+                                                 output path deps (inputs ..1))
+                                              (map (cute lower-input
+                                                         (%store) <>)
+                                                   inputs))
+                                             (($ <manifest-entry> name version
                                                  output path deps)
-                                              `((,name ,path)
-                                                ,@(map ensure-valid-input
-                                                       deps))))
+                                              ;; Assume PATH and DEPS are
+                                              ;; already valid.
+                                              `((,name ,path) ,@deps)))
                                             (manifest-entries manifest))
                                 #:modules '((guix build union))))
 
@@ -429,6 +435,16 @@ RX."
                 (package-name p2))))
    same-location?))
 
+(define* (lower-input store input #:optional (system (%current-system)))
+  "Lower INPUT so that it contains derivations instead of packages."
+  (match input
+    ((name (? package? package))
+     `(,name ,(package-derivation store package system)))
+    ((name (? package? package) output)
+     `(,name ,(package-derivation store package system)
+             ,output))
+    (_ input)))
+
 (define (input->name+path input)
   "Convert the name/package/sub-drv tuple INPUT to a name/store-path tuple."
   (let loop ((input input))
@@ -790,12 +806,10 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
 
 (define (options->installable opts manifest)
   "Given MANIFEST, the current manifest, and OPTS, the result of 'args-fold',
-return two values: the new list of manifest entries, and the list of
-derivations that need to be built."
-  (define (canonicalize-deps deps)
-    ;; Remove duplicate entries from DEPS, a list of propagated inputs,
-    ;; where each input is a name/path tuple, and replace package objects with
-    ;; store paths.
+return the new list of manifest entries."
+  (define (deduplicate 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
         ((_ p1)
@@ -809,12 +823,7 @@ derivations that need to be built."
                  (eq? p1 p2)))
            (_ #f)))))
 
-    (map (match-lambda
-          ((name package)
-           (list name (package-output (%store) package)))
-          ((name package output)
-           (list name (package-output (%store) package output))))
-         (delete-duplicates deps same?)))
+    (delete-duplicates deps same?))
 
   (define (package->manifest-entry p output)
     ;; Return a manifest entry for the OUTPUT of package P.
@@ -823,13 +832,15 @@ derivations that need to be built."
     ;; outputs (XXX).
     (let* ((output (or output (car (package-outputs p))))
            (path   (package-output (%store) p output))
-           (deps   (package-transitive-propagated-inputs p)))
+           (deps   (deduplicate (package-transitive-propagated-inputs p))))
       (manifest-entry
        (name (package-name p))
        (version (package-version p))
        (output output)
        (path path)
-       (dependencies (canonicalize-deps deps)))))
+       (dependencies (map input->name+path deps))
+       (inputs (cons (list (package-name p) p output)
+                     deps)))))
 
   (define upgrade-regexps
     (filter-map (match-lambda
@@ -895,15 +906,7 @@ derivations that need to be built."
                          (_ #f))
                         opts)))
 
-  (define derivations
-    (map (match-lambda
-          ((package output)
-           ;; FIXME: We should really depend on just OUTPUT rather than on all
-           ;; the outputs of PACKAGE.
-           (package-derivation (%store) package)))
-         (append packages-to-install packages-to-upgrade)))
-
-  (values (append to-upgrade to-install) derivations))
+  (append to-upgrade to-install))
 
 
 ;;;
@@ -1089,74 +1092,60 @@ more information.~%"))
              (_ #f))
             opts))
           (else
-           (let*-values (((manifest)
-                          (profile-manifest profile))
-                         ((install* drv)
-                          (options->installable opts manifest)))
-             (let* ((remove  (filter-map (match-lambda
-                                          (('remove . package)
-                                           package)
-                                          (_ #f))
-                                         opts))
-                    (remove* (filter (cut manifest-installed? manifest <>)
-                                     remove))
-                    (entries
-                     (append install*
-                             (fold (lambda (package result)
-                                     (match package
-                                       (($ <manifest-entry> name _ out _ ...)
-                                        (filter (negate
-                                                 (cut same-package? <>
-                                                      name out))
-                                                result))))
-                                   (manifest-entries
-                                    (manifest-remove manifest remove))
-                                   install*))))
-
-               (when (equal? profile %current-profile)
-                 (ensure-default-profile))
-
-               (show-what-to-remove/install remove* install* dry-run?)
-               (show-what-to-build (%store) drv
-                                   #:use-substitutes? (assoc-ref opts 'substitutes?)
-                                   #:dry-run? dry-run?)
-
-               (or dry-run?
-                   (and (build-derivations (%store) drv)
-                        (let* ((prof-drv (profile-derivation (%store)
-                                                             (make-manifest
-                                                              entries)))
-                               (prof     (derivation->output-path prof-drv))
-                               (old-drv  (profile-derivation
-                                          (%store) (profile-manifest profile)))
-                               (old-prof (derivation->output-path old-drv))
-                               (number   (generation-number profile))
-
-                               ;; Always use NUMBER + 1 for the new profile,
-                               ;; possibly overwriting a "previous future
-                               ;; generation".
-                               (name     (format #f "~a-~a-link"
-                                                 profile (+ 1 number))))
-                          (if (string=? old-prof prof)
-                              (when (or (pair? install*) (pair? remove))
-                                (format (current-error-port)
-                                        (_ "nothing to be done~%")))
-                              (and (parameterize ((current-build-output-port
-                                                   ;; Output something when Guile
-                                                   ;; needs to be built.
-                                                   (if (or verbose? (guile-missing?))
-                                                       (current-error-port)
-                                                       (%make-void-port "w"))))
-                                     (build-derivations (%store) (list prof-drv)))
-                                   (let ((count (length entries)))
-                                     (switch-symlinks name prof)
-                                     (switch-symlinks profile name)
-                                     (format #t (N_ "~a package in profile~%"
-                                                    "~a packages in profile~%"
-                                                    count)
-                                             count)
-                                     (display-search-paths entries
-                                                           profile))))))))))))
+           (let* ((manifest (profile-manifest profile))
+                  (install* (options->installable opts manifest))
+                  (remove   (filter-map (match-lambda
+                                         (('remove . package)
+                                          package)
+                                         (_ #f))
+                                        opts))
+                  (remove*  (filter (cut manifest-installed? manifest <>)
+                                    remove))
+                  (entries
+                   (append install*
+                           (fold (lambda (package result)
+                                   (match package
+                                     (($ <manifest-entry> name _ out _ ...)
+                                      (filter (negate
+                                               (cut same-package? <>
+                                                    name out))
+                                              result))))
+                                 (manifest-entries
+                                  (manifest-remove manifest remove))
+                                 install*)))
+                  (new      (make-manifest entries)))
+
+             (when (equal? profile %current-profile)
+               (ensure-default-profile))
+
+             (if (manifest=? new manifest)
+                 (format (current-error-port) (_ "nothing to be done~%"))
+                 (let ((prof-drv (profile-derivation (%store) new)))
+                   (show-what-to-remove/install remove* install* dry-run?)
+                   (show-what-to-build (%store) (list prof-drv)
+                                       #:use-substitutes?
+                                       (assoc-ref opts 'substitutes?)
+                                       #:dry-run? dry-run?)
+
+                   (or dry-run?
+                       (let* ((prof     (derivation->output-path prof-drv))
+                              (number   (generation-number profile))
+
+                              ;; Always use NUMBER + 1 for the new profile,
+                              ;; possibly overwriting a "previous future
+                              ;; generation".
+                              (name     (format #f "~a-~a-link"
+                                                profile (+ 1 number))))
+                         (and (build-derivations (%store) (list prof-drv))
+                              (let ((count (length entries)))
+                                (switch-symlinks name prof)
+                                (switch-symlinks profile name)
+                                (format #t (N_ "~a package in profile~%"
+                                               "~a packages in profile~%"
+                                               count)
+                                        count)
+                                (display-search-paths entries
+                                                      profile)))))))))))
 
   (define (process-query opts)
     ;; Process any query specified by OPTS.  Return #t when a query was
@@ -1266,6 +1255,7 @@ more information.~%"))
         (with-error-handling
           (parameterize ((%store (open-connection)))
             (set-build-options (%store)
+                               #:print-build-trace #f
                                #:fallback? (assoc-ref opts 'fallback?)
                                #:use-substitutes?
                                (assoc-ref opts 'substitutes?)