me
/
guix
Archived
1
0
Fork 0
Code

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'.
master
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
guix/scripts/weather.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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 © 2017 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2018 Kyle Meyer <kyle@kyleam.com> ;;; Copyright © 2018 Kyle Meyer <kyle@kyleam.com>
;;; ;;;
@ -28,6 +28,7 @@
#:use-module (guix monads) #:use-module (guix monads)
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix grafts) #:use-module (guix grafts)
#:use-module (guix gexp)
#:use-module ((guix build syscalls) #:select (terminal-columns)) #:use-module ((guix build syscalls) #:select (terminal-columns))
#:use-module (guix scripts substitute) #:use-module (guix scripts substitute)
#:use-module (guix http-client) #:use-module (guix http-client)
@ -75,7 +76,16 @@ scope."
(define* (package-outputs packages (define* (package-outputs packages
#:optional (system (%current-system))) #:optional (system (%current-system)))
"Return the list of outputs of all of PACKAGES for the given 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) (format (current-error-port)
(G_ "computing ~h package derivations for ~a...~%") (G_ "computing ~h package derivations for ~a...~%")
(length packages) system) (length packages) system)
@ -84,8 +94,11 @@ scope."
(lambda (report) (lambda (report)
(foldm %store-monad (foldm %store-monad
(lambda (package result) (lambda (package result)
(mlet %store-monad ((drv (package->derivation package system ;; PACKAGE could in fact be a non-package object, for example
#:graft? #f))) ;; 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) (report)
(match (derivation->output-paths drv) (match (derivation->output-paths drv)
(((names . items) ...) (((names . items) ...)