mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-07 07:26:13 -05:00
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:
parent
f7283db37d
commit
c2b8467645
3 changed files with 45 additions and 11 deletions
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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:]]+>$"
|
||||
|
|
Loading…
Reference in a new issue