diff options
author | Ludovic Courtès <ludo@gnu.org> | 2013-04-17 00:06:59 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2013-04-17 00:08:21 +0200 |
commit | dd36b51bf7cffa389726ad997465b14f7072944a (patch) | |
tree | 7c80a1b36acd81841204444cf6d9fe0b016ff0cc /guix/ui.scm | |
parent | acb6ba256703da1db1d300541e15a4e7428f622b (diff) | |
download | gnu-guix-dd36b51bf7cffa389726ad997465b14f7072944a.tar gnu-guix-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.scm | 81 |
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 () |