futurile/guix-play
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

gexp: Add 'file-append'.

Browse Source 
* 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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
doc/guix.texi
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:
@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

29
guix/gexp.scm
View File

@ -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.

53
tests/gexp.scm
View File

@ -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