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.
This commit is contained in:
Ludovic Courtès 2017-05-31 11:06:42 +02:00
parent ef51ac21ee
commit 2dc98729af
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
3 changed files with 36 additions and 26 deletions

View File

@ -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)
((derivation-substitutable-info drv sub-drvs)
=>
(lambda (substitutables)
(values build
(append (derivation-output-paths drv sub-drvs)
substitute)))
(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))
(map substitutable-info
(derivation-input-output-paths
input)
input))
'()))
(derivation-inputs drv))
substitute)

View File

@ -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 <>)
(filter-map (lambda (item)
(if (valid-path? store item)
#f
(substitutable-info item)))
(append-map
substitutable-references
(substitutable-path-info store
download)))))
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*

View File

@ -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"