bug#27284: [PATCH 4/8] gexp: Add 'file-union'.

["Ludovic Courtès" <ludo@gnu.org>]

* gnu/services.scm (file-union): Move to...
* guix/gexp.scm (file-union): ... here.  New procedure.
* doc/guix.texi (G-Expressions): Document it.
---
 doc/guix.texi    | 17 +++++++++++++++++
 gnu/services.scm | 20 --------------------
 guix/gexp.scm    | 32 ++++++++++++++++++++++++++++++++
 3 files changed, 49 insertions(+), 20 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index b7f4f88f9..1de3494da 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -4990,6 +4990,23 @@ as in:
 This is the declarative counterpart of @code{text-file*}.
 @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{}
 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
diff --git a/gnu/services.scm b/gnu/services.scm
index 0bd362085..bc866eafe 100644
--- a/gnu/services.scm
+++ b/gnu/services.scm
@@ -97,7 +97,6 @@
             %activation-service
             etc-service
 
-            file-union                        ;XXX: for lack of a better place
             directory-union))
 
 ;;; Comment:
@@ -388,25 +387,6 @@ boot."
                  (list (service-extension boot-service-type
                                           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)
   "Return a directory that is the union of THINGS."
   (match things
diff --git a/guix/gexp.scm b/guix/gexp.scm
index 2622c5cb6..9835599bb 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -78,6 +78,7 @@
             gexp->script
             text-file*
             mixed-text-file
+            file-union
             imported-files
             imported-modules
             compiled-modules
@@ -1171,6 +1172,37 @@ This is the declarative counterpart of 'text-file*'."
 
   (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))))))
+
 \f
 ;;;
 ;;; Syntactic sugar.
-- 
2.14.2