Merge branch 'master' into core-updates

2 files changed, 42 insertions, 23 deletions

diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index eedf6bf6a8..da2a675ce2 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -812,14 +812,6 @@ build---packages, gexps, derivations, and so on."
       (for-each validate-type lst)
       lst))
 
-  ;; Note: Taken from (guix scripts refresh).
-  (define (manifest->packages manifest)
-    "Return the list of packages in MANIFEST."
-    (filter-map (lambda (entry)
-                  (let ((item (manifest-entry-item entry)))
-                    (if (package? item) item #f)))
-                (manifest-entries manifest)))
-
   (append-map (match-lambda
                 (('argument . (? string? spec))
                  (cond ((derivation-path? spec)
@@ -844,8 +836,10 @@ build---packages, gexps, derivations, and so on."
                 (('file . file)
                  (ensure-list (load* file (make-user-module '()))))
                 (('manifest . manifest)
-                 (manifest->packages
-                  (load* manifest (make-user-module '((guix profiles) (gnu))))))
+                 (map manifest-entry-item
+                      (manifest-entries
+                       (load* manifest
+                              (make-user-module '((guix profiles) (gnu)))))))
                 (('expression . str)
                  (ensure-list (read/eval str)))
                 (('argument . (? derivation? drv))
@@ -949,13 +943,21 @@ needed."
     (parse-command-line args %options
                         (list %default-options)))
 
+  (define graft?
+    (assoc-ref opts 'graft?))
+
   (with-error-handling
     (with-status-verbosity (assoc-ref opts 'verbosity)
       (with-store store
         ;; Set the build options before we do anything else.
         (set-build-options-from-command-line store opts)
 
-        (parameterize ((current-terminal-columns (terminal-columns)))
+        (parameterize ((current-terminal-columns (terminal-columns))
+
+                       ;; Set grafting upfront in case the user's input
+                       ;; depends on it (e.g., a manifest or code snippet that
+                       ;; calls 'gexp->derivation').
+                       (%graft?                  graft?))
           (let* ((mode  (assoc-ref opts 'build-mode))
                  (drv   (options->derivations store opts))
                  (urls  (map (cut string-append <> "/log")
diff --git a/guix/scripts/weather.scm b/guix/scripts/weather.scm
index 1701772bc1..629844768a 100644
--- a/guix/scripts/weather.scm
+++ b/guix/scripts/weather.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2018 Kyle Meyer <kyle@kyleam.com>
 ;;;
@@ -28,6 +28,7 @@
   #:use-module (guix monads)
   #:use-module (guix store)
   #:use-module (guix grafts)
+  #:use-module (guix gexp)
   #:use-module ((guix build syscalls) #:select (terminal-columns))
   #:use-module (guix scripts substitute)
   #:use-module (guix http-client)
@@ -75,7 +76,16 @@ scope."
 (define* (package-outputs packages
                           #:optional (system (%current-system)))
   "Return the list of outputs of all of PACKAGES for the given SYSTEM."
-  (let ((packages (filter (cut supported-package? <> system) packages)))
+  (define (lower-object/no-grafts obj system)
+    (mlet* %store-monad ((previous (set-grafting #f))
+                         (drv      (lower-object obj system))
+                         (_        (set-grafting previous)))
+      (return drv)))
+
+  (let ((packages (filter (lambda (package)
+                            (or (not (package? package))
+                                (supported-package? package system)))
+                          packages)))
     (format (current-error-port)
             (G_ "computing ~h package derivations for ~a...~%")
             (length packages) system)
@@ -84,8 +94,11 @@ scope."
       (lambda (report)
         (foldm %store-monad
                (lambda (package result)
-                 (mlet %store-monad ((drv (package->derivation package system
-                                                               #:graft? #f)))
+                 ;; PACKAGE could in fact be a non-package object, for example
+                 ;; coming from a user-specified manifest.  Thus, use
+                 ;; 'lower-object' rather than 'package->derivation' here.
+                 (mlet %store-monad ((drv (lower-object/no-grafts package
+                                                                  system)))
                    (report)
                    (match (derivation->output-paths drv)
                      (((names . items) ...)
@@ -487,7 +500,12 @@ SERVER.  Display information for packages with at least THRESHOLD dependents."
                   (if file (load-manifest file) '())))))
 
   (with-error-handling
-    (parameterize ((current-terminal-columns (terminal-columns)))
+    (parameterize ((current-terminal-columns (terminal-columns))
+
+                   ;; Set grafting upfront in case the user's input depends on
+                   ;; it (e.g., a manifest or code snippet that calls
+                   ;; 'gexp->derivation').
+                   (%graft?                  #f))
       (let* ((opts     (parse-command-line args %options
                                            (list %default-options)
                                            #:build-options? #f))
@@ -500,13 +518,12 @@ SERVER.  Display information for packages with at least THRESHOLD dependents."
                          (systems systems)))
              (packages (package-list opts))
              (items    (with-store store
-                         (parameterize ((%graft? #f))
-                           (concatenate
-                            (run-with-store store
-                              (mapm %store-monad
-                                    (lambda (system)
-                                      (package-outputs packages system))
-                                    systems)))))))
+                         (concatenate
+                          (run-with-store store
+                            (mapm %store-monad
+                                  (lambda (system)
+                                    (package-outputs packages system))
+                                  systems))))))
         (for-each (lambda (server)
                     (report-server-coverage server items)
                     (match (assoc-ref opts 'coverage)