~ruther/guix-local

d938a58beefc669ab340aa1aeab49df3dc24d123 — Ludovic Courtès 9 years ago 4c0c4db
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'.
3 files changed, 84 insertions(+), 13 deletions(-)

M doc/guix.texi
M guix/gexp.scm
M tests/gexp.scm
M doc/guix.texi => doc/guix.texi +16 -2
@@ 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

M guix/gexp.scm => guix/gexp.scm +29 -11
@@ 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)))


M tests/gexp.scm => tests/gexp.scm +39 -0
@@ 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)))