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'.
This commit is contained in:
Ludovic Courtès 2020-03-03 10:48:09 +01:00
parent 5a675b2c67
commit d37b5a1b58
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 17 additions and 4 deletions

View File

@ -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) ...)