ui: Factorize `show-what-to-build'.
* guix/scripts/package.scm (guix-package)[show-what-to-build]: Move to.. * guix/ui.scm (show-what-to-build): ... here. Add a `store' parameter'. Adjust callers. * guix/scripts/build.scm (guix-build): Use it. Remove `req' and `req*' variables.master
parent
7730d112a2
commit
9bb2b96aab
|
@ -241,31 +241,12 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
|
|||
(package-derivation (%store) p sys))))
|
||||
(_ #f))
|
||||
opts))
|
||||
(req (append-map (lambda (drv-path)
|
||||
(let ((d (call-with-input-file drv-path
|
||||
read-derivation)))
|
||||
(derivation-prerequisites-to-build (%store) d)))
|
||||
drv))
|
||||
(req* (delete-duplicates
|
||||
(append (remove (compose (cut valid-path? (%store) <>)
|
||||
derivation-path->output-path)
|
||||
drv)
|
||||
(map derivation-input-path req))))
|
||||
(roots (filter-map (match-lambda
|
||||
(('gc-root . root) root)
|
||||
(_ #f))
|
||||
opts)))
|
||||
(if (assoc-ref opts 'dry-run?)
|
||||
(format (current-error-port)
|
||||
(N_ "~:[the following derivation would be built:~%~{ ~a~%~}~;~]"
|
||||
"~:[the following derivations would be built:~%~{ ~a~%~}~;~]"
|
||||
(length req*))
|
||||
(null? req*) req*)
|
||||
(format (current-error-port)
|
||||
(N_ "~:[the following derivation will be built:~%~{ ~a~%~}~;~]"
|
||||
"~:[the following derivations will be built:~%~{ ~a~%~}~;~]"
|
||||
(length req*))
|
||||
(null? req*) req*))
|
||||
|
||||
(show-what-to-build (%store) drv (assoc-ref opts 'dry-run?))
|
||||
|
||||
;; TODO: Add more options.
|
||||
(set-build-options (%store)
|
||||
|
|
|
@ -380,32 +380,6 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
|
|||
(let ((out (derivation-path->output-path (%guile-for-build))))
|
||||
(not (valid-path? (%store) out))))
|
||||
|
||||
(define (show-what-to-build drv dry-run?)
|
||||
;; Show what will/would be built in realizing the derivations listed
|
||||
;; in DRV.
|
||||
(let* ((req (append-map (lambda (drv-path)
|
||||
(let ((d (call-with-input-file drv-path
|
||||
read-derivation)))
|
||||
(derivation-prerequisites-to-build
|
||||
(%store) d)))
|
||||
drv))
|
||||
(req* (delete-duplicates
|
||||
(append (remove (compose (cute valid-path? (%store) <>)
|
||||
derivation-path->output-path)
|
||||
drv)
|
||||
(map derivation-input-path req)))))
|
||||
(if dry-run?
|
||||
(format (current-error-port)
|
||||
(N_ "~:[the following derivation would be built:~%~{ ~a~%~}~;~]"
|
||||
"~:[the following derivations would be built:~%~{ ~a~%~}~;~]"
|
||||
(length req*))
|
||||
(null? req*) req*)
|
||||
(format (current-error-port)
|
||||
(N_ "~:[the following derivation will be built:~%~{ ~a~%~}~;~]"
|
||||
"~:[the following derivations will be built:~%~{ ~a~%~}~;~]"
|
||||
(length req*))
|
||||
(null? req*) req*))))
|
||||
|
||||
(define newest-available-packages
|
||||
(memoize find-newest-available-packages))
|
||||
|
||||
|
@ -589,7 +563,7 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
|
|||
(when (equal? profile %current-profile)
|
||||
(ensure-default-profile))
|
||||
|
||||
(show-what-to-build drv dry-run?)
|
||||
(show-what-to-build (%store) drv dry-run?)
|
||||
|
||||
(or dry-run?
|
||||
(and (build-derivations (%store) drv)
|
||||
|
|
29
guix/ui.scm
29
guix/ui.scm
|
@ -22,17 +22,20 @@
|
|||
#:use-module (guix store)
|
||||
#:use-module (guix config)
|
||||
#:use-module (guix packages)
|
||||
#:use-module (guix derivations)
|
||||
#:use-module ((guix licenses) #:select (license? license-name))
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-11)
|
||||
#:use-module (srfi srfi-26)
|
||||
#:use-module (srfi srfi-34)
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (ice-9 format)
|
||||
#:export (_
|
||||
N_
|
||||
leave
|
||||
show-version-and-exit
|
||||
show-bug-report-information
|
||||
show-what-to-build
|
||||
call-with-error-handling
|
||||
with-error-handling
|
||||
location->string
|
||||
|
@ -112,6 +115,32 @@ General help using GNU software: <http://www.gnu.org/gethelp/>"))
|
|||
(nix-protocol-error-message c))))
|
||||
(thunk)))
|
||||
|
||||
(define* (show-what-to-build store drv #:optional dry-run?)
|
||||
"Show what will or would (depending on DRY-RUN?) be built in realizing the
|
||||
derivations listed in DRV."
|
||||
(let* ((req (append-map (lambda (drv-path)
|
||||
(let ((d (call-with-input-file drv-path
|
||||
read-derivation)))
|
||||
(derivation-prerequisites-to-build
|
||||
store d)))
|
||||
drv))
|
||||
(req* (delete-duplicates
|
||||
(append (remove (compose (cute valid-path? store <>)
|
||||
derivation-path->output-path)
|
||||
drv)
|
||||
(map derivation-input-path req)))))
|
||||
(if dry-run?
|
||||
(format (current-error-port)
|
||||
(N_ "~:[the following derivation would be built:~%~{ ~a~%~}~;~]"
|
||||
"~:[the following derivations would be built:~%~{ ~a~%~}~;~]"
|
||||
(length req*))
|
||||
(null? req*) req*)
|
||||
(format (current-error-port)
|
||||
(N_ "~:[the following derivation will be built:~%~{ ~a~%~}~;~]"
|
||||
"~:[the following derivations will be built:~%~{ ~a~%~}~;~]"
|
||||
(length req*))
|
||||
(null? req*) req*))))
|
||||
|
||||
(define-syntax with-error-handling
|
||||
(syntax-rules ()
|
||||
"Run BODY within a user-friendly error condition handler."
|
||||
|
|
Reference in New Issue