02/12: gexp: Add '=>' syntax to import computed modules.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit d938a58beefc669ab340aa1aeab49df3dc24d123
Author: Ludovic Courtès <address@hidden>
Date:   Wed Mar 15 22:14:36 2017 +0100

    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'.
---
 doc/guix.texi  | 18 ++++++++++++++++--
 guix/gexp.scm  | 40 +++++++++++++++++++++++++++++-----------
 tests/gexp.scm | 39 +++++++++++++++++++++++++++++++++++++++
 3 files changed, 84 insertions(+), 13 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 78bf03d..2e70848 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} @address@hidden
 Mark the gexps defined in @address@hidden 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
address@hidden(guix build utils)}, or it can be a module name, followed by an
+arrow, followed by a file-like object:
+
address@hidden
+`((guix build utils)
+  (guix gcrypt)
+  ((guix config) => ,(scheme-file "config.scm"
+                                  #~(define-module @dots{}))))
address@hidden example
+
address@hidden
+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 @address@hidden, but not on those defined, say, in
diff --git a/guix/gexp.scm b/guix/gexp.scm
index d11ed17..1b8e43e 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 baf7883..b3f7323 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)))