aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--doc/guix.texi35
-rw-r--r--guix/gexp.scm29
-rw-r--r--tests/gexp.scm53
3 files changed, 113 insertions, 4 deletions
diff --git a/doc/guix.texi b/doc/guix.texi
index 3923627c79..6d3361878b 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -3985,7 +3985,7 @@ The @code{local-file}, @code{plain-file}, @code{computed-file},
these objects lead to a file in the store. Consider this G-expression:
@example
-#~(system* (string-append #$glibc "/sbin/nscd") "-f"
+#~(system* #$(file-append glibc "/sbin/nscd") "-f"
#$(local-file "/tmp/my-nscd.conf"))
@end example
@@ -4044,7 +4044,7 @@ command:
(use-modules (guix gexp) (gnu packages base))
(gexp->script "list-files"
- #~(execl (string-append #$coreutils "/bin/ls")
+ #~(execl #$(file-append coreutils "/bin/ls")
"ls"))
@end example
@@ -4055,8 +4055,7 @@ executable file @file{/gnu/store/@dots{}-list-files} along these lines:
@example
#!/gnu/store/@dots{}-guile-2.0.11/bin/guile -ds
!#
-(execl (string-append "/gnu/store/@dots{}-coreutils-8.22"/bin/ls")
- "ls")
+(execl "/gnu/store/@dots{}-coreutils-8.22"/bin/ls" "ls")
@end example
@end deffn
@@ -4126,6 +4125,34 @@ as in:
This is the declarative counterpart of @code{text-file*}.
@end deffn
+@deffn {Scheme Procedure} file-append @var{obj} @var{suffix} @dots{}
+Return a file-like object that expands to the concatenation of @var{obj}
+and @var{suffix}, where @var{obj} is a lowerable object and each
+@var{suffix} is a string.
+
+As an example, consider this gexp:
+
+@example
+(gexp->script "run-uname"
+ #~(system* #$(file-append coreutils
+ "/bin/uname")))
+@end example
+
+The same effect could be achieved with:
+
+@example
+(gexp->script "run-uname"
+ #~(system* (string-append #$coreutils
+ "/bin/uname")))
+@end example
+
+There is one difference though: in the @code{file-append} case, the
+resulting script contains the absolute file name as a string, whereas in
+the second case, the resulting script contains a @code{(string-append
+@dots{})} expression to construct the file name @emph{at run time}.
+@end deffn
+
+
Of course, in addition to gexps embedded in ``host'' code, there are
also modules containing build tools. To make it clear that they are
meant to be used in the build stratum, these modules are kept in the
diff --git a/guix/gexp.scm b/guix/gexp.scm
index 8d380ec95b..7e2ecf6c33 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -63,6 +63,11 @@
scheme-file-name
scheme-file-gexp
+ file-append
+ file-append?
+ file-append-base
+ file-append-suffix
+
gexp->derivation
gexp->file
gexp->script
@@ -368,6 +373,30 @@ This is the declarative counterpart of 'gexp->file'."
(($ <scheme-file> name gexp)
(gexp->file name gexp))))
+;; Appending SUFFIX to BASE's output file name.
+(define-record-type <file-append>
+ (%file-append base suffix)
+ file-append?
+ (base file-append-base) ;<package> | <derivation> | ...
+ (suffix file-append-suffix)) ;list of strings
+
+(define (file-append base . suffix)
+ "Return a <file-append> object that expands to the concatenation of BASE and
+SUFFIX."
+ (%file-append base suffix))
+
+(define-gexp-compiler file-append-compiler file-append?
+ compiler => (lambda (obj system target)
+ (match obj
+ (($ <file-append> base _)
+ (lower-object base system #:target target))))
+ expander => (lambda (obj lowered output)
+ (match obj
+ (($ <file-append> base suffix)
+ (let* ((expand (lookup-expander base))
+ (base (expand base lowered output)))
+ (string-append base (string-concatenate suffix)))))))
+
;;;
;;; Inputs & outputs.
diff --git a/tests/gexp.scm b/tests/gexp.scm
index 03a64fa6bb..214e7a5302 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -207,6 +207,47 @@
(e3 `(display ,txt)))
(equal? `(begin ,e0 ,e1 ,e2 ,e3) (gexp->sexp* exp))))))
+(test-assert "file-append"
+ (let* ((drv (package-derivation %store %bootstrap-guile))
+ (fa (file-append %bootstrap-guile "/bin/guile"))
+ (exp #~(here we go #$fa)))
+ (and (match (gexp->sexp* exp)
+ (('here 'we 'go (? string? result))
+ (string=? result
+ (string-append (derivation->output-path drv)
+ "/bin/guile"))))
+ (match (gexp-inputs exp)
+ (((thing "out"))
+ (eq? thing fa))))))
+
+(test-assert "file-append, output"
+ (let* ((drv (package-derivation %store glibc))
+ (fa (file-append glibc "/lib" "/debug"))
+ (exp #~(foo #$fa:debug)))
+ (and (match (gexp->sexp* exp)
+ (('foo (? string? result))
+ (string=? result
+ (string-append (derivation->output-path drv "debug")
+ "/lib/debug"))))
+ (match (gexp-inputs exp)
+ (((thing "debug"))
+ (eq? thing fa))))))
+
+(test-assert "file-append, nested"
+ (let* ((drv (package-derivation %store glibc))
+ (dir (file-append glibc "/bin"))
+ (slash (file-append dir "/"))
+ (file (file-append slash "getent"))
+ (exp #~(foo #$file)))
+ (and (match (gexp->sexp* exp)
+ (('foo (? string? result))
+ (string=? result
+ (string-append (derivation->output-path drv)
+ "/bin/getent"))))
+ (match (gexp-inputs exp)
+ (((thing "out"))
+ (eq? thing file))))))
+
(test-assert "ungexp + ungexp-native"
(let* ((exp (gexp (list (ungexp-native %bootstrap-guile)
(ungexp coreutils)
@@ -338,6 +379,18 @@
(return (and (equal? sexp (call-with-input-file out read))
(equal? (list guile) refs)))))
+(test-assertm "gexp->file + file-append"
+ (mlet* %store-monad ((exp -> #~#$(file-append %bootstrap-guile
+ "/bin/guile"))
+ (guile (package-file %bootstrap-guile))
+ (drv (gexp->file "foo" exp))
+ (out -> (derivation->output-path drv))
+ (done (built-derivations (list drv)))
+ (refs ((store-lift references) out)))
+ (return (and (equal? (string-append guile "/bin/guile")
+ (call-with-input-file out read))
+ (equal? (list guile) refs)))))
+
(test-assertm "gexp->derivation"
(mlet* %store-monad ((file (text-file "foo" "Hello, world!"))
(exp -> (gexp