gexp: Add 'file-append'.

* guix/gexp.scm (<file-append>): New record type.
(file-append): New procedure.
(file-append-compiler): New gexp compiler.
* tests/gexp.scm ("file-append", "file-append, output")
("file-append, nested", "gexp->file + file-append"): New tests.
* doc/guix.texi (G-Expressions): Use it in 'nscd' and 'list-files'
examples.  Document 'file-append'.
This commit is contained in:
Ludovic Courtès 2016-09-09 22:46:36 +02:00
parent ebdfd776f4
commit a9e5e92f94
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
3 changed files with 113 additions and 4 deletions

View File

@ -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: these objects lead to a file in the store. Consider this G-expression:
@example @example
#~(system* (string-append #$glibc "/sbin/nscd") "-f" #~(system* #$(file-append glibc "/sbin/nscd") "-f"
#$(local-file "/tmp/my-nscd.conf")) #$(local-file "/tmp/my-nscd.conf"))
@end example @end example
@ -4044,7 +4044,7 @@ command:
(use-modules (guix gexp) (gnu packages base)) (use-modules (guix gexp) (gnu packages base))
(gexp->script "list-files" (gexp->script "list-files"
#~(execl (string-append #$coreutils "/bin/ls") #~(execl #$(file-append coreutils "/bin/ls")
"ls")) "ls"))
@end example @end example
@ -4055,8 +4055,7 @@ executable file @file{/gnu/store/@dots{}-list-files} along these lines:
@example @example
#!/gnu/store/@dots{}-guile-2.0.11/bin/guile -ds #!/gnu/store/@dots{}-guile-2.0.11/bin/guile -ds
!# !#
(execl (string-append "/gnu/store/@dots{}-coreutils-8.22"/bin/ls") (execl "/gnu/store/@dots{}-coreutils-8.22"/bin/ls" "ls")
"ls")
@end example @end example
@end deffn @end deffn
@ -4126,6 +4125,34 @@ as in:
This is the declarative counterpart of @code{text-file*}. This is the declarative counterpart of @code{text-file*}.
@end deffn @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 Of course, in addition to gexps embedded in ``host'' code, there are
also modules containing build tools. To make it clear that they 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 meant to be used in the build stratum, these modules are kept in the

View File

@ -63,6 +63,11 @@
scheme-file-name scheme-file-name
scheme-file-gexp scheme-file-gexp
file-append
file-append?
file-append-base
file-append-suffix
gexp->derivation gexp->derivation
gexp->file gexp->file
gexp->script gexp->script
@ -368,6 +373,30 @@ This is the declarative counterpart of 'gexp->file'."
(($ <scheme-file> name gexp) (($ <scheme-file> name gexp)
(gexp->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. ;;; Inputs & outputs.

View File

@ -207,6 +207,47 @@
(e3 `(display ,txt))) (e3 `(display ,txt)))
(equal? `(begin ,e0 ,e1 ,e2 ,e3) (gexp->sexp* exp)))))) (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" (test-assert "ungexp + ungexp-native"
(let* ((exp (gexp (list (ungexp-native %bootstrap-guile) (let* ((exp (gexp (list (ungexp-native %bootstrap-guile)
(ungexp coreutils) (ungexp coreutils)
@ -338,6 +379,18 @@
(return (and (equal? sexp (call-with-input-file out read)) (return (and (equal? sexp (call-with-input-file out read))
(equal? (list guile) refs))))) (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" (test-assertm "gexp->derivation"
(mlet* %store-monad ((file (text-file "foo" "Hello, world!")) (mlet* %store-monad ((file (text-file "foo" "Hello, world!"))
(exp -> (gexp (exp -> (gexp