03/03: gexp: Add 'plain-file'.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 558e8b11d77ed79c1ae0baf5fda66cfc083bab4b
Author: Ludovic Courtès <address@hidden>
Date:   Wed Jun 3 11:45:27 2015 +0200

    gexp: Add 'plain-file'.
    
    * guix/gexp.scm (<plain-file>): New type.
      (plain-file, plain-file-compiler): New procedures.
    * tests/gexp.scm ("one plain file"): New test.
    * doc/guix.texi (G-Expressions): Document 'plain-file'.
---
 doc/guix.texi  |   10 +++++++++-
 guix/gexp.scm  |   30 +++++++++++++++++++++++++++++-
 tests/gexp.scm |   10 ++++++++++
 3 files changed, 48 insertions(+), 2 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 2d10ec9..665bdb0 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -2948,7 +2948,8 @@ derivations can be defined, such that these objects can 
also be inserted
 into gexps.  Another useful type of high-level object that can be
 inserted in a gexp is @dfn{local files}, which allows files from the
 local file system to be added to the store and referred to by
-derivations and such (see @code{local-file} below.)
+derivations and such (see @code{local-file} and @code{plain-file}
+below.)
 
 To illustrate the idea, here is an example of a gexp:
 
@@ -3126,6 +3127,13 @@ This is the declarative counterpart of the 
@code{interned-file} monadic
 procedure (@pxref{The Store Monad, @code{interned-file}}).
 @end deffn
 
address@hidden {Scheme Procedure} plain-file @var{name} @var{content}
+Return an object representing a text file called @var{name} with the given
address@hidden (a string) to be added to the store.
+
+This is the declarative counterpart of @code{text-file}.
address@hidden deffn
+
 @deffn {Monadic Procedure} gexp->script @var{name} @var{exp}
 Return an executable script @var{name} that runs @var{exp} using
 @var{guile} with @var{modules} in its search path.
diff --git a/guix/gexp.scm b/guix/gexp.scm
index 03b4cbf..10056e5 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -31,12 +31,18 @@
 
             gexp-input
             gexp-input?
+
             local-file
             local-file?
             local-file-file
             local-file-name
             local-file-recursive?
 
+            plain-file
+            plain-file?
+            plain-file-name
+            plain-file-content
+
             gexp->derivation
             gexp->file
             gexp->script
@@ -140,7 +146,7 @@ cross-compiling.)"
 
 
 ;;;
-;;; Local files.
+;;; File declarations.
 ;;;
 
 (define-record-type <local-file>
@@ -169,6 +175,28 @@ This is the declarative counterpart of the 'interned-file' 
monadic procedure."
     (($ <local-file> file name recursive?)
      (interned-file file name #:recursive? recursive?))))
 
+(define-record-type <plain-file>
+  (%plain-file name content references)
+  plain-file?
+  (name        plain-file-name)                   ;string
+  (content     plain-file-content)                ;string
+  (references  plain-file-references))            ;list (currently unused)
+
+(define (plain-file name content)
+  "Return an object representing a text file called NAME with the given
+CONTENT (a string) to be added to the store.
+
+This is the declarative counterpart of 'text-file'."
+  ;; XXX: For now just ignore 'references' because it's not clear how to use
+  ;; them in a declarative context.
+  (%plain-file name content '()))
+
+(define-gexp-compiler (plain-file-compiler (file plain-file?) system target)
+  ;; "Compile" FILE by adding it to the store.
+  (match file
+    (($ <plain-file> name content references)
+     (text-file name content references))))
+
 
 ;;;
 ;;; Inputs & outputs.
diff --git a/tests/gexp.scm b/tests/gexp.scm
index f81ef39..7e14073 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -109,6 +109,16 @@
             (eq? x local)))
          (equal? `(display ,intd) (gexp->sexp* exp)))))
 
+(test-assert "one plain file"
+  (let* ((file     (plain-file "hi" "Hello, world!"))
+         (exp      (gexp (display (ungexp file))))
+         (expected (add-text-to-store %store "hi" "Hello, world!")))
+    (and (gexp? exp)
+         (match (gexp-inputs exp)
+           (((x "out"))
+            (eq? x file)))
+         (equal? `(display ,expected) (gexp->sexp* exp)))))
+
 (test-assert "same input twice"
   (let ((exp (gexp (begin
                      (display (ungexp coreutils))