diff options
| author | Attila Lendvai <attila@lendvai.name> | 2021-10-03 14:43:02 +0200 |
|---|---|---|
| committer | Liliana Marie Prikler <liliana.prikler@gmail.com> | 2022-09-02 17:04:46 +0200 |
| commit | 42e3089752b9fdfd0569b990085fc1cd5cd75f77 (patch) | |
| tree | 324baecdb46029555832def667be8e976c3b0067 | |
| parent | e4adc665e1ce4fe5341eda12157460ac3bd87aec (diff) | |
| download | guix-42e3089752b9fdfd0569b990085fc1cd5cd75f77.tar guix-42e3089752b9fdfd0569b990085fc1cd5cd75f77.tar.gz | |
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>
| -rw-r--r-- | guix/build/union.scm | 25 | ||||
| -rw-r--r-- | guix/gexp.scm | 2 |
2 files changed, 18 insertions, 9 deletions
diff --git a/guix/build/union.scm b/guix/build/union.scm index bf75c67c52..ce6d030109 100644 --- a/guix/build/union.scm +++ b/guix/build/union.scm @@ -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 diff --git a/guix/gexp.scm b/guix/gexp.scm index 73595a216b..a50b93ed48 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -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: |