summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2015-08-26 11:28:23 +0200
committerLudovic Courtès <ludo@gnu.org>2015-08-27 00:49:23 +0200
commitc2b8467645bb2c2e17eb9c580f39e345c4dc2f4a (patch)
tree754462cfbcccdb8c58f000ee5bf88d064279b657
parentf7283db37d58f1a7dede5f410c6c0a75aa82b12e (diff)
downloadpatches-c2b8467645bb2c2e17eb9c580f39e345c4dc2f4a.tar
patches-c2b8467645bb2c2e17eb9c580f39e345c4dc2f4a.tar.gz
gexp: Add 'lower-object'.
* guix/gexp.scm (lower-object): New procedure. (lower-inputs, lower-references, gexp->sexp): Use it. * tests/gexp.scm ("lower-object"): New test. * doc/guix.texi (G-Expressions): Document it.
-rw-r--r--doc/guix.texi18
-rw-r--r--guix/gexp.scm31
-rw-r--r--tests/gexp.scm7
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:]]+>$"