me
/
guix
Archived
1
0
Fork 0

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.
master
Ludovic Courtès 2018-03-23 18:21:28 +01:00
parent 7aff5d025d
commit 1ae16033f3
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
3 changed files with 63 additions and 16 deletions

View File

@ -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}. This is the declarative counterpart of @code{gexp->derivation}.
@end deffn @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 Return an executable script @var{name} that runs @var{exp} using
@var{guile}, with @var{exp}'s imported modules in its search path. @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} The example below builds a script that simply invokes the @command{ls}
command: command:
@ -5186,11 +5188,13 @@ This is the declarative counterpart of @code{gexp->script}.
@end deffn @end deffn
@deffn {Monadic Procedure} gexp->file @var{name} @var{exp} @ @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}. 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 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 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} The resulting file holds references to all the dependencies of @var{exp}
or a subset thereof. or a subset thereof.

View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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> ;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
@ -1116,11 +1116,14 @@ they can refer to each other."
(module-ref (resolve-interface '(gnu packages guile)) (module-ref (resolve-interface '(gnu packages guile))
'guile-2.2)) '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 "Return as a monadic value a gexp that sets '%load-path' and
'%load-compiled-path' to point to MODULES, a list of module names." '%load-compiled-path' to point to MODULES, a list of module names. MODULES
(mlet %store-monad ((modules (imported-modules modules)) are searched for in PATH."
(compiled (compiled-modules modules))) (mlet %store-monad ((modules (imported-modules modules
#:module-path path))
(compiled (compiled-modules modules
#:module-path path)))
(return (gexp (eval-when (expand load eval) (return (gexp (eval-when (expand load eval)
(set! %load-path (set! %load-path
(cons (ungexp modules) %load-path)) (cons (ungexp modules) %load-path))
@ -1129,11 +1132,13 @@ they can refer to each other."
%load-compiled-path))))))) %load-compiled-path)))))))
(define* (gexp->script name exp (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 "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 (mlet %store-monad ((set-load-path
(load-path-expression (gexp-modules exp)))) (load-path-expression (gexp-modules exp)
module-path)))
(gexp->derivation name (gexp->derivation name
(gexp (gexp
(call-with-output-file (ungexp output) (call-with-output-file (ungexp output)
@ -1148,12 +1153,16 @@ imported modules in its search path."
(write '(ungexp set-load-path) port) (write '(ungexp set-load-path) port)
(write '(ungexp exp) 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 "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' 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) '()) (match (if set-load-path? (gexp-modules exp) '())
(() ;zero modules (() ;zero modules
(gexp->derivation name (gexp->derivation name
@ -1164,13 +1173,15 @@ and '%load-compiled-path' to honor EXP's imported modules."
#:local-build? #t #:local-build? #t
#:substitutable? #f)) #:substitutable? #f))
((modules ...) ((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->derivation name
(gexp (gexp
(call-with-output-file (ungexp output) (call-with-output-file (ungexp output)
(lambda (port) (lambda (port)
(write '(ungexp set-load-path) port) (write '(ungexp set-load-path) port)
(write '(ungexp exp) port)))) (write '(ungexp exp) port))))
#:module-path module-path
#:local-build? #t #:local-build? #t
#:substitutable? #f))))) #:substitutable? #f)))))

View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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. ;;; This file is part of GNU Guix.
;;; ;;;
@ -25,6 +25,7 @@
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (guix tests) #:use-module (guix tests)
#:use-module ((guix build utils) #:select (with-directory-excursion)) #: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)
#:use-module (gnu packages base) #:use-module (gnu packages base)
#:use-module (gnu packages bootstrap) #:use-module (gnu packages bootstrap)
@ -853,6 +854,37 @@
(return (and (zero? (close-pipe pipe)) (return (and (zero? (close-pipe pipe))
(= (expt n 2) (string->number str))))))) (= (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" (test-assertm "program-file"
(let* ((n (random (expt 2 50))) (let* ((n (random (expt 2 50)))
(exp (with-imported-modules '((guix build utils)) (exp (with-imported-modules '((guix build utils))