packages: Add support for system-dependent inputs.
* guix/packages.scm (package-derivation)[intern]: New procedure. Pass #t as the `recursive?' argument, instead of #f. [expand-input]: New procedure, with code formerly in the body. Support inputs where the input is a procedure returning a file name or an <origin>. Use `expand-input' in the body. * tests/packages.scm ("trivial with system-dependent input"): New test.master
parent
095c7a2683
commit
592ef6c88f
|
@ -227,6 +227,51 @@ recursively."
|
||||||
(define* (package-derivation store package
|
(define* (package-derivation store package
|
||||||
#:optional (system (%current-system)))
|
#:optional (system (%current-system)))
|
||||||
"Return the derivation of PACKAGE for SYSTEM."
|
"Return the derivation of PACKAGE for SYSTEM."
|
||||||
|
(define (intern file)
|
||||||
|
;; Add FILE to the store. Set the `recursive?' bit to #t, so that
|
||||||
|
;; file permissions are preserved.
|
||||||
|
(add-to-store store (basename file)
|
||||||
|
#t #t "sha256" file))
|
||||||
|
|
||||||
|
(define expand-input
|
||||||
|
;; Expand the given input tuple such that it contains only
|
||||||
|
;; references to derivation paths or store paths.
|
||||||
|
(match-lambda
|
||||||
|
(((? string? name) (? package? package))
|
||||||
|
(list name (package-derivation store package)))
|
||||||
|
(((? string? name) (? package? package)
|
||||||
|
(? string? sub-drv))
|
||||||
|
(list name (package-derivation store package)
|
||||||
|
sub-drv))
|
||||||
|
(((? string? name)
|
||||||
|
(and (? string?) (? derivation-path?) drv))
|
||||||
|
(list name drv))
|
||||||
|
(((? string? name)
|
||||||
|
(and (? string?) (? file-exists? file)))
|
||||||
|
;; Add FILE to the store. When FILE is in the sub-directory of a
|
||||||
|
;; store path, it needs to be added anyway, so it can be used as a
|
||||||
|
;; source.
|
||||||
|
(list name (intern file)))
|
||||||
|
(((? string? name) (? origin? source))
|
||||||
|
(list name (package-source-derivation store source)))
|
||||||
|
((and i ((? string? name) (? procedure? proc) sub-drv ...))
|
||||||
|
;; This form allows PROC to make a SYSTEM-dependent choice.
|
||||||
|
|
||||||
|
;; XXX: Currently PROC must return a .drv, a store path, a local
|
||||||
|
;; file name, or an <origin>. If it were allowed to return a
|
||||||
|
;; package, then `transitive-inputs' and co. would need to be
|
||||||
|
;; adjusted.
|
||||||
|
(let ((input (proc system)))
|
||||||
|
(if (or (string? input) (origin? input))
|
||||||
|
(expand-input (cons* name input sub-drv))
|
||||||
|
(raise (condition (&package-input-error
|
||||||
|
(package package)
|
||||||
|
(input i)))))))
|
||||||
|
(x
|
||||||
|
(raise (condition (&package-input-error
|
||||||
|
(package package)
|
||||||
|
(input x)))))))
|
||||||
|
|
||||||
(or (cached-derivation package system)
|
(or (cached-derivation package system)
|
||||||
|
|
||||||
;; Compute the derivation and cache the result. Caching is
|
;; Compute the derivation and cache the result. Caching is
|
||||||
|
@ -241,31 +286,7 @@ recursively."
|
||||||
outputs)
|
outputs)
|
||||||
;; TODO: For `search-paths', add a builder prologue that calls
|
;; TODO: For `search-paths', add a builder prologue that calls
|
||||||
;; `set-path-environment-variable'.
|
;; `set-path-environment-variable'.
|
||||||
(let ((inputs (map (match-lambda
|
(let ((inputs (map expand-input
|
||||||
(((? string? name) (? package? package))
|
|
||||||
(list name (package-derivation store package)))
|
|
||||||
(((? string? name) (? package? package)
|
|
||||||
(? string? sub-drv))
|
|
||||||
(list name (package-derivation store package)
|
|
||||||
sub-drv))
|
|
||||||
(((? string? name)
|
|
||||||
(and (? string?) (? derivation-path?) drv))
|
|
||||||
(list name drv))
|
|
||||||
(((? string? name)
|
|
||||||
(and (? string?) (? file-exists? file)))
|
|
||||||
;; Add FILE to the store. When FILE is in the
|
|
||||||
;; sub-directory of a store path, it needs to be
|
|
||||||
;; added anyway, so it can be used as a source.
|
|
||||||
(list name
|
|
||||||
(add-to-store store (basename file)
|
|
||||||
#t #f "sha256" file)))
|
|
||||||
(((? string? name) (? origin? source))
|
|
||||||
(list name
|
|
||||||
(package-source-derivation store source)))
|
|
||||||
(x
|
|
||||||
(raise (condition (&package-input-error
|
|
||||||
(package package)
|
|
||||||
(input x))))))
|
|
||||||
(package-transitive-inputs package))))
|
(package-transitive-inputs package))))
|
||||||
|
|
||||||
(apply builder
|
(apply builder
|
||||||
|
|
|
@ -95,6 +95,25 @@
|
||||||
(equal? '(hello guix)
|
(equal? '(hello guix)
|
||||||
(call-with-input-file (string-append p "/test") read))))))
|
(call-with-input-file (string-append p "/test") read))))))
|
||||||
|
|
||||||
|
(test-assert "trivial with system-dependent input"
|
||||||
|
(let* ((p (package (inherit (dummy-package "trivial-system-dependent-input"))
|
||||||
|
(build-system trivial-build-system)
|
||||||
|
(source #f)
|
||||||
|
(arguments
|
||||||
|
`(#:guile ,%bootstrap-guile
|
||||||
|
#:builder
|
||||||
|
(let ((out (assoc-ref %outputs "out"))
|
||||||
|
(bash (assoc-ref %build-inputs "bash")))
|
||||||
|
(zero? (system* bash "-c"
|
||||||
|
(format #f "echo hello > ~a" out))))))
|
||||||
|
(inputs `(("bash" ,(lambda (system)
|
||||||
|
(search-bootstrap-binary "bash"
|
||||||
|
system)))))))
|
||||||
|
(d (package-derivation %store p)))
|
||||||
|
(and (build-derivations %store (list d))
|
||||||
|
(let ((p (pk 'drv d (derivation-path->output-path d))))
|
||||||
|
(eq? 'hello (call-with-input-file p read))))))
|
||||||
|
|
||||||
(test-assert "GNU Hello"
|
(test-assert "GNU Hello"
|
||||||
(let ((hello (package-with-explicit-inputs hello %bootstrap-inputs
|
(let ((hello (package-with-explicit-inputs hello %bootstrap-inputs
|
||||||
#:guile %bootstrap-guile)))
|
#:guile %bootstrap-guile)))
|
||||||
|
|
Reference in New Issue