From dd36b51bf7cffa389726ad997465b14f7072944a Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Wed, 17 Apr 2013 00:06:59 +0200
Subject: 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.
---
 guix/ui.scm | 81 +++++++++++++++++++++++++++++++++++++++++++------------------
 1 file changed, 57 insertions(+), 24 deletions(-)

(limited to 'guix/ui.scm')

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 ()
-- 
cgit v1.2.3