summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--guix/scripts/build.scm23
-rw-r--r--guix/scripts/package.scm28
-rw-r--r--guix/ui.scm29
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
120derivations 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."