diff options
author | Ludovic Courtès <ludo@gnu.org> | 2016-05-20 22:14:46 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2016-05-21 01:35:14 +0200 |
commit | ece6864bd04fc2f9ff86fd4ac9cb0712dd71c094 (patch) | |
tree | 53334de02ef208350cdb7d9d05306e729ed2633f /guix | |
parent | cf8b312d1872aec1f38a179eeb981d79bf7faa03 (diff) |
grafts: Rename files whose name matches a graft.
Fixes <http://bugs.gnu.org/23132>.
Reported by Mark H Weaver <mhw@netris.org>.
* guix/build/graft.scm (rename-matching-files): New procedure.
(rewrite-directory): Use it.
* tests/grafts.scm ("graft-derivation, renaming"): New test.
Diffstat (limited to 'guix')
-rw-r--r-- | guix/build/graft.scm | 25 |
1 files changed, 24 insertions, 1 deletions
diff --git a/guix/build/graft.scm b/guix/build/graft.scm index e9fce03181..b61982dd64 100644 --- a/guix/build/graft.scm +++ b/guix/build/graft.scm @@ -83,6 +83,28 @@ writing the result to OUTPUT." (put-u8 output (char->integer char)) result))))) +(define (rename-matching-files directory mapping) + "Apply MAPPING to the names of all the files in DIRECTORY, where MAPPING is +a list of store file name pairs." + (let* ((mapping (map (match-lambda + ((source . target) + (cons (basename source) (basename target)))) + mapping)) + (matches (find-files directory + (lambda (file stat) + (assoc-ref mapping (basename file))) + #:directories? #t))) + + ;; XXX: This is not quite correct: if MAPPING contains "foo", and + ;; DIRECTORY contains "bar/foo/foo", we first rename "bar/foo" and then + ;; "bar/foo/foo" no longer exists so we fail. Oh well, surely that's good + ;; enough! + (for-each (lambda (file) + (let ((target (assoc-ref mapping (basename file)))) + (rename-file file + (string-append (dirname file) "/" target)))) + matches))) + (define* (rewrite-directory directory output mapping #:optional (store (%store-directory))) "Copy DIRECTORY to OUTPUT, replacing strings according to MAPPING, a list of @@ -127,6 +149,7 @@ file name pairs." (n-par-for-each (parallel-job-count) rewrite-leaf (find-files directory (const #t) - #:directories? #t))) + #:directories? #t)) + (rename-matching-files output mapping)) ;;; graft.scm ends here |