gexp: Add 'file-union'.

* gnu/services.scm (file-union): Move to...
* guix/gexp.scm (file-union): ... here.  New procedure.
* doc/guix.texi (G-Expressions): Document it.
This commit is contained in:
Ludovic Courtès 2017-10-16 09:57:44 +02:00
parent 7a51c78c6e
commit dedb512f8f
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
3 changed files with 49 additions and 20 deletions

View File

@ -4990,6 +4990,23 @@ 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-union @var{name} @var{files}
Return a @code{<computed-file>} that builds a directory containing all of @var{files}.
Each item in @var{files} must be a two-element list where the first element is the
file name to use in the new directory, and the second element is a gexp
denoting the target file. Here's an example:
@example
(file-union "etc"
`(("hosts" ,(plain-file "hosts"
"127.0.0.1 localhost"))
("bashrc" ,(plain-file "bashrc"
"alias ls='ls --color'"))))
@end example
This yields an @code{etc} directory containing these two files.
@end deffn
@deffn {Scheme Procedure} file-append @var{obj} @var{suffix} @dots{} @deffn {Scheme Procedure} file-append @var{obj} @var{suffix} @dots{}
Return a file-like object that expands to the concatenation of @var{obj} 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 and @var{suffix}, where @var{obj} is a lowerable object and each

View File

@ -97,7 +97,6 @@
%activation-service %activation-service
etc-service etc-service
file-union ;XXX: for lack of a better place
directory-union)) directory-union))
;;; Comment: ;;; Comment:
@ -388,25 +387,6 @@ boot."
(list (service-extension boot-service-type (list (service-extension boot-service-type
cleanup-gexp))))) cleanup-gexp)))))
(define* (file-union name files) ;FIXME: Factorize.
"Return a <computed-file> that builds a directory containing all of FILES.
Each item in FILES must be a list where the first element is the file name to
use in the new directory, and the second element is a gexp denoting the target
file."
(computed-file name
#~(begin
(mkdir #$output)
(chdir #$output)
#$@(map (match-lambda
((target source)
#~(begin
;; Stat the source to abort early if it
;; does not exist.
(stat #$source)
(symlink #$source #$target))))
files))))
(define (directory-union name things) (define (directory-union name things)
"Return a directory that is the union of THINGS." "Return a directory that is the union of THINGS."
(match things (match things

View File

@ -78,6 +78,7 @@
gexp->script gexp->script
text-file* text-file*
mixed-text-file mixed-text-file
file-union
imported-files imported-files
imported-modules imported-modules
compiled-modules compiled-modules
@ -1171,6 +1172,37 @@ This is the declarative counterpart of 'text-file*'."
(computed-file name build)) (computed-file name build))
(define (file-union name files)
"Return a <computed-file> that builds a directory containing all of FILES.
Each item in FILES must be a two-element list where the first element is the
file name to use in the new directory, and the second element is a gexp
denoting the target file. Here's an example:
(file-union \"etc\"
`((\"hosts\" ,(plain-file \"hosts\"
\"127.0.0.1 localhost\"))
(\"bashrc\" ,(plain-file \"bashrc\"
\"alias ls='ls --color'\"))))
This yields an 'etc' directory containing these two files."
(computed-file name
(gexp
(begin
(mkdir (ungexp output))
(chdir (ungexp output))
(ungexp-splicing
(map (match-lambda
((target source)
(gexp
(begin
;; Stat the source to abort early if it does
;; not exist.
(stat (ungexp source))
(symlink (ungexp source)
(ungexp target))))))
files))))))
;;; ;;;
;;; Syntactic sugar. ;;; Syntactic sugar.