diff options
author | Ludovic Courtès <ludo@gnu.org> | 2013-02-20 23:41:24 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2013-02-27 20:55:41 +0100 |
commit | 7650e148f69832e6b89b93c549278b1bbf89946a (patch) | |
tree | f61aac63bce8d52550ddddc320023660ec7ddb15 | |
parent | e51035f70a2eee6d0def046d58fdc63c1aa3899e (diff) | |
download | patches-7650e148f69832e6b89b93c549278b1bbf89946a.tar patches-7650e148f69832e6b89b93c549278b1bbf89946a.tar.gz |
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.
-rw-r--r-- | guix/scripts/build.scm | 23 | ||||
-rw-r--r-- | guix/scripts/package.scm | 28 | ||||
-rw-r--r-- | guix/ui.scm | 29 |
3 files changed, 32 insertions, 48 deletions
diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index 7863fb881b..fbd22a9e29 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -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) diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 38e8ae1150..1f9355ff22 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -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) diff --git a/guix/ui.scm b/guix/ui.scm index 9c27dd8b3a..2b75504573 100644 --- a/guix/ui.scm +++ b/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." |