03/09: weather: Allow non-package objects in manifest.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit d37b5a1b58824dafbe6f32b1c183661c147c660c
Author: Ludovic Courtès <address@hidden>
AuthorDate: Tue Mar 3 10:48:09 2020 +0100

    weather: Allow non-package objects in manifest.
    
    * guix/scripts/weather.scm (package-outputs)[lower-object/no-grafts]:
    New procedure.
    Use it instead of 'package->derivation'.
---
 guix/scripts/weather.scm | 21 +++++++++++++++++----
 1 file changed, 17 insertions(+), 4 deletions(-)

diff --git a/guix/scripts/weather.scm b/guix/scripts/weather.scm
index 1701772..7bfa786 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 <address@hidden>
+;;; Copyright © 2017, 2018, 2019, 2020 Ludovic Courtès <address@hidden>
 ;;; Copyright © 2017 Ricardo Wurmus <address@hidden>
 ;;; Copyright © 2018 Kyle Meyer <address@hidden>
 ;;;
@@ -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) ...)