summaryrefslogtreecommitdiff
path: root/guix/ui.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2013-04-17 00:06:59 +0200
committerLudovic Courtès <ludo@gnu.org>2013-04-17 00:08:21 +0200
commitdd36b51bf7cffa389726ad997465b14f7072944a (patch)
tree7c80a1b36acd81841204444cf6d9fe0b016ff0cc /guix/ui.scm
parentacb6ba256703da1db1d300541e15a4e7428f622b (diff)
downloadguix-patches-dd36b51bf7cffa389726ad997465b14f7072944a.tar
guix-patches-dd36b51bf7cffa389726ad997465b14f7072944a.tar.gz
scripts: Report what will be substituted.
* guix/derivations.scm (derivation-input-output-paths): New procedure. (derivation-prerequisites-to-build): New `use-substitutes?' keyword argument. Change two return the list of substitutable paths as a second argument. * guix/ui.scm (show-what-to-build): Turn `dry-run?' into a keyword argument. New `use-substitutes?' keyword argument. Use `fold2' and adjust to use both return values of `derivation-prerequisites-to-build'. Display what will/would be downloaded. * guix/scripts/build.scm (guix-build): Adjust accordingly. * guix/scripts/package.scm (guix-package): Likewise. * tests/derivations.scm ("derivation-prerequisites-to-build and substitutes"): New test.
Diffstat (limited to 'guix/ui.scm')
-rw-r--r--guix/ui.scm81
1 files changed, 57 insertions, 24 deletions
diff --git a/guix/ui.scm b/guix/ui.scm
index dfb6418a10..db0711bb61 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -144,33 +144,66 @@ error."
(leave (_ "expression `~s' does not evaluate to a package~%")
exp)))))
-(define* (show-what-to-build store drv #:optional dry-run?)
+(define* (show-what-to-build store drv
+ #:key dry-run? (use-substitutes? #t))
"Show what will or would (depending on DRY-RUN?) be built in realizing the
derivations listed in DRV. Return #t if there's something to build, #f
-otherwise."
- (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)))))
+otherwise. When USE-SUBSTITUTES?, check and report what is prerequisites are
+available for download."
+ (let*-values (((build download)
+ (fold2 (lambda (drv-path build download)
+ (let ((drv (call-with-input-file drv-path
+ read-derivation)))
+ (let-values (((b d)
+ (derivation-prerequisites-to-build
+ store drv
+ #:use-substitutes?
+ use-substitutes?)))
+ (values (append b build)
+ (append d download)))))
+ '() '()
+ drv))
+ ((build) ; add the DRV themselves
+ (delete-duplicates
+ (append (remove (compose (lambda (out)
+ (or (valid-path? store out)
+ (and use-substitutes?
+ (has-substitutes? store
+ out))))
+ derivation-path->output-path)
+ drv)
+ (map derivation-input-path build))))
+ ((download) ; add the references of DOWNLOAD
+ (delete-duplicates
+ (append download
+ (remove (cut valid-path? store <>)
+ (append-map
+ substitutable-references
+ (substitutable-path-info store download)))))))
(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*))
- (pair? req*)))
+ (begin
+ (format (current-error-port)
+ (N_ "~:[the following derivation would be built:~%~{ ~a~%~}~;~]"
+ "~:[the following derivations would be built:~%~{ ~a~%~}~;~]"
+ (length build))
+ (null? build) build)
+ (format (current-error-port)
+ (N_ "~:[the following file would be downloaded:~%~{ ~a~%~}~;~]"
+ "~:[the following files would be downloaded:~%~{ ~a~%~}~;~]"
+ (length download))
+ (null? download) download))
+ (begin
+ (format (current-error-port)
+ (N_ "~:[the following derivation will be built:~%~{ ~a~%~}~;~]"
+ "~:[the following derivations will be built:~%~{ ~a~%~}~;~]"
+ (length build))
+ (null? build) build)
+ (format (current-error-port)
+ (N_ "~:[the following file will be downloaded:~%~{ ~a~%~}~;~]"
+ "~:[the following files will be downloaded:~%~{ ~a~%~}~;~]"
+ (length download))
+ (null? download) download)))
+ (pair? build)))
(define-syntax with-error-handling
(syntax-rules ()