aboutsummaryrefslogtreecommitdiff
path: root/guix/packages.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2015-01-14 14:42:10 +0100
committerLudovic Courtès <ludo@gnu.org>2015-01-14 14:42:10 +0100
commitf220a8384890b2a50f30c62fba56e507333f1a92 (patch)
treec51640dc8115aecb8f7b3ffc055f6b2e066d16f7 /guix/packages.scm
parent023d9892c0411adb523e6bc8337be3e7e94e606f (diff)
downloadguix-f220a8384890b2a50f30c62fba56e507333f1a92.tar
guix-f220a8384890b2a50f30c62fba56e507333f1a92.tar.gz
packages: Convert source derivations to monadic style.
* guix/packages.scm (origin->derivation): Take body from 'package-source-derivation', and change it to monadic style. Expect METHOD to a monadic procedure. (package-source-derivation): Define in terms of 'origin->derivation'. * guix/download.scm (url-fetch): Remove 'store' argument. Remove 'guile-for-build' variable. Turn into a monadic procedure. * guix/git-download.scm (git-fetch): Likewise. * guix/svn-download.scm (svn-fetch): Likewise. * tests/builders.scm (url-fetch*): New procedure. Change tests to call 'url-fetch*' instead of 'url-fetch'. * tests/packages.scm ("package-source-derivation, snippet"): Remove 'store' parameter of 'fetch' and change it to use 'interned-file' instead of 'add-to-store'. * gnu/packages/bootstrap.scm (bootstrap-origin)[boot]: Remove 'store' parameter.
Diffstat (limited to 'guix/packages.scm')
-rw-r--r--guix/packages.scm73
1 files changed, 40 insertions, 33 deletions
diff --git a/guix/packages.scm b/guix/packages.scm
index 909aa6d90d..05ba389ad6 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -331,6 +331,7 @@ derivations."
(let ((distro (resolve-interface '(gnu packages commencement))))
(module-ref distro 'guile-final)))
+;; TODO: Rewrite using %STORE-MONAD and gexps.
(define* (patch-and-repack store source patches
#:key
(inputs '())
@@ -476,37 +477,6 @@ IMPORTED-MODULES specify modules to use/import for use by SNIPPET."
#:modules modules
#:guile-for-build guile-for-build)))
-(define* (package-source-derivation store source
- #:optional (system (%current-system)))
- "Return the derivation path for SOURCE, a package source, for SYSTEM."
- (match source
- (($ <origin> uri method sha256 name () #f)
- ;; No patches, no snippet: this is a fixed-output derivation.
- (method store uri 'sha256 sha256 name
- #:system system))
- (($ <origin> uri method sha256 name (patches ...) snippet
- (flags ...) inputs (modules ...) (imported-modules ...)
- guile-for-build)
- ;; Patches and/or a snippet.
- (let ((source (method store uri 'sha256 sha256 name
- #:system system))
- (guile (match (or guile-for-build (default-guile))
- ((? package? p)
- (package-derivation store p system
- #:graft? #f)))))
- (patch-and-repack store source patches
- #:inputs inputs
- #:snippet snippet
- #:flags flags
- #:system system
- #:modules modules
- #:imported-modules modules
- #:guile-for-build guile)))
- ((and (? string?) (? direct-store-path?) file)
- file)
- ((? string? file)
- (add-to-store store (basename file) #t "sha256" file))))
-
(define (transitive-inputs inputs)
(let loop ((inputs inputs)
(result '()))
@@ -949,5 +919,42 @@ cross-compilation target triplet."
(define package->cross-derivation
(store-lift package-cross-derivation))
-(define origin->derivation
- (store-lift package-source-derivation))
+(define patch-and-repack*
+ (store-lift patch-and-repack))
+
+(define* (origin->derivation source
+ #:optional (system (%current-system)))
+ "When SOURCE is an <origin> object, return its derivation for SYSTEM. When
+SOURCE is a file name, return either the interned file name (if SOURCE is
+outside of the store) or SOURCE itself (if SOURCE is already a store item.)"
+ (match source
+ (($ <origin> uri method sha256 name () #f)
+ ;; No patches, no snippet: this is a fixed-output derivation.
+ (method uri 'sha256 sha256 name #:system system))
+ (($ <origin> uri method sha256 name (patches ...) snippet
+ (flags ...) inputs (modules ...) (imported-modules ...)
+ guile-for-build)
+ ;; Patches and/or a snippet.
+ (mlet %store-monad ((source (method uri 'sha256 sha256 name
+ #:system system))
+ (guile (package->derivation (or guile-for-build
+ (default-guile))
+ system
+ #:graft? #f)))
+ (patch-and-repack* source patches
+ #:inputs inputs
+ #:snippet snippet
+ #:flags flags
+ #:system system
+ #:modules modules
+ #:imported-modules modules
+ #:guile-for-build guile)))
+ ((and (? string?) (? direct-store-path?) file)
+ (with-monad %store-monad
+ (return file)))
+ ((? string? file)
+ (interned-file file (basename file)
+ #:recursive? #t))))
+
+(define package-source-derivation
+ (store-lower origin->derivation))