diff options
| -rw-r--r-- | doc/guix.texi | 18 | ||||
| -rw-r--r-- | guix/gexp.scm | 40 | ||||
| -rw-r--r-- | tests/gexp.scm | 39 |
3 files changed, 84 insertions, 13 deletions
diff --git a/doc/guix.texi b/doc/guix.texi index 78bf03de9e..2e70848e55 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -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 diff --git a/guix/gexp.scm b/guix/gexp.scm index d11ed177fe..1b8e43e994 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -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))) diff --git a/tests/gexp.scm b/tests/gexp.scm index baf78837ae..b3f7323984 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -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))) |