mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2025-01-19 09:22:05 -05:00
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:
parent
5a675b2c67
commit
d37b5a1b58
1 changed files with 17 additions and 4 deletions
|
@ -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 @@ (define-module (guix scripts weather)
|
|||
#: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 @@ (define (call-with-progress-reporter reporter proc)
|
|||
(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 @@ (define* (package-outputs packages
|
|||
(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) ...)
|
||||
|
|
Loading…
Reference in a new issue