02/03: gexp: Add 'local-file'.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit d9ae938f2c950f3bf1896fb07189c3e28b4d8029
Author: Ludovic Courtès <address@hidden>
Date:   Sat Mar 28 21:26:33 2015 +0100

    gexp: Add 'local-file'.
    
    * guix/gexp.scm (<local-file>): New record type.
      (local-file): New procedure.
      (local-file-compiler): New compiler.
      (gexp->sexp) <struct? thing>: Handle the case where 'lower' returns a
      file name.
      (text-file*): Update docstring.local-file doc
    * tests/gexp.scm ("one local file", "gexp->derivation, local-file"): New
      tests.
    * doc/guix.texi (G-Expressions): Mention local files early.  Document
      'local-file'.  Update 'text-file*' documentation.
---
 doc/guix.texi  |   24 +++++++++++++++++++++---
 guix/gexp.scm  |   47 +++++++++++++++++++++++++++++++++++++++++++----
 tests/gexp.scm |   26 ++++++++++++++++++++++++++
 3 files changed, 90 insertions(+), 7 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 18e6733..4e549ac 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -2503,7 +2503,10 @@ processes that use them.
 Actually this mechanism is not limited to package and derivation
 objects; @dfn{compilers} able to ``lower'' other high-level objects to
 derivations can be defined, such that these objects can also be inserted
-into gexps.
+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.)
 
 To illustrate the idea, here is an example of a gexp:
 
@@ -2666,6 +2669,20 @@ refer to.  Any reference to another store item will lead 
to a build error.
 The other arguments are as for @code{derivation} (@pxref{Derivations}).
 @end deffn
 
address@hidden {Scheme Procedure} local-file @var{file} address@hidden @
+   [#:recursive? #t]
+Return an object representing local file @var{file} to add to the store; this
+object can be used in a gexp.  @var{file} will be added to the store under 
@var{name}--by
+default the base name of @var{file}.
+
+When @var{recursive?} is true, the contents of @var{file} are added 
recursively; if @var{file}
+designates a flat file and @var{recursive?} is true, its contents are added, 
and its
+permission bits are kept.
+
+This is the declarative counterpart of the @code{interned-file} monadic
+procedure (@pxref{The Store Monad, @code{interned-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.
@@ -2703,8 +2720,9 @@ or a subset thereof.
 @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
-strings, packages, derivations, and store file names; the resulting
-store file holds references to all these.
+strings, objects of any type that can be used in a gexp: packages,
+derivations, local file objects, etc.  The resulting store file holds
+references to all these.
 
 This variant should be preferred over @code{text-file} anytime the file
 to create will reference items from the store.  This is typically the
diff --git a/guix/gexp.scm b/guix/gexp.scm
index 01290db..2492974 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -31,6 +31,8 @@
 
             gexp-input
             gexp-input?
+            local-file
+            local-file?
 
             gexp->derivation
             gexp->file
@@ -135,6 +137,37 @@ cross-compiling.)"
 
 
 ;;;
+;;; Local files.
+;;;
+
+(define-record-type <local-file>
+  (%local-file file name recursive?)
+  local-file?
+  (file       local-file-file)                    ;string
+  (name       local-file-name)                    ;string
+  (recursive? local-file-recursive?))             ;Boolean
+
+(define* (local-file file #:optional (name (basename file))
+                     #:key (recursive? #t))
+  "Return an object representing local file FILE to add to the store; this
+object can be used in a gexp.  FILE will be added to the store under NAME--by
+default the base name of FILE.
+
+When RECURSIVE? is true, the contents of FILE are added recursively; if FILE
+designates a flat file and RECURSIVE? is true, its contents are added, and its
+permission bits are kept.
+
+This is the declarative counterpart of the 'interned-file' monadic procedure."
+  (%local-file file name recursive?))
+
+(define-gexp-compiler (local-file-compiler (file local-file?) system target)
+  ;; "Compile" FILE by adding it to the store.
+  (match file
+    (($ <local-file> file name recursive?)
+     (interned-file file name #:recursive? recursive?))))
+
+
+;;;
 ;;; Inputs & outputs.
 ;;;
 
@@ -453,8 +486,13 @@ and in the current monad setting (system type, etc.)"
         (($ <gexp-input> (? struct? thing) output n?)
          (let ((lower  (lookup-compiler thing))
                (target (if (or n? native?) #f target)))
-           (mlet %store-monad ((drv (lower thing system target)))
-             (return (derivation->output-path drv output)))))
+           (mlet %store-monad ((obj (lower thing system target)))
+             ;; OBJ must be either a derivation or a store file name.
+             (return (match obj
+                       ((? derivation? drv)
+                        (derivation->output-path drv output))
+                       ((? string? file)
+                        file))))))
         (($ <gexp-input> x)
          (return x))
         (x
@@ -809,8 +847,9 @@ its search path."
 
 (define* (text-file* name #:rest text)
   "Return as a monadic value a derivation that builds a text file containing
-all of TEXT.  TEXT may list, in addition to strings, packages, derivations,
-and store file names; the resulting store file holds references to all these."
+all of TEXT.  TEXT may list, in addition to strings, objects of any type that
+can be used in a gexp: packages, derivations, local file objects, etc.  The
+resulting store file holds references to all these."
   (define builder
     (gexp (call-with-output-file (ungexp output "out")
             (lambda (port)
diff --git a/tests/gexp.scm b/tests/gexp.scm
index 0540969..f81ef39 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -97,6 +97,18 @@
                               %store (package-source coreutils))))
                  (gexp->sexp* exp)))))
 
+(test-assert "one local file"
+  (let* ((file  (search-path %load-path "guix.scm"))
+         (local (local-file file))
+         (exp   (gexp (display (ungexp local))))
+         (intd  (add-to-store %store (basename file) #t
+                              "sha256" file)))
+    (and (gexp? exp)
+         (match (gexp-inputs exp)
+           (((x "out"))
+            (eq? x local)))
+         (equal? `(display ,intd) (gexp->sexp* exp)))))
+
 (test-assert "same input twice"
   (let ((exp (gexp (begin
                      (display (ungexp coreutils))
@@ -336,6 +348,20 @@
     (mlet %store-monad ((drv mdrv))
       (return (string=? system (derivation-system drv))))))
 
+(test-assertm "gexp->derivation, local-file"
+  (mlet* %store-monad ((file ->  (search-path %load-path "guix.scm"))
+                       (intd     (interned-file file))
+                       (local -> (local-file file))
+                       (exp ->   (gexp (begin
+                                         (stat (ungexp local))
+                                         (symlink (ungexp local)
+                                                  (ungexp output)))))
+                       (drv      (gexp->derivation "local-file" exp)))
+    (mbegin %store-monad
+      (built-derivations (list drv))
+      (return (string=? (readlink (derivation->output-path drv))
+                        intd)))))
+
 (test-assertm "gexp->derivation, cross-compilation"
   (mlet* %store-monad ((target -> "mips64el-linux")
                        (exp    -> (gexp (list (ungexp coreutils)