summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2018-04-08 16:22:25 +0200
committerLudovic Courtès <ludo@gnu.org>2018-04-08 17:41:08 +0200
commitb244ae25f9d5d09ef62f59249c794601b1433886 (patch)
tree454e70bf31adc33c2424ec874bf1925d784ce777
parente40aa54e98aa6329e6196fd29e7e4e34ce3a063c (diff)
downloadpatches-b244ae25f9d5d09ef62f59249c794601b1433886.tar
patches-b244ae25f9d5d09ef62f59249c794601b1433886.tar.gz
gexp: 'directory-union' has a #:resolve-collision parameter.
* guix/gexp.scm (directory-union): Add #:resolve-collision and honor it.
-rw-r--r--guix/gexp.scm15
1 files changed, 12 insertions, 3 deletions
diff --git a/guix/gexp.scm b/guix/gexp.scm
index b47965d9eb..448eeed3f1 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -1250,7 +1250,8 @@ This yields an 'etc' directory containing these two files."
files))))))
(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
file-like objects denoting directories. For example:
@@ -1258,6 +1259,10 @@ file-like objects denoting directories. For example:
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?
is true, the derivation will not print anything."
(define symlink
@@ -1281,12 +1286,16 @@ is true, the derivation will not print anything."
(computed-file name
(with-imported-modules '((guix build union))
(gexp (begin
- (use-modules (guix build union))
+ (use-modules (guix build union)
+ (srfi srfi-1)) ;for 'first' and 'last'
+
(union-build (ungexp output)
'(ungexp things)
#:log-port (ungexp log-port)
- #:symlink (ungexp symlink)))))))))
+ #:symlink (ungexp symlink)
+ #:resolve-collision
+ (ungexp resolve-collision)))))))))
;;;