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-20 23:46:57 +0100 |
| commit | 9bb2b96aabdbb245c4a409e96b25df2954cfe385 (patch) | |
| tree | ed08fd19242d1f481be005d655c67187eadb5dee | |
| parent | 7730d112a2707522943d06940da25a22841a4568 (diff) | |
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 7863fb881b6..fbd22a9e295 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")) | |||
| 241 | (package-derivation (%store) p sys)))) | 241 | (package-derivation (%store) p sys)))) |
| 242 | (_ #f)) | 242 | (_ #f)) |
| 243 | opts)) | 243 | opts)) |
| 244 | (req (append-map (lambda (drv-path) | ||
| 245 | (let ((d (call-with-input-file drv-path | ||
| 246 | read-derivation))) | ||
| 247 | (derivation-prerequisites-to-build (%store) d))) | ||
| 248 | drv)) | ||
| 249 | (req* (delete-duplicates | ||
| 250 | (append (remove (compose (cut valid-path? (%store) <>) | ||
| 251 | derivation-path->output-path) | ||
| 252 | drv) | ||
| 253 | (map derivation-input-path req)))) | ||
| 254 | (roots (filter-map (match-lambda | 244 | (roots (filter-map (match-lambda |
| 255 | (('gc-root . root) root) | 245 | (('gc-root . root) root) |
| 256 | (_ #f)) | 246 | (_ #f)) |
| 257 | opts))) | 247 | opts))) |
| 258 | (if (assoc-ref opts 'dry-run?) | 248 | |
| 259 | (format (current-error-port) | 249 | (show-what-to-build (%store) drv (assoc-ref opts 'dry-run?)) |
| 260 | (N_ "~:[the following derivation would be built:~%~{ ~a~%~}~;~]" | ||
| 261 | "~:[the following derivations would be built:~%~{ ~a~%~}~;~]" | ||
| 262 | (length req*)) | ||
| 263 | (null? req*) req*) | ||
| 264 | (format (current-error-port) | ||
| 265 | (N_ "~:[the following derivation will be built:~%~{ ~a~%~}~;~]" | ||
| 266 | "~:[the following derivations will be built:~%~{ ~a~%~}~;~]" | ||
| 267 | (length req*)) | ||
| 268 | (null? req*) req*)) | ||
| 269 | 250 | ||
| 270 | ;; TODO: Add more options. | 251 | ;; TODO: Add more options. |
| 271 | (set-build-options (%store) | 252 | (set-build-options (%store) |
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 38e8ae1150b..1f9355ff221 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")) | |||
| 380 | (let ((out (derivation-path->output-path (%guile-for-build)))) | 380 | (let ((out (derivation-path->output-path (%guile-for-build)))) |
| 381 | (not (valid-path? (%store) out)))) | 381 | (not (valid-path? (%store) out)))) |
| 382 | 382 | ||
| 383 | (define (show-what-to-build drv dry-run?) | ||
| 384 | ;; Show what will/would be built in realizing the derivations listed | ||
| 385 | ;; in DRV. | ||
| 386 | (let* ((req (append-map (lambda (drv-path) | ||
| 387 | (let ((d (call-with-input-file drv-path | ||
| 388 | read-derivation))) | ||
| 389 | (derivation-prerequisites-to-build | ||
| 390 | (%store) d))) | ||
| 391 | drv)) | ||
| 392 | (req* (delete-duplicates | ||
| 393 | (append (remove (compose (cute valid-path? (%store) <>) | ||
| 394 | derivation-path->output-path) | ||
| 395 | drv) | ||
| 396 | (map derivation-input-path req))))) | ||
| 397 | (if dry-run? | ||
| 398 | (format (current-error-port) | ||
| 399 | (N_ "~:[the following derivation would be built:~%~{ ~a~%~}~;~]" | ||
| 400 | "~:[the following derivations would be built:~%~{ ~a~%~}~;~]" | ||
| 401 | (length req*)) | ||
| 402 | (null? req*) req*) | ||
| 403 | (format (current-error-port) | ||
| 404 | (N_ "~:[the following derivation will be built:~%~{ ~a~%~}~;~]" | ||
| 405 | "~:[the following derivations will be built:~%~{ ~a~%~}~;~]" | ||
| 406 | (length req*)) | ||
| 407 | (null? req*) req*)))) | ||
| 408 | |||
| 409 | (define newest-available-packages | 383 | (define newest-available-packages |
| 410 | (memoize find-newest-available-packages)) | 384 | (memoize find-newest-available-packages)) |
| 411 | 385 | ||
| @@ -589,7 +563,7 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n")) | |||
| 589 | (when (equal? profile %current-profile) | 563 | (when (equal? profile %current-profile) |
| 590 | (ensure-default-profile)) | 564 | (ensure-default-profile)) |
| 591 | 565 | ||
| 592 | (show-what-to-build drv dry-run?) | 566 | (show-what-to-build (%store) drv dry-run?) |
| 593 | 567 | ||
| 594 | (or dry-run? | 568 | (or dry-run? |
| 595 | (and (build-derivations (%store) drv) | 569 | (and (build-derivations (%store) drv) |
diff --git a/guix/ui.scm b/guix/ui.scm index 9c27dd8b3a1..2b755045737 100644 --- a/guix/ui.scm +++ b/guix/ui.scm | |||
| @@ -22,17 +22,20 @@ | |||
| 22 | #:use-module (guix store) | 22 | #:use-module (guix store) |
| 23 | #:use-module (guix config) | 23 | #:use-module (guix config) |
| 24 | #:use-module (guix packages) | 24 | #:use-module (guix packages) |
| 25 | #:use-module (guix derivations) | ||
| 25 | #:use-module ((guix licenses) #:select (license? license-name)) | 26 | #:use-module ((guix licenses) #:select (license? license-name)) |
| 26 | #:use-module (srfi srfi-1) | 27 | #:use-module (srfi srfi-1) |
| 27 | #:use-module (srfi srfi-11) | 28 | #:use-module (srfi srfi-11) |
| 28 | #:use-module (srfi srfi-26) | 29 | #:use-module (srfi srfi-26) |
| 29 | #:use-module (srfi srfi-34) | 30 | #:use-module (srfi srfi-34) |
| 30 | #:use-module (ice-9 match) | 31 | #:use-module (ice-9 match) |
| 32 | #:use-module (ice-9 format) | ||
| 31 | #:export (_ | 33 | #:export (_ |
| 32 | N_ | 34 | N_ |
| 33 | leave | 35 | leave |
| 34 | show-version-and-exit | 36 | show-version-and-exit |
| 35 | show-bug-report-information | 37 | show-bug-report-information |
| 38 | show-what-to-build | ||
| 36 | call-with-error-handling | 39 | call-with-error-handling |
| 37 | with-error-handling | 40 | with-error-handling |
| 38 | location->string | 41 | location->string |
| @@ -112,6 +115,32 @@ General help using GNU software: <http://www.gnu.org/gethelp/>")) | |||
| 112 | (nix-protocol-error-message c)))) | 115 | (nix-protocol-error-message c)))) |
| 113 | (thunk))) | 116 | (thunk))) |
| 114 | 117 | ||
| 118 | (define* (show-what-to-build store drv #:optional dry-run?) | ||
| 119 | "Show what will or would (depending on DRY-RUN?) be built in realizing the | ||
| 120 | derivations listed in DRV." | ||
| 121 | (let* ((req (append-map (lambda (drv-path) | ||
| 122 | (let ((d (call-with-input-file drv-path | ||
| 123 | read-derivation))) | ||
| 124 | (derivation-prerequisites-to-build | ||
| 125 | store d))) | ||
| 126 | drv)) | ||
| 127 | (req* (delete-duplicates | ||
| 128 | (append (remove (compose (cute valid-path? store <>) | ||
| 129 | derivation-path->output-path) | ||
| 130 | drv) | ||
| 131 | (map derivation-input-path req))))) | ||
| 132 | (if dry-run? | ||
| 133 | (format (current-error-port) | ||
| 134 | (N_ "~:[the following derivation would be built:~%~{ ~a~%~}~;~]" | ||
| 135 | "~:[the following derivations would be built:~%~{ ~a~%~}~;~]" | ||
| 136 | (length req*)) | ||
| 137 | (null? req*) req*) | ||
| 138 | (format (current-error-port) | ||
| 139 | (N_ "~:[the following derivation will be built:~%~{ ~a~%~}~;~]" | ||
| 140 | "~:[the following derivations will be built:~%~{ ~a~%~}~;~]" | ||
| 141 | (length req*)) | ||
| 142 | (null? req*) req*)))) | ||
| 143 | |||
| 115 | (define-syntax with-error-handling | 144 | (define-syntax with-error-handling |
| 116 | (syntax-rules () | 145 | (syntax-rules () |
| 117 | "Run BODY within a user-friendly error condition handler." | 146 | "Run BODY within a user-friendly error condition handler." |
