From d37b5a1b58824dafbe6f32b1c183661c147c660c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Tue, 3 Mar 2020 10:48:09 +0100
Subject: 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 1701772bc1..7bfa786358 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) ...)
-- 
cgit v1.2.3