diff options
Diffstat (limited to 'guix/build/union.scm')
| -rw-r--r-- | guix/build/union.scm | 40 |
1 files changed, 25 insertions, 15 deletions
diff --git a/guix/build/union.scm b/guix/build/union.scm index d46b750035..1179f1234b 100644 --- a/guix/build/union.scm +++ b/guix/build/union.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2016, 2017 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2014 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2017 Huang Ying <huang.ying.caritas@gmail.com> ;;; @@ -25,7 +25,9 @@ #:use-module (srfi srfi-26) #:use-module (rnrs bytevectors) #:use-module (rnrs io ports) - #:export (union-build)) + #:export (union-build + + warn-about-collision)) ;;; Commentary: ;;; @@ -76,14 +78,29 @@ identical, #f otherwise." (or (eof-object? n1) (loop)))))))))))))) +(define (warn-about-collision files) + "Handle the collision among FILES by emitting a warning and choosing the +first one of THEM." + (format (current-error-port) + "~%warning: collision encountered:~%~{ ~a~%~}" + files) + (let ((file (first files))) + (format (current-error-port) "warning: choosing ~a~%" file) + file)) + (define* (union-build output inputs #:key (log-port (current-error-port)) (create-all-directories? #f) - (symlink symlink)) + (symlink symlink) + (resolve-collision warn-about-collision)) "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 -make sure the caller can modify them later." +make sure the caller can modify them later. + +When two or more regular files collide, call RESOLVE-COLLISION with the list +of colliding files and use the one that it returns; or, if RESOLVE-COLLISION +returns #f, skip the faulty file altogether." (define (symlink* input output) (format log-port "`~a' ~~> `~a'~%" input output) @@ -92,17 +109,10 @@ make sure the caller can modify them later." (define (resolve-collisions output dirs files) (cond ((null? dirs) ;; The inputs are all files. - (format (current-error-port) - "~%warning: collision encountered:~%~{~a~%~}" - files) - - (let ((file (first files))) - ;; TODO: Implement smarter strategies. - (format (current-error-port) - "warning: arbitrarily choosing ~a~%" - file) - - (symlink* file output))) + (match (resolve-collision files) + (#f #f) + ((? string? file) + (symlink* file output)))) (else ;; The inputs are a mixture of files and directories |