~ruther/guix-local

e1c153e0ab116a174ea0ed88b76f222927048c5f — Ludovic Courtès 10 years ago b893f1a
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'.
3 files changed, 48 insertions(+), 4 deletions(-)

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

M guix/gexp.scm => guix/gexp.scm +24 -0
@@ 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.

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