gexp: 'gexp->script' and 'gexp->file' have a new #:module-path parameter.

* guix/gexp.scm (load-path-expression): Add 'path' optional parameter.
(gexp->script): Add #:module-path and honor it.
(gexp->file): Likewise.
* tests/gexp.scm ("gexp->script #:module-path"): New test.
* doc/guix.texi (G-Expressions): Update accordingly.

3 files changed, 63 insertions, 16 deletions

diff --git a/doc/guix.texi b/doc/guix.texi
index 7617d7fe16..b765bcd112 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -5150,9 +5150,11 @@ is a list of additional arguments to pass to @code{gexp->derivation}.
 This is the declarative counterpart of @code{gexp->derivation}.
 @end deffn
 
-@deffn {Monadic Procedure} gexp->script @var{name} @var{exp}
+@deffn {Monadic Procedure} gexp->script @var{name} @var{exp} @
+  [#:guile (default-guile)] [#:module-path %load-path]
 Return an executable script @var{name} that runs @var{exp} using
 @var{guile}, with @var{exp}'s imported modules in its search path.
+Look up @var{exp}'s modules in @var{module-path}.
 
 The example below builds a script that simply invokes the @command{ls}
 command:
@@ -5186,11 +5188,13 @@ This is the declarative counterpart of @code{gexp->script}.
 @end deffn
 
 @deffn {Monadic Procedure} gexp->file @var{name} @var{exp} @
-            [#:set-load-path? #t]
+            [#:set-load-path? #t] [#:module-path %load-path] @
+            [#:guile (default-guile)]
 Return a derivation that builds a file @var{name} containing @var{exp}.
 When @var{set-load-path?} is true, emit code in the resulting file to
 set @code{%load-path} and @code{%load-compiled-path} to honor
-@var{exp}'s imported modules.
+@var{exp}'s imported modules.  Look up @var{exp}'s modules in
+@var{module-path}.
 
 The resulting file holds references to all the dependencies of @var{exp}
 or a subset thereof.
diff --git a/guix/gexp.scm b/guix/gexp.scm
index 8dea022e04..4a2e5a682e 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -1116,11 +1116,14 @@ they can refer to each other."
   (module-ref (resolve-interface '(gnu packages guile))
               'guile-2.2))
 
-(define (load-path-expression modules)
+(define* (load-path-expression modules #:optional (path %load-path))
   "Return as a monadic value a gexp that sets '%load-path' and
-'%load-compiled-path' to point to MODULES, a list of module names."
-  (mlet %store-monad ((modules  (imported-modules modules))
-                      (compiled (compiled-modules modules)))
+'%load-compiled-path' to point to MODULES, a list of module names.  MODULES
+are searched for in PATH."
+  (mlet %store-monad ((modules  (imported-modules modules
+                                                  #:module-path path))
+                      (compiled (compiled-modules modules
+                                                  #:module-path path)))
     (return (gexp (eval-when (expand load eval)
                     (set! %load-path
                       (cons (ungexp modules) %load-path))
@@ -1129,11 +1132,13 @@ they can refer to each other."
                             %load-compiled-path)))))))
 
 (define* (gexp->script name exp
-                       #:key (guile (default-guile)))
+                       #:key (guile (default-guile))
+                       (module-path %load-path))
   "Return an executable script NAME that runs EXP using GUILE, with EXP's
-imported modules in its search path."
+imported modules in its search path.  Look up EXP's modules in MODULE-PATH."
   (mlet %store-monad ((set-load-path
-                       (load-path-expression (gexp-modules exp))))
+                       (load-path-expression (gexp-modules exp)
+                                             module-path)))
     (gexp->derivation name
                       (gexp
                        (call-with-output-file (ungexp output)
@@ -1148,12 +1153,16 @@ imported modules in its search path."
 
                            (write '(ungexp set-load-path) port)
                            (write '(ungexp exp) port)
-                           (chmod port #o555)))))))
+                           (chmod port #o555))))
+                      #:module-path module-path)))
 
-(define* (gexp->file name exp #:key (set-load-path? #t))
+(define* (gexp->file name exp #:key
+                     (set-load-path? #t)
+                     (module-path %load-path))
   "Return a derivation that builds a file NAME containing EXP.  When
 SET-LOAD-PATH? is true, emit code in the resulting file to set '%load-path'
-and '%load-compiled-path' to honor EXP's imported modules."
+and '%load-compiled-path' to honor EXP's imported modules.  Lookup EXP's
+modules in MODULE-PATH."
   (match (if set-load-path? (gexp-modules exp) '())
     (()                                           ;zero modules
      (gexp->derivation name
@@ -1164,13 +1173,15 @@ and '%load-compiled-path' to honor EXP's imported modules."
                        #:local-build? #t
                        #:substitutable? #f))
     ((modules ...)
-     (mlet %store-monad ((set-load-path (load-path-expression modules)))
+     (mlet %store-monad ((set-load-path (load-path-expression modules
+                                                              module-path)))
        (gexp->derivation name
                          (gexp
                           (call-with-output-file (ungexp output)
                             (lambda (port)
                               (write '(ungexp set-load-path) port)
                               (write '(ungexp exp) port))))
+                         #:module-path module-path
                          #:local-build? #t
                          #:substitutable? #f)))))
 
diff --git a/tests/gexp.scm b/tests/gexp.scm
index 5873abdd41..a0198b13a0 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -25,6 +25,7 @@
   #:use-module (guix packages)
   #:use-module (guix tests)
   #:use-module ((guix build utils) #:select (with-directory-excursion))
+  #:use-module ((guix utils) #:select (call-with-temporary-directory))
   #:use-module (gnu packages)
   #:use-module (gnu packages base)
   #:use-module (gnu packages bootstrap)
@@ -853,6 +854,37 @@
       (return (and (zero? (close-pipe pipe))
                    (= (expt n 2) (string->number str)))))))
 
+(test-assertm "gexp->script #:module-path"
+  (call-with-temporary-directory
+   (lambda (directory)
+     (define str
+       "Fake (guix base32) module!")
+
+     (mkdir (string-append directory "/guix"))
+     (call-with-output-file (string-append directory "/guix/base32.scm")
+       (lambda (port)
+         (write `(begin (define-module (guix base32))
+                        (define-public %fake! ,str))
+                port)))
+
+     (mlet* %store-monad ((exp -> (with-imported-modules '((guix base32))
+                                    (gexp (begin
+                                            (use-modules (guix base32))
+                                            (write (list %load-path
+                                                         %fake!))))))
+                          (drv    (gexp->script "guile-thing" exp
+                                                #:guile %bootstrap-guile
+                                                #:module-path (list directory)))
+                          (out -> (derivation->output-path drv))
+                          (done   (built-derivations (list drv))))
+       (let* ((pipe  (open-input-pipe out))
+              (data  (read pipe)))
+         (return (and (zero? (close-pipe pipe))
+                      (match data
+                        ((load-path str*)
+                         (and (string=? str* str)
+                              (not (member directory load-path))))))))))))
+
 (test-assertm "program-file"
   (let* ((n      (random (expt 2 50)))
          (exp    (with-imported-modules '((guix build utils))