futurile/guix-play
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

guix: build: Factor out default collision-resolver.

Browse Source 
This prepares the stage for new collision resolvers without changing the
underlying semantics too much.

* guix/build/union.scm (resolve+warn-if-harmful): New variable.
(warn-about-collision): Rename to...
(resolve-collision/default): ... this.  Implement in terms of
resolve+warn-if-harmful.
(union-build): Adjust accordingly.
* guix/gexp.scm (directory-union): Likewise.

Signed-off-by: Liliana Marie Prikler <liliana.prikler@gmail.com>
This commit is contained in:
Attila Lendvai 2021-10-03 14:43:02 +02:00 committed by Liliana Marie Prikler
parent e4adc665e1
commit 42e3089752
No known key found for this signature in database
GPG Key ID: 442A84B8C70E2F87
2 changed files with 18 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
guix/build/union.scm
View File

@ -27,7 +27,7 @@
#:use-module (rnrs io ports)
#:export (union-build
warn-about-collision
resolve-collision/default
relative-file-name
symlink-relative))
@ -103,22 +103,31 @@ identical, #f otherwise."
;; for most packages.
'("icon-theme.cache" "gschemas.compiled" "ld.so.cache"))
(define (warn-about-collision files)
"Handle the collision among FILES by emitting a warning and choosing the
first one of THEM."
(let ((file (first files)))
(unless (member (basename file) %harmless-collisions)
(define (resolve+warn-if-harmful resolve files)
"Same as (resolve files), but print a warning if the resolved file is not
considered harmless. Also warn if the resolver doesn't pick any file."
(let ((file (resolve files)))
(cond
((not file)
(format (current-error-port)
"~%warning: collision encountered:~%~{ ~a~%~}"
files)
(format (current-error-port) "warning: choosing ~a~%" file))
(format (current-error-port) "warning: not choosing any file~%"))
(((negate member) (basename file) %harmless-collisions)
(format (current-error-port)
"~%warning: collision encountered:~%~{ ~a~%~}"
files)
(format (current-error-port) "warning: choosing ~a~%" file)))
file))
(define (resolve-collision/default files)
(resolve+warn-if-harmful first files))
(define* (union-build output inputs
#:key (log-port (current-error-port))
(create-all-directories? #f)
(symlink symlink)
(resolve-collision warn-about-collision))
(resolve-collision resolve-collision/default))
"Build in the OUTPUT directory a symlink tree that is the union of all the
INPUTS, using SYMLINK to create symlinks. As a special case, if
CREATE-ALL-DIRECTORIES?, creates the subdirectories in the output directory to

2
guix/gexp.scm
View File

@ -2128,7 +2128,7 @@ This yields an 'etc' directory containing these two files."
(define* (directory-union name things
#:key (copy? #f) (quiet? #f)
(resolve-collision 'warn-about-collision))
(resolve-collision 'resolve-collision/default))
"Return a directory that is the union of THINGS, where THINGS is a list of
file-like objects denoting directories. For example: