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>
This commit is contained in:
Sergey Trofimov 2025-05-19 11:50:08 +02:00 committed by Maxim Cournoyer
parent 93e74686ea
commit 9b7213fc11
No known key found for this signature in database
GPG key ID: 1260E46482E63562
2 changed files with 30 additions and 27 deletions

View file

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

View file

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