[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
01/03: gexp: Add 'lower-object'.
From: |
Ludovic Courtès |
Subject: |
01/03: gexp: Add 'lower-object'. |
Date: |
Wed, 26 Aug 2015 22:49:33 +0000 |
civodul pushed a commit to branch master
in repository guix.
commit c2b8467645bb2c2e17eb9c580f39e345c4dc2f4a
Author: Ludovic Courtès <address@hidden>
Date: Wed Aug 26 11:28:23 2015 +0200
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.
---
doc/guix.texi | 18 +++++++++++++++++-
guix/gexp.scm | 31 +++++++++++++++++++++----------
tests/gexp.scm | 7 +++++++
3 files changed, 45 insertions(+), 11 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index f05376e..39093a9 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
address@hidden 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.
address@hidden 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.
+
address@hidden {Monadic Procedure} lower-object @var{obj} address@hidden @
+ [#: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
address@hidden if @var{target} is true. @var{obj} must be an object that
+has an associated gexp compiler, such as a @code{<package>}.
address@hidden deffn
+
@c *********************************************************************
@node Utilities
diff --git a/guix/gexp.scm b/guix/gexp.scm
index 49dcc99..6dc816d 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 0749811..492f3d6 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:]]+>$"