01/12: gexp: Add 'computed-file'.

[Ludovic Courtès]

civodul pushed a commit to branch wip-service-refactor
in repository guix.

commit 7954399524fa4ba17c11fc45f7c42b8a8fa6bc09
Author: Ludovic Courtès <address@hidden>
Date:   Mon Sep 7 22:37:14 2015 +0200

    gexp: Add 'computed-file'.
    
    * guix/gexp.scm (<computed-file>): New record type.
      (computed-file, computed-file-compiler): New procedures.
    * tests/gexp.scm ("lower-object, computed-file"): New test.
    * doc/guix.texi (G-Expressions): Document 'computed-file'.
---
 doc/guix.texi  |   17 ++++++++++++++---
 guix/gexp.scm  |   33 +++++++++++++++++++++++++++++++++
 tests/gexp.scm |   19 +++++++++++++++++++
 3 files changed, 66 insertions(+), 3 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 6a3765f..47458ca 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -3345,9 +3345,10 @@ The other arguments are as for @code{derivation} 
(@pxref{Derivations}).
 @end deffn
 
 @cindex file-like objects
-The @code{local-file} and @code{plain-file} procedures below return
address@hidden 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}, and @code{computed-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"
@@ -3383,6 +3384,16 @@ Return an object representing a text file called 
@var{name} with the given
 This is the declarative counterpart of @code{text-file}.
 @end deffn
 
address@hidden {Scheme Procedure} computed-file @var{name} @var{gexp} @
+          [#:modules '()] [#:options '(#:local-build? #t)]
+Return an object representing the store item @var{name}, a file or
+directory computed by @var{gexp}.  @var{modules} specifies the set of
+modules visible in the execution context of @var{gexp}.  @var{options}
+is a list of additional arguments to pass to @code{gexp->derivation}.
+
+This is the declarative counterpart of @code{gexp->derivation}.
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 de49fef..ebb147d 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -43,6 +43,13 @@
             plain-file-name
             plain-file-content
 
+            computed-file
+            computed-file?
+            computed-file-name
+            computed-file-gexp
+            computed-file-modules
+            computed-file-options
+
             gexp->derivation
             gexp->file
             gexp->script
@@ -214,6 +221,32 @@ This is the declarative counterpart of 'text-file'."
     (($ <plain-file> name content references)
      (text-file name content references))))
 
+(define-record-type <computed-file>
+  (%computed-file name gexp modules options)
+  computed-file?
+  (name       computed-file-name)                 ;string
+  (gexp       computed-file-gexp)                 ;gexp
+  (modules    computed-file-modules)              ;list of module names
+  (options    computed-file-options))             ;list of arguments
+
+(define* (computed-file name gexp
+                        #:key (modules '()) (options '(#:local-build? #t)))
+  "Return an object representing the store item NAME, a file or directory
+computed by GEXP.  MODULES specifies the set of modules visible in the
+execution context of GEXP.  OPTIONS is a list of additional arguments to pass
+to 'gexp->derivation'.
+
+This is the declarative counterpart of 'gexp->derivation'."
+  (%computed-file name gexp modules options))
+
+(define-gexp-compiler (computed-file-compiler (file computed-file?)
+                                              system target)
+  ;; Compile FILE by returning a derivation whose build expression is its
+  ;; gexp.
+  (match file
+    (($ <computed-file> name gexp modules options)
+     (apply gexp->derivation name gexp #:modules modules options))))
+
 
 ;;;
 ;;; Inputs & outputs.
diff --git a/tests/gexp.scm b/tests/gexp.scm
index 492f3d6..ccbbbae 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -661,6 +661,25 @@
     (return (and (derivation? drv1) (derivation? drv2)
                  (store-path? item)))))
 
+(test-assertm "lower-object, computed-file"
+  (let* ((text     (plain-file "foo" "Hello!"))
+         (exp      #~(begin
+                       (mkdir #$output)
+                       (symlink #$%bootstrap-guile
+                                (string-append #$output "/guile"))
+                       (symlink #$text (string-append #$output "/text"))))
+         (computed (computed-file "computed" exp)))
+    (mlet* %store-monad ((text      (lower-object text))
+                         (guile-drv (lower-object %bootstrap-guile))
+                         (comp-drv  (lower-object computed))
+                         (comp ->   (derivation->output-path comp-drv)))
+      (mbegin %store-monad
+        (built-derivations (list comp-drv))
+        (return (and (string=? (readlink (string-append comp "/guile"))
+                               (derivation->output-path guile-drv))
+                     (string=? (readlink (string-append comp "/text"))
+                               text)))))))
+
 (test-assert "printer"
   (string-match "^#<gexp \\(string-append .*#<package coreutils.*\
  \"/bin/uname\"\\) [[:xdigit:]]+>$"