packages: Factorize things common to `package-{,cross-}derivation'.
* guix/packages.scm (expand-input): New procedure, moved out of... (package-derivation): ... here. Adjust accordingly. (package-cross-derivation): Add `cross-system' and `system' parameters.
This commit is contained in:
parent
7046c48d72
commit
a63062b55a
|
@ -27,6 +27,7 @@
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
#:use-module (srfi srfi-9 gnu)
|
#:use-module (srfi srfi-9 gnu)
|
||||||
#:use-module (srfi srfi-11)
|
#:use-module (srfi srfi-11)
|
||||||
|
#:use-module (srfi srfi-26)
|
||||||
#:use-module (srfi srfi-34)
|
#:use-module (srfi srfi-34)
|
||||||
#:use-module (srfi srfi-35)
|
#:use-module (srfi srfi-35)
|
||||||
#:re-export (%current-system)
|
#:re-export (%current-system)
|
||||||
|
@ -305,41 +306,47 @@ Return the cached result when available."
|
||||||
(#f
|
(#f
|
||||||
(cache package system thunk)))))
|
(cache package system thunk)))))
|
||||||
|
|
||||||
(define* (package-derivation store package
|
(define* (expand-input store package input system #:optional cross-system)
|
||||||
#:optional (system (%current-system)))
|
"Expand INPUT, an input tuple, such that it contains only references to
|
||||||
"Return the derivation path and corresponding <derivation> object of
|
derivation paths or store paths. PACKAGE is only used to provide contextual
|
||||||
PACKAGE for SYSTEM."
|
information in exceptions."
|
||||||
(define (intern file)
|
(define (intern file)
|
||||||
;; Add FILE to the store. Set the `recursive?' bit to #t, so that
|
;; Add FILE to the store. Set the `recursive?' bit to #t, so that
|
||||||
;; file permissions are preserved.
|
;; file permissions are preserved.
|
||||||
(add-to-store store (basename file) #t "sha256" file))
|
(add-to-store store (basename file) #t "sha256" file))
|
||||||
|
|
||||||
(define expand-input
|
(define derivation
|
||||||
;; Expand the given input tuple such that it contains only
|
(if cross-system
|
||||||
;; references to derivation paths or store paths.
|
(cut package-cross-derivation store <> cross-system system)
|
||||||
(match-lambda
|
(cut package-derivation store <> system)))
|
||||||
(((? string? name) (? package? package))
|
|
||||||
(list name (package-derivation store package system)))
|
|
||||||
(((? string? name) (? package? package)
|
|
||||||
(? string? sub-drv))
|
|
||||||
(list name (package-derivation store package system)
|
|
||||||
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 system)))
|
|
||||||
(x
|
|
||||||
(raise (condition (&package-input-error
|
|
||||||
(package package)
|
|
||||||
(input x)))))))
|
|
||||||
|
|
||||||
|
(match input
|
||||||
|
(((? string? name) (? package? package))
|
||||||
|
(list name (derivation package)))
|
||||||
|
(((? string? name) (? package? package)
|
||||||
|
(? string? sub-drv))
|
||||||
|
(list name (derivation 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 system)))
|
||||||
|
(x
|
||||||
|
(raise (condition (&package-input-error
|
||||||
|
(package package)
|
||||||
|
(input x)))))))
|
||||||
|
|
||||||
|
(define* (package-derivation store package
|
||||||
|
#:optional (system (%current-system)))
|
||||||
|
"Return the derivation path and corresponding <derivation> object of
|
||||||
|
PACKAGE for SYSTEM."
|
||||||
;; Compute the derivation and cache the result. Caching is important
|
;; Compute the derivation and cache the result. Caching is important
|
||||||
;; because some derivations, such as the implicit inputs of the GNU build
|
;; because some derivations, such as the implicit inputs of the GNU build
|
||||||
;; system, will be queried many, many times in a row.
|
;; system, will be queried many, many times in a row.
|
||||||
|
@ -353,7 +360,9 @@ PACKAGE for SYSTEM."
|
||||||
args inputs propagated-inputs native-inputs self-native-input?
|
args inputs propagated-inputs native-inputs self-native-input?
|
||||||
outputs)
|
outputs)
|
||||||
(let* ((inputs (package-transitive-inputs package))
|
(let* ((inputs (package-transitive-inputs package))
|
||||||
(input-drvs (map expand-input inputs))
|
(input-drvs (map (cut expand-input
|
||||||
|
store package <> system)
|
||||||
|
inputs))
|
||||||
(paths (delete-duplicates
|
(paths (delete-duplicates
|
||||||
(append-map (match-lambda
|
(append-map (match-lambda
|
||||||
((_ (? package? p) _ ...)
|
((_ (? package? p) _ ...)
|
||||||
|
@ -371,7 +380,8 @@ PACKAGE for SYSTEM."
|
||||||
#:outputs outputs #:system system
|
#:outputs outputs #:system system
|
||||||
(args))))))))
|
(args))))))))
|
||||||
|
|
||||||
(define* (package-cross-derivation store package)
|
(define* (package-cross-derivation store package cross-system
|
||||||
|
#:optional (system (%current-system)))
|
||||||
;; TODO
|
;; TODO
|
||||||
#f)
|
#f)
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue