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'.
This commit is contained in:
Ludovic Courtès 2017-03-15 22:14:36 +01:00
parent 4c0c4db070
commit d938a58bee
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
3 changed files with 84 additions and 13 deletions

@ -4347,8 +4347,22 @@ of the @code{gexp?} type (see below.)
@deffn {Scheme Syntax} with-imported-modules @var{modules} @var{body}@dots{}
Mark the gexps defined in @var{body}@dots{} as requiring @var{modules}
in their execution environment. @var{modules} must be a list of Guile
module names, such as @code{'((guix build utils) (guix build gremlin))}.
in their execution environment.
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
directly defined in @var{body}@dots{}, but not on those defined, say, in

@ -912,13 +912,17 @@ environment."
(system (%current-system))
(guile (%guile-for-build)))
"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
system, imported, and appears under FINAL-PATH in the resulting store path."
of (FINAL-PATH . FILE) pairs. Each FILE is mapped to FINAL-PATH in the
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
(match-lambda
((final-path . file-name)
((final-path . (? string? file-name))
(mlet %store-monad ((file (interned-file file-name
(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))))))
(mlet %store-monad ((files (sequence %store-monad
@ -950,14 +954,28 @@ system, imported, and appears under FINAL-PATH in the resulting store path."
(guile (%guile-for-build))
(module-path %load-path))
"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
search path."
;; TODO: Determine the closure of MODULES, build the `.go' files,
;; canonicalize the source files through read/write, etc.
(let ((files (map (lambda (m)
(let ((f (module->source-file-name m)))
(cons f (search-path* module-path f))))
modules)))
module names such as `(ice-9 q)'. All of MODULES must be either names of
modules to be found in the MODULE-PATH search path, or a module name followed
by an arrow followed by a file-like object. For example:
(imported-modules `((guix build utils)
(guix gcrypt)
((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)))
(imported-files files #:name name #:system system
#:guile guile)))

@ -598,6 +598,23 @@
get-bytevector-all))))
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"
'((bar) (foo))
((@@ (guix gexp) gexp-modules)
@ -668,6 +685,28 @@
(equal? '(chdir "/foo")
(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"
(mlet* %store-monad
((one (text-file "one" (random-text)))