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
parent
ef51ac21ee
commit
2dc98729af
|
|
@ -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)
|
||||
|
|
|
|||
25
guix/ui.scm
25
guix/ui.scm
|
|
@ -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*
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
|
|
|||
Loading…
Reference in New Issue