gexp: Allow file-unions with dangling symlinks.

* guix/gexp.scm (file-union): Add #:dangling-symlinks? parameter.

Change-Id: I09d44ec785fd7141b02dee2d8dc23ccc499aa933
Signed-off-by: Maxim Cournoyer <maxim.cournoyer@gmail.com>

2 files changed, 31 insertions, 28 deletions

diff --git a/doc/guix.texi b/doc/guix.texi
index fd86551787..ef8504bb3e 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -12673,11 +12673,13 @@ as in:
 This is the declarative counterpart of @code{text-file*}.
 @end deffn
 
-@deffn {Procedure} file-union name 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:
+@deffn {Procedure} file-union name files [#:dangling-symlinks? #f]
+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.
+@code{#:dangling-symlinks?} controls if gexps must lower to an existing
+file.  Here's an example:
 
 @lisp
 (file-union "etc"
diff --git a/guix/gexp.scm b/guix/gexp.scm
index 8dd746eee0..302a1bb553 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -2144,7 +2144,7 @@ This is the declarative counterpart of 'text-file*'."
 
   (computed-file name build #:guile guile))
 
-(define* (file-union name files #:key guile)
+(define* (file-union name files #:key guile dangling-symlinks?)
   "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
@@ -2158,28 +2158,29 @@ denoting the target file.  Here's an example:
                 (\"libvirt/qemu.conf\" ,(plain-file \"qemu.conf\" \"\"))))
 
 This yields an 'etc' directory containing these two files."
-  (computed-file name
-                 (with-imported-modules '((guix build utils))
-                   (gexp
-                    (begin
-                      (use-modules (guix build utils))
-
-                      (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))
-
-                                  (mkdir-p (dirname (ungexp target)))
-                                  (symlink (ungexp source)
-                                           (ungexp target))))))
-                            files)))))
-                 #:guile guile))
+  (computed-file
+   name
+   (with-imported-modules '((guix build utils))
+     (gexp
+      (begin
+        (use-modules (guix build utils))
+
+        (mkdir (ungexp output))
+        (chdir (ungexp output))
+        (ungexp-splicing
+         (map (match-lambda
+                ((target source)
+                 (gexp
+                  (let ((source (ungexp source))
+                        (target (ungexp target)))
+                    (unless (or (ungexp dangling-symlinks?)
+                                (stat source #f))
+                      (error (format #f "~a points to inexistent file \
+or dangling symlink ~a" target source)))
+                    (mkdir-p (dirname target))
+                    (symlink source target)))))
+              files)))))
+   #:guile guile))
 
 (define* (directory-union name things
                           #:key (copy? #f) (quiet? #f)