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.

1 files changed, 82 insertions, 35 deletions

diff --git a/guix/derivations.scm b/guix/derivations.scm
index 2243d2ba46..cf329819c4 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -48,6 +48,7 @@
             derivation-input?
             derivation-input-path
             derivation-input-sub-derivations
+            derivation-input-output-paths
 
             fixed-output-derivation?
             derivation-hash
@@ -99,6 +100,14 @@ download with a fixed hash (aka. `fetchurl')."
      #t)
     (_ #f)))
 
+(define (derivation-input-output-paths input)
+  "Return the list of output paths corresponding to INPUT, a
+<derivation-input>."
+  (match input
+    (($ <derivation-input> path sub-drvs)
+     (map (cut derivation-path->output-path path <>)
+          sub-drvs))))
+
 (define (derivation-prerequisites drv)
   "Return the list of derivation-inputs required to build DRV, recursively."
   (let loop ((drv    drv)
@@ -113,47 +122,85 @@ download with a fixed hash (aka. `fetchurl')."
                  inputs)))))
 
 (define* (derivation-prerequisites-to-build store drv
-                                            #:key (outputs
-                                                   (map
-                                                    car
-                                                    (derivation-outputs drv))))
-  "Return the list of derivation-inputs required to build the OUTPUTS of
-DRV and not already available in STORE, recursively."
+                                            #:key
+                                            (outputs
+                                             (map
+                                              car
+                                              (derivation-outputs drv)))
+                                            (use-substitutes? #t))
+  "Return two values: the list of derivation-inputs required to build the
+OUTPUTS of DRV and not already available in STORE, recursively, and the list
+of required store paths that can be substituted.  When USE-SUBSTITUTES? is #f,
+that second value is the empty list."
+  (define (derivation-output-paths drv sub-drvs)
+    (match drv
+      (($ <derivation> outputs)
+       (map (lambda (sub-drv)
+              (derivation-output-path (assoc-ref outputs sub-drv)))
+            sub-drvs))))
+
   (define built?
     (cut valid-path? store <>))
 
+  (define substitutable?
+    ;; Return true if the given path is substitutable.  Call
+    ;; `substitutable-paths' upfront, to benefit from parallelism in the
+    ;; substituter.
+    (if use-substitutes?
+        (let ((s (substitutable-paths store
+                                      (append
+                                       (derivation-output-paths drv outputs)
+                                       (append-map
+                                        derivation-input-output-paths
+                                        (derivation-prerequisites drv))))))
+          (cut member <> s))
+        (const #f)))
+
   (define input-built?
-    (match-lambda
-     (($ <derivation-input> path sub-drvs)
-      (let ((out (map (cut derivation-path->output-path path <>)
-                      sub-drvs)))
-        (any built? out)))))
+    (compose (cut any built? <>) derivation-input-output-paths))
+
+  (define input-substitutable?
+    ;; Return true if and only if all of SUB-DRVS are subsitutable.  If at
+    ;; least one is missing, then everything must be rebuilt.
+    (compose (cut every substitutable? <>) derivation-input-output-paths))
 
   (define (derivation-built? drv sub-drvs)
-    (match drv
-      (($ <derivation> outputs)
-       (let ((paths (map (lambda (sub-drv)
-                           (derivation-output-path
-                            (assoc-ref outputs sub-drv)))
-                         sub-drvs)))
-         (every built? paths)))))
-
-  (let loop ((drv      drv)
-             (sub-drvs outputs)
-             (result   '()))
-    (if (derivation-built? drv sub-drvs)
-        result
-        (let ((inputs (remove (lambda (i)
-                                (or (member i result) ; XXX: quadratic
-                                    (input-built? i)))
-                              (derivation-inputs drv))))
-          (fold loop
-                (append inputs result)
-                (map (lambda (i)
-                       (call-with-input-file (derivation-input-path i)
-                         read-derivation))
-                     inputs)
-                (map derivation-input-sub-derivations inputs))))))
+    (every built? (derivation-output-paths drv sub-drvs)))
+
+  (define (derivation-substitutable? drv sub-drvs)
+    (every substitutable? (derivation-output-paths drv sub-drvs)))
+
+  (let loop ((drv        drv)
+             (sub-drvs   outputs)
+             (build      '())
+             (substitute '()))
+    (cond ((derivation-built? drv sub-drvs)
+           (values build substitute))
+          ((derivation-substitutable? drv sub-drvs)
+           (values build
+                   (append (derivation-output-paths drv sub-drvs)
+                           substitute)))
+          (else
+           (let ((inputs (remove (lambda (i)
+                                   (or (member i build) ; XXX: quadratic
+                                       (input-built? i)
+                                       (input-substitutable? i)))
+                                 (derivation-inputs drv))))
+             (fold2 loop
+                    (append inputs build)
+                    (append (append-map (lambda (input)
+                                          (if (and (not (input-built? input))
+                                                   (input-substitutable? input))
+                                              (derivation-input-output-paths
+                                               input)
+                                              '()))
+                                        (derivation-inputs drv))
+                            substitute)
+                    (map (lambda (i)
+                           (call-with-input-file (derivation-input-path i)
+                             read-derivation))
+                         inputs)
+                    (map derivation-input-sub-derivations inputs)))))))
 
 (define (%read-derivation drv-port)
   ;; Actually read derivation from DRV-PORT.