diff options
Diffstat (limited to 'guix/packages.scm')
| -rw-r--r-- | guix/packages.scm | 127 |
1 files changed, 93 insertions, 34 deletions
diff --git a/guix/packages.scm b/guix/packages.scm index 68fd531c6b..db14f9e0b8 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2014 Mark H Weaver <mhw@netris.org> ;;; ;;; This file is part of GNU Guix. @@ -21,6 +21,7 @@ #:use-module (guix utils) #:use-module (guix records) #:use-module (guix store) + #:use-module (guix monads) #:use-module (guix base32) #:use-module (guix derivations) #:use-module (guix build-system) @@ -108,7 +109,15 @@ bag-transitive-inputs bag-transitive-host-inputs bag-transitive-build-inputs - bag-transitive-target-inputs)) + bag-transitive-target-inputs + + default-guile + + set-guile-for-build + package-file + package->derivation + package->cross-derivation + origin->derivation)) ;;; Commentary: ;;; @@ -322,10 +331,12 @@ corresponds to the arguments expected by `set-path-environment-variable'." ("patch" ,(ref '(gnu packages base) 'patch))))) (define (default-guile) - "Return the default Guile package for SYSTEM." + "Return the default Guile package used to run the build code of +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 '()) @@ -474,37 +485,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 '())) @@ -907,3 +887,82 @@ symbolic output name, such as \"out\". Note that this procedure calls `package-derivation', which is costly." (let ((drv (package-derivation store package system))) (derivation->output-path drv output))) + + +;;; +;;; Monadic interface. +;;; + +(define (set-guile-for-build guile) + "This monadic procedure changes the Guile currently used to run the build +code of derivations to GUILE, a package object." + (lambda (store) + (let ((guile (package-derivation store guile))) + (%guile-for-build guile)))) + +(define* (package-file package + #:optional file + #:key + system (output "out") target) + "Return as a monadic value the absolute file name of FILE within the +OUTPUT directory of PACKAGE. When FILE is omitted, return the name of the +OUTPUT directory of PACKAGE. When TARGET is true, use it as a +cross-compilation target triplet." + (lambda (store) + (define compute-derivation + (if target + (cut package-cross-derivation <> <> target <>) + package-derivation)) + + (let* ((system (or system (%current-system))) + (drv (compute-derivation store package system)) + (out (derivation->output-path drv output))) + (if file + (string-append out "/" file) + out)))) + +(define package->derivation + (store-lift package-derivation)) + +(define package->cross-derivation + (store-lift package-cross-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)) |