~ruther/guix-local

2dc98729afb62e48b5866f599df9a9274d440686 — Ludovic Courtès 8 years ago ef51ac2
derivations: 'derivation-prerequisites-to-build' returns <substitutable>.

* guix/derivations.scm (derivation-prerequisites-to-build): Rename
 #:substitutable? to #:substitutable-info.
[derivation-substitutable?]: Rename to...
[derivation-substitutable-info]: ... this.  Return a list of <substitutable>.
Second return value is now a list of <substitutable> instead of a list
of strings.
* guix/ui.scm (show-what-to-build)[substitutable?]: Rename to...
[substitutable-info]: ... this.
Adjust to new 'derivation-prerequisites-to-build' return value type.
* tests/derivations.scm ("derivation-prerequisites-to-build and
substitutes"): Adjust.
("derivation-prerequisites-to-build and substitutes, local build"):
Likewise.
3 files changed, 36 insertions(+), 26 deletions(-)

M guix/derivations.scm
M guix/ui.scm
M tests/derivations.scm
M guix/derivations.scm => guix/derivations.scm +18 -13
@@ 334,13 334,13 @@ substituter many times."
                                            (mode (build-mode normal))
                                            (outputs
                                             (derivation-output-names drv))
                                            (substitutable?
                                            (substitutable-info
                                             (substitution-oracle store
                                                                  (list drv)
                                                                  #:mode mode)))
  "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.  SUBSTITUTABLE? must be a
of required store paths that can be substituted.  SUBSTITUTABLE-INFO must be a
one-argument procedure similar to that returned by 'substitution-oracle'."
  (define built?
    (cut valid-path? store <>))


@@ 351,7 351,7 @@ one-argument procedure similar to that returned by 'substitution-oracle'."
  (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))
    (compose (cut every substitutable-info <>) derivation-input-output-paths))

  (define (derivation-built? drv* sub-drvs)
    ;; In 'check' mode, assume that DRV is not built.


@@ 359,20 359,24 @@ one-argument procedure similar to that returned by 'substitution-oracle'."
                   (eq? drv* drv)))
         (every built? (derivation-output-paths drv* sub-drvs))))

  (define (derivation-substitutable? drv sub-drvs)
  (define (derivation-substitutable-info drv sub-drvs)
    (and (substitutable-derivation? drv)
         (every substitutable? (derivation-output-paths drv sub-drvs))))
         (let ((info (filter-map substitutable-info
                                 (derivation-output-paths drv sub-drvs))))
           (and (= (length info) (length sub-drvs))
                info))))

  (let loop ((drv        drv)
             (sub-drvs   outputs)
             (build      '())
             (substitute '()))
             (build      '())                     ;list of <derivation-input>
             (substitute '()))                    ;list of <substitutable>
    (cond ((derivation-built? drv sub-drvs)
           (values build substitute))
          ((derivation-substitutable? drv sub-drvs)
           (values build
                   (append (derivation-output-paths drv sub-drvs)
                           substitute)))
          ((derivation-substitutable-info drv sub-drvs)
           =>
           (lambda (substitutables)
             (values build
                     (append substitutables substitute))))
          (else
           (let ((build  (if (substitutable-derivation? drv)
                             build


@@ 389,8 393,9 @@ one-argument procedure similar to that returned by 'substitution-oracle'."
                    (append (append-map (lambda (input)
                                          (if (and (not (input-built? input))
                                                   (input-substitutable? input))
                                              (derivation-input-output-paths
                                               input)
                                              (map substitutable-info
                                                   (derivation-input-output-paths
                                                    input))
                                              '()))
                                        (derivation-inputs drv))
                            substitute)

M guix/ui.scm => guix/ui.scm +15 -10
@@ 588,7 588,7 @@ error."
derivations listed in DRV using MODE, a 'build-mode' value.  Return #t if
there's something to build, #f otherwise.  When USE-SUBSTITUTES?, check and
report what is prerequisites are available for download."
  (define substitutable?
  (define substitutable-info
    ;; Call 'substitutation-oracle' upfront so we don't end up launching the
    ;; substituter many times.  This makes a big difference, especially when
    ;; DRV is a long list as is the case with 'guix environment'.


@@ 600,7 600,7 @@ report what is prerequisites are available for download."
    (or (null? (derivation-outputs drv))
        (let ((out (derivation->output-path drv))) ;XXX: assume "out" exists
          (or (valid-path? store out)
              (substitutable? out)))))
              (substitutable-info out)))))

  (let*-values (((build download)
                 (fold2 (lambda (drv build download)


@@ 608,7 608,8 @@ report what is prerequisites are available for download."
                                        (derivation-prerequisites-to-build
                                         store drv
                                         #:mode mode
                                         #:substitutable? substitutable?)))
                                         #:substitutable-info
                                         substitutable-info)))
                            (values (append b build)
                                    (append d download))))
                        '() '()


@@ 622,11 623,13 @@ report what is prerequisites are available for download."
                 (if use-substitutes?
                     (delete-duplicates
                      (append download
                              (remove (cut valid-path? store <>)
                                      (append-map
                                       substitutable-references
                                       (substitutable-path-info store
                                                                download)))))
                              (filter-map (lambda (item)
                                            (if (valid-path? store item)
                                                #f
                                                (substitutable-info item)))
                                          (append-map
                                           substitutable-references
                                           download))))
                     download)))
    ;; TODO: Show the installed size of DOWNLOAD.
    (if dry-run?


@@ 640,7 643,8 @@ report what is prerequisites are available for download."
                  (N_ "~:[The following file would be downloaded:~%~{   ~a~%~}~;~]"
                      "~:[The following files would be downloaded:~%~{   ~a~%~}~;~]"
                      (length download))
                  (null? download) download))
                  (null? download)
                  (map substitutable-path download)))
        (begin
          (format (current-error-port)
                  (N_ "~:[The following derivation will be built:~%~{   ~a~%~}~;~]"


@@ 651,7 655,8 @@ report what is prerequisites are available for download."
                  (N_ "~:[The following file will be downloaded:~%~{   ~a~%~}~;~]"
                      "~:[The following files will be downloaded:~%~{   ~a~%~}~;~]"
                      (length download))
                  (null? download) download)))
                  (null? download)
                  (map substitutable-path download))))
    (pair? build)))

(define show-what-to-build*

M tests/derivations.scm => tests/derivations.scm +3 -3
@@ 831,10 831,10 @@
                    (derivation-prerequisites-to-build store drv))
                   ((build* download*)
                    (derivation-prerequisites-to-build store drv
                                                       #:substitutable?
                                                       #:substitutable-info
                                                       (const #f))))
        (and (null? build)
             (equal? download (list output))
             (equal? (map substitutable-path download) (list output))
             (null? download*)
             (null? build*))))))



@@ 879,7 879,7 @@
          ;; See <http://bugs.gnu.org/18747>.
          (and (null? build)
               (match download
                 (((? string? item))
                 (((= substitutable-path item))
                  (string=? item (derivation->output-path drv))))))))))

(test-assert "derivation-prerequisites-to-build in 'check' mode"