gexp: Add '=>' syntax to import computed modules.
* guix/gexp.scm (imported-files)[file-pair]: Add case for pairs where the cdr is not a string. (imported-modules): Support '=>' syntax in MODULES. * tests/gexp.scm ("imported-files with file-like objects") ("gexp->derivation & with-imported-module & computed module"): New tests. * doc/guix.texi (G-Expressions): Document '=>' syntax for 'with-imported-modules'.master
parent
4c0c4db070
commit
d938a58bee
|
@ -4347,8 +4347,22 @@ of the @code{gexp?} type (see below.)
|
||||||
|
|
||||||
@deffn {Scheme Syntax} with-imported-modules @var{modules} @var{body}@dots{}
|
@deffn {Scheme Syntax} with-imported-modules @var{modules} @var{body}@dots{}
|
||||||
Mark the gexps defined in @var{body}@dots{} as requiring @var{modules}
|
Mark the gexps defined in @var{body}@dots{} as requiring @var{modules}
|
||||||
in their execution environment. @var{modules} must be a list of Guile
|
in their execution environment.
|
||||||
module names, such as @code{'((guix build utils) (guix build gremlin))}.
|
|
||||||
|
Each item in @var{modules} can be the name of a module, such as
|
||||||
|
@code{(guix build utils)}, or it can be a module name, followed by an
|
||||||
|
arrow, followed by a file-like object:
|
||||||
|
|
||||||
|
@example
|
||||||
|
`((guix build utils)
|
||||||
|
(guix gcrypt)
|
||||||
|
((guix config) => ,(scheme-file "config.scm"
|
||||||
|
#~(define-module @dots{}))))
|
||||||
|
@end example
|
||||||
|
|
||||||
|
@noindent
|
||||||
|
In the example above, the first two modules are taken from the search
|
||||||
|
path, and the last one is created from the given file-like object.
|
||||||
|
|
||||||
This form has @emph{lexical} scope: it has an effect on the gexps
|
This form has @emph{lexical} scope: it has an effect on the gexps
|
||||||
directly defined in @var{body}@dots{}, but not on those defined, say, in
|
directly defined in @var{body}@dots{}, but not on those defined, say, in
|
||||||
|
|
|
@ -912,13 +912,17 @@ environment."
|
||||||
(system (%current-system))
|
(system (%current-system))
|
||||||
(guile (%guile-for-build)))
|
(guile (%guile-for-build)))
|
||||||
"Return a derivation that imports FILES into STORE. FILES must be a list
|
"Return a derivation that imports FILES into STORE. FILES must be a list
|
||||||
of (FINAL-PATH . FILE-NAME) pairs; each FILE-NAME is read from the file
|
of (FINAL-PATH . FILE) pairs. Each FILE is mapped to FINAL-PATH in the
|
||||||
system, imported, and appears under FINAL-PATH in the resulting store path."
|
resulting store path. FILE can be either a file name, or a file-like object,
|
||||||
|
as returned by 'local-file' for example."
|
||||||
(define file-pair
|
(define file-pair
|
||||||
(match-lambda
|
(match-lambda
|
||||||
((final-path . file-name)
|
((final-path . (? string? file-name))
|
||||||
(mlet %store-monad ((file (interned-file file-name
|
(mlet %store-monad ((file (interned-file file-name
|
||||||
(basename final-path))))
|
(basename final-path))))
|
||||||
|
(return (list final-path file))))
|
||||||
|
((final-path . file-like)
|
||||||
|
(mlet %store-monad ((file (lower-object file-like system)))
|
||||||
(return (list final-path file))))))
|
(return (list final-path file))))))
|
||||||
|
|
||||||
(mlet %store-monad ((files (sequence %store-monad
|
(mlet %store-monad ((files (sequence %store-monad
|
||||||
|
@ -950,13 +954,27 @@ system, imported, and appears under FINAL-PATH in the resulting store path."
|
||||||
(guile (%guile-for-build))
|
(guile (%guile-for-build))
|
||||||
(module-path %load-path))
|
(module-path %load-path))
|
||||||
"Return a derivation that contains the source files of MODULES, a list of
|
"Return a derivation that contains the source files of MODULES, a list of
|
||||||
module names such as `(ice-9 q)'. All of MODULES must be in the MODULE-PATH
|
module names such as `(ice-9 q)'. All of MODULES must be either names of
|
||||||
search path."
|
modules to be found in the MODULE-PATH search path, or a module name followed
|
||||||
;; TODO: Determine the closure of MODULES, build the `.go' files,
|
by an arrow followed by a file-like object. For example:
|
||||||
;; canonicalize the source files through read/write, etc.
|
|
||||||
(let ((files (map (lambda (m)
|
(imported-modules `((guix build utils)
|
||||||
(let ((f (module->source-file-name m)))
|
(guix gcrypt)
|
||||||
(cons f (search-path* module-path f))))
|
((guix config) => ,(scheme-file …))))
|
||||||
|
|
||||||
|
In this example, the first two modules are taken from MODULE-PATH, and the
|
||||||
|
last one is created from the given <scheme-file> object."
|
||||||
|
(mlet %store-monad ((files
|
||||||
|
(mapm %store-monad
|
||||||
|
(match-lambda
|
||||||
|
(((module ...) '=> file)
|
||||||
|
(return
|
||||||
|
(cons (module->source-file-name module)
|
||||||
|
file)))
|
||||||
|
((module ...)
|
||||||
|
(let ((f (module->source-file-name module)))
|
||||||
|
(return
|
||||||
|
(cons f (search-path* module-path f))))))
|
||||||
modules)))
|
modules)))
|
||||||
(imported-files files #:name name #:system system
|
(imported-files files #:name name #:system system
|
||||||
#:guile guile)))
|
#:guile guile)))
|
||||||
|
|
|
@ -598,6 +598,23 @@
|
||||||
get-bytevector-all))))
|
get-bytevector-all))))
|
||||||
files))))))
|
files))))))
|
||||||
|
|
||||||
|
(test-assertm "imported-files with file-like objects"
|
||||||
|
(mlet* %store-monad ((plain -> (plain-file "foo" "bar!"))
|
||||||
|
(q-scm -> (search-path %load-path "ice-9/q.scm"))
|
||||||
|
(files -> `(("a/b/c" . ,q-scm)
|
||||||
|
("p/q" . ,plain)))
|
||||||
|
(drv (imported-files files)))
|
||||||
|
(mbegin %store-monad
|
||||||
|
(built-derivations (list drv))
|
||||||
|
(mlet %store-monad ((dir -> (derivation->output-path drv))
|
||||||
|
(plain* (text-file "foo" "bar!"))
|
||||||
|
(q-scm* (interned-file q-scm "c")))
|
||||||
|
(return
|
||||||
|
(and (string=? (readlink (string-append dir "/a/b/c"))
|
||||||
|
q-scm*)
|
||||||
|
(string=? (readlink (string-append dir "/p/q"))
|
||||||
|
plain*)))))))
|
||||||
|
|
||||||
(test-equal "gexp-modules & ungexp"
|
(test-equal "gexp-modules & ungexp"
|
||||||
'((bar) (foo))
|
'((bar) (foo))
|
||||||
((@@ (guix gexp) gexp-modules)
|
((@@ (guix gexp) gexp-modules)
|
||||||
|
@ -668,6 +685,28 @@
|
||||||
(equal? '(chdir "/foo")
|
(equal? '(chdir "/foo")
|
||||||
(call-with-input-file b read))))))))
|
(call-with-input-file b read))))))))
|
||||||
|
|
||||||
|
(test-assertm "gexp->derivation & with-imported-module & computed module"
|
||||||
|
(mlet* %store-monad
|
||||||
|
((module -> (scheme-file "x" #~(begin
|
||||||
|
(define-module (foo bar)
|
||||||
|
#:export (the-answer))
|
||||||
|
|
||||||
|
(define the-answer 42))))
|
||||||
|
(build -> (with-imported-modules `(((foo bar) => ,module)
|
||||||
|
(guix build utils))
|
||||||
|
#~(begin
|
||||||
|
(use-modules (guix build utils)
|
||||||
|
(foo bar))
|
||||||
|
mkdir-p
|
||||||
|
(call-with-output-file #$output
|
||||||
|
(lambda (port)
|
||||||
|
(write the-answer port))))))
|
||||||
|
(drv (gexp->derivation "thing" build))
|
||||||
|
(out -> (derivation->output-path drv)))
|
||||||
|
(mbegin %store-monad
|
||||||
|
(built-derivations (list drv))
|
||||||
|
(return (= 42 (call-with-input-file out read))))))
|
||||||
|
|
||||||
(test-assertm "gexp->derivation #:references-graphs"
|
(test-assertm "gexp->derivation #:references-graphs"
|
||||||
(mlet* %store-monad
|
(mlet* %store-monad
|
||||||
((one (text-file "one" (random-text)))
|
((one (text-file "one" (random-text)))
|
||||||
|
|
Reference in New Issue