me
/
guix
Archived
1
0
Fork 0
Code

guix: build: Factor out default collision-resolver. 

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