diff options
author | Ludovic Courtès <ludo@gnu.org> | 2015-09-16 15:03:52 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2015-10-10 22:46:15 +0200 |
commit | e1c153e0ab116a174ea0ed88b76f222927048c5f (patch) | |
tree | 20f3bad7cf98e82d8f6b4652279d4278e9001c0e | |
parent | b893f1aec35b879169f80bc9461fac21907fbaf4 (diff) |
gexp: Add 'scheme-file'.
* guix/gexp.scm (<scheme-file>): New record type.
(scheme-file, scheme-file-compiler): New procedures.
* tests/gexp.scm ("scheme-file"): New test.
* doc/guix.texi (G-Expressions): Document 'scheme-file'.
-rw-r--r-- | doc/guix.texi | 15 | ||||
-rw-r--r-- | guix/gexp.scm | 24 | ||||
-rw-r--r-- | tests/gexp.scm | 13 |
3 files changed, 48 insertions, 4 deletions
diff --git a/doc/guix.texi b/doc/guix.texi index 591c4407a8..80c8d873da 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -3345,10 +3345,10 @@ The other arguments are as for @code{derivation} (@pxref{Derivations}). @end deffn @cindex file-like objects -The @code{local-file}, @code{plain-file}, @code{computed-file}, and -@code{program-file} procedures below return @dfn{file-like objects}. -That is, when unquoted in a G-expression, these objects lead to a file -in the store. Consider this G-expression: +The @code{local-file}, @code{plain-file}, @code{computed-file}, +@code{program-file}, and @code{scheme-file} procedures below return +@dfn{file-like objects}. That is, when unquoted in a G-expression, +these objects lead to a file in the store. Consider this G-expression: @example #~(system* (string-append #$glibc "/sbin/nscd") "-f" @@ -3437,6 +3437,13 @@ The resulting file holds references to all the dependencies of @var{exp} or a subset thereof. @end deffn +@deffn {Scheme Procedure} scheme-file @var{name} @var{exp} +Return an object representing the Scheme file @var{name} that contains +@var{exp}. + +This is the declarative counterpart of @code{gexp->file}. +@end deffn + @deffn {Monadic Procedure} text-file* @var{name} @var{text} @dots{} Return as a monadic value a derivation that builds a text file containing all of @var{text}. @var{text} may list, in addition to diff --git a/guix/gexp.scm b/guix/gexp.scm index f44df9c6ea..27bccc6206 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -57,6 +57,11 @@ program-file-modules program-file-guile + scheme-file + scheme-file? + scheme-file-name + scheme-file-gexp + gexp->derivation gexp->file gexp->script @@ -281,6 +286,25 @@ This is the declarative counterpart of 'gexp->script'." #:modules modules #:guile (or guile (default-guile)))))) +(define-record-type <scheme-file> + (%scheme-file name gexp) + scheme-file? + (name scheme-file-name) ;string + (gexp scheme-file-gexp)) ;gexp + +(define* (scheme-file name gexp) + "Return an object representing the Scheme file NAME that contains GEXP. + +This is the declarative counterpart of 'gexp->file'." + (%scheme-file name gexp)) + +(define-gexp-compiler (scheme-file-compiler (file scheme-file?) + system target) + ;; Compile FILE by returning a derivation that builds the file. + (match file + (($ <scheme-file> name gexp) + (gexp->file name gexp)))) + ;;; ;;; Inputs & outputs. diff --git a/tests/gexp.scm b/tests/gexp.scm index 77439cf6e9..4860a8e79c 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -636,6 +636,19 @@ (return (and (zero? (close-pipe pipe)) (= n (string->number str))))))))) +(test-assertm "scheme-file" + (let* ((text (plain-file "foo" "Hello, world!")) + (scheme (scheme-file "bar" #~(list "foo" #$text)))) + (mlet* %store-monad ((drv (lower-object scheme)) + (text (lower-object text)) + (out -> (derivation->output-path drv))) + (mbegin %store-monad + (built-derivations (list drv)) + (mlet %store-monad ((refs ((store-lift references) out))) + (return (and (equal? refs (list text)) + (equal? `(list "foo" ,text) + (call-with-input-file out read))))))))) + (test-assert "text-file*" (let ((references (store-lift references))) (run-with-store %store |