aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2015-09-07 22:37:14 +0200
committerLudovic Courtès <ludo@gnu.org>2015-10-10 22:46:14 +0200
commit919370291f4f9cc93878eea7db11013949ee8473 (patch)
treecd86c3cf59adc2d07e398ad6779a62de0c09d7f9
parenta72ccbc25125d0d14cabdc1b0f824f27bb64478b (diff)
downloadguix-919370291f4f9cc93878eea7db11013949ee8473.tar
guix-919370291f4f9cc93878eea7db11013949ee8473.tar.gz
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'.
-rw-r--r--doc/guix.texi17
-rw-r--r--guix/gexp.scm33
-rw-r--r--tests/gexp.scm19
3 files changed, 66 insertions, 3 deletions
diff --git a/doc/guix.texi b/doc/guix.texi
index 39b76c7bf6..9c63230a4f 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
-@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}, 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
+@deffn {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}.
+@end 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 de49fef088..ebb147d7db 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 492f3d6d89..ccbbbae7da 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:]]+>$"