aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2013-05-20 23:00:47 +0200
committerLudovic Courtès <ludo@gnu.org>2013-05-24 08:58:52 +0200
commita63062b55a6592467816571fd7983f4e88903c0a (patch)
tree2e81a3bfe0f84397d0f8f730fbb0ab0445e5f425
parent7046c48d721dfc0c733d2d31a4251e97ab581ed8 (diff)
downloadguix-a63062b55a6592467816571fd7983f4e88903c0a.tar
guix-a63062b55a6592467816571fd7983f4e88903c0a.tar.gz
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.
-rw-r--r--guix/packages.scm72
1 files changed, 41 insertions, 31 deletions
diff --git a/guix/packages.scm b/guix/packages.scm
index 0549771cea..242b912d5d 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -27,6 +27,7 @@
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9 gnu)
#:use-module (srfi srfi-11)
+ #:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:re-export (%current-system)
@@ -305,41 +306,47 @@ Return the cached result when available."
(#f
(cache package system thunk)))))
-(define* (package-derivation store package
- #:optional (system (%current-system)))
- "Return the derivation path and corresponding <derivation> object of
-PACKAGE for SYSTEM."
+(define* (expand-input store package input system #:optional cross-system)
+ "Expand INPUT, an input tuple, such that it contains only references to
+derivation paths or store paths. PACKAGE is only used to provide contextual
+information in exceptions."
(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 "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 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)))))))
+ (define derivation
+ (if cross-system
+ (cut package-cross-derivation store <> cross-system system)
+ (cut package-derivation store <> system)))
+
+ (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
;; because some derivations, such as the implicit inputs of the GNU build
;; 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?
outputs)
(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
(append-map (match-lambda
((_ (? package? p) _ ...)
@@ -371,7 +380,8 @@ PACKAGE for SYSTEM."
#:outputs outputs #:system system
(args))))))))
-(define* (package-cross-derivation store package)
+(define* (package-cross-derivation store package cross-system
+ #:optional (system (%current-system)))
;; TODO
#f)