diff options
| -rw-r--r-- | doc/guix.texi | 18 | ||||
| -rw-r--r-- | guix/gexp.scm | 31 | ||||
| -rw-r--r-- | tests/gexp.scm | 7 |
3 files changed, 45 insertions, 11 deletions
diff --git a/doc/guix.texi b/doc/guix.texi index f05376efcf..39093a9c98 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -3125,9 +3125,11 @@ and these dependencies are automatically added as inputs to the build processes that use them. @end itemize +@cindex lowering, of high-level objects in gexps This mechanism is not limited to package and derivation objects: @dfn{compilers} able to ``lower'' other high-level objects to -derivations can be defined, such that these objects can also be inserted +derivations or files in the store can be defined, +such that these objects can also be inserted into gexps. For example, a useful type of high-level object that can be inserted in a gexp is ``file-like objects'', which make it easy to add files to the store and refer to them in @@ -3400,6 +3402,20 @@ also modules containing build tools. To make it clear that they are meant to be used in the build stratum, these modules are kept in the @code{(guix build @dots{})} name space. +@cindex lowering, of high-level objects in gexps +Internally, high-level objects are @dfn{lowered}, using their compiler, +to either derivations or store items. For instance, lowering a package +yields a derivation, and lowering a @code{plain-file} yields a store +item. This is achieved using the @code{lower-object} monadic procedure. + +@deffn {Monadic Procedure} lower-object @var{obj} [@var{system}] @ + [#:target #f] +Return as a value in @var{%store-monad} the derivation or store item +corresponding to @var{obj} for @var{system}, cross-compiling for +@var{target} if @var{target} is true. @var{obj} must be an object that +has an associated gexp compiler, such as a @code{<package>}. +@end deffn + @c ********************************************************************* @node Utilities diff --git a/guix/gexp.scm b/guix/gexp.scm index 49dcc99ac3..6dc816dc40 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -53,6 +53,7 @@ define-gexp-compiler gexp-compiler? + lower-object lower-inputs)) @@ -126,6 +127,16 @@ procedure to lower it; otherwise return #f." (and (predicate object) lower))) %gexp-compilers)) +(define* (lower-object obj + #:optional (system (%current-system)) + #:key target) + "Return as a value in %STORE-MONAD the derivation or store item +corresponding to OBJ for SYSTEM, cross-compiling for TARGET if TARGET is true. +OBJ must be an object that has an associated gexp compiler, such as a +<package>." + (let ((lower (lookup-compiler obj))) + (lower obj system target))) + (define-syntax-rule (define-gexp-compiler (name (param predicate) system target) body ...) @@ -258,8 +269,8 @@ the cross-compilation target triplet." (sequence %store-monad (map (match-lambda (((? struct? thing) sub-drv ...) - (mlet* %store-monad ((lower -> (lookup-compiler thing)) - (drv (lower thing system target))) + (mlet %store-monad ((drv (lower-object + thing system #:target target))) (return `(,drv ,@sub-drv)))) (input (return input))) @@ -288,13 +299,13 @@ names and file names suitable for the #:allowed-references argument to ((? string? output) (return output)) (($ <gexp-input> thing output native?) - (mlet* %store-monad ((lower -> (lookup-compiler thing)) - (drv (lower thing system - (if native? #f target)))) + (mlet %store-monad ((drv (lower-object thing system + #:target (if native? + #f target)))) (return (derivation->output-path drv output)))) (thing - (mlet* %store-monad ((lower -> (lookup-compiler thing)) - (drv (lower thing system target))) + (mlet %store-monad ((drv (lower-object thing system + #:target target))) (return (derivation->output-path drv)))))) (sequence %store-monad (map lower lst)))) @@ -540,9 +551,9 @@ and in the current monad setting (system type, etc.)" native?)) refs))) (($ <gexp-input> (? struct? thing) output n?) - (let ((lower (lookup-compiler thing)) - (target (if (or n? native?) #f target))) - (mlet %store-monad ((obj (lower thing system target))) + (let ((target (if (or n? native?) #f target))) + (mlet %store-monad ((obj (lower-object thing system + #:target target))) ;; OBJ must be either a derivation or a store file name. (return (match obj ((? derivation? drv) diff --git a/tests/gexp.scm b/tests/gexp.scm index 0749811ea8..492f3d6d89 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -654,6 +654,13 @@ (parameterize ((%current-target-system "fooooo")) (derivation? (run-with-store %store mval))))) +(test-assertm "lower-object" + (mlet %store-monad ((drv1 (lower-object %bootstrap-guile)) + (drv2 (lower-object (package-source coreutils))) + (item (lower-object (plain-file "foo" "Hello!")))) + (return (and (derivation? drv1) (derivation? drv2) + (store-path? item))))) + (test-assert "printer" (string-match "^#<gexp \\(string-append .*#<package coreutils.*\ \"/bin/uname\"\\) [[:xdigit:]]+>$" |