gexp: 'directory-union' has a #:resolve-collision parameter.

* guix/gexp.scm (directory-union): Add #:resolve-collision and honor it.
This commit is contained in:
Ludovic Courtès 2018-04-08 16:22:25 +02:00
parent e40aa54e98
commit b244ae25f9
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5

View file

@ -1250,7 +1250,8 @@ (define (file-union name files)
files)))))) files))))))
(define* (directory-union name things (define* (directory-union name things
#:key (copy? #f) (quiet? #f)) #:key (copy? #f) (quiet? #f)
(resolve-collision 'warn-about-collision))
"Return a directory that is the union of THINGS, where THINGS is a list of "Return a directory that is the union of THINGS, where THINGS is a list of
file-like objects denoting directories. For example: file-like objects denoting directories. For example:
@ -1258,6 +1259,10 @@ (define* (directory-union name things
yields a directory that is the union of the 'guile' and 'emacs' packages. yields a directory that is the union of the 'guile' and 'emacs' packages.
Call RESOLVE-COLLISION when several files collide, passing it the list of
colliding files. RESOLVE-COLLISION must return the chosen file or #f, in
which case the colliding entry is skipped altogether.
When HARD-LINKS? is true, create hard links instead of symlinks. When QUIET? When HARD-LINKS? is true, create hard links instead of symlinks. When QUIET?
is true, the derivation will not print anything." is true, the derivation will not print anything."
(define symlink (define symlink
@ -1281,12 +1286,16 @@ (define log-port
(computed-file name (computed-file name
(with-imported-modules '((guix build union)) (with-imported-modules '((guix build union))
(gexp (begin (gexp (begin
(use-modules (guix build union)) (use-modules (guix build union)
(srfi srfi-1)) ;for 'first' and 'last'
(union-build (ungexp output) (union-build (ungexp output)
'(ungexp things) '(ungexp things)
#:log-port (ungexp log-port) #:log-port (ungexp log-port)
#:symlink (ungexp symlink))))))))) #:symlink (ungexp symlink)
#:resolve-collision
(ungexp resolve-collision)))))))))
;;; ;;;