diff options
author | Ludovic Courtès <ludo@gnu.org> | 2015-01-14 14:42:10 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2015-01-14 14:42:10 +0100 |
commit | f220a8384890b2a50f30c62fba56e507333f1a92 (patch) | |
tree | c51640dc8115aecb8f7b3ffc055f6b2e066d16f7 /guix/packages.scm | |
parent | 023d9892c0411adb523e6bc8337be3e7e94e606f (diff) | |
download | gnu-guix-f220a8384890b2a50f30c62fba56e507333f1a92.tar gnu-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.scm | 73 |
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)) |