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.
This commit is contained in:
Ludovic Courtès 2015-08-26 11:28:23 +02:00
parent f7283db37d
commit c2b8467645
3 changed files with 45 additions and 11 deletions

View file

@ -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

View file

@ -53,6 +53,7 @@ (define-module (guix gexp)
define-gexp-compiler
gexp-compiler?
lower-object
lower-inputs))
@ -126,6 +127,16 @@ (define (lookup-compiler object)
(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 @@ (define* (lower-inputs inputs
(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 @@ (define lower
((? 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 @@ (define* (reference->sexp ref #:optional native?)
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)

View file

@ -654,6 +654,13 @@ (define shebang
(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:]]+>$"