Andrew Wong wrote 4 weeks ago
(address . guix-patches@gnu.org)(name . Andrew Wong)(address . wongandj@icloud.com)
0b8d4eb4212609048cf81f2e3e6e3da83c1caf46.1740273538.git.wongandj@icloud.com
* guix/build/utils.scm (delete-all-but): New procedure.
Change-Id: I82db4b63c45d88ef0529adb760182495c28dae9e
---
delete-all-but is defined and used within package definitions a total of 11 times according to a simple grep; it makes sense to move it to a common location. However, changing (guix build utils) is a heavy change, so perhaps there is a better branch to merge this to than master.
guix/build/utils.scm | 25 +++++++++++++++++++++++++
1 file changed, 25 insertions(+)
Toggle diff (54 lines)
diff --git a/guix/build/utils.scm b/guix/build/utils.scm
index 94714bf397..b74c1ad7d8 100644
--- a/guix/build/utils.scm
+++ b/guix/build/utils.scm
@@ -10,6 +10,7 @@
;;; Copyright © 2021, 2022 Maxime Devos <maximedevos@telenet.be>
;;; Copyright © 2021 Brendan Tildesley <mail@brendan.scot>
;;; Copyright © 2023 Carlo Zancanaro <carlo@zancanaro.id.au>
+;;; Copyright © 2025 Andrew Wong <wongandj@icloud.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -77,6 +78,7 @@ (define-module (guix build utils)
make-file-writable
copy-recursively
delete-file-recursively
+ delete-all-but
file-name-predicate
find-files
false-if-file-not-found
@@ -522,6 +524,29 @@ (define* (delete-file-recursively dir
;; Don't follow symlinks.
lstat)))
+(define (delete-all-but paths-kept)
+ "Delete all paths in DIR except for those listed in PATHS-KEPT, without
+following symblinks. Report but don't ignore errors."
+ (let ((paths-kept (map (cut canonicalize-path <>)
+ paths-kept)))
+ (file-system-fold
+ (lambda (current-path current-stat result) ;enter?
+ (not (member (canonicalize-path current-path) paths-kept string=?)))
+ (lambda (file file-stat result) ;leaf
+ (if (not (any (cut string-prefix? (canonicalize-path file) <>)
+ paths-kept))
+ (warn-on-error (delete-file file) file)))
+ (const #t) ;down
+ (lambda (dir dir-stat result) ;up
+ (if (not (any (cut string-prefix? (canonicalize-path dir) <>)
+ paths-kept))
+ (warn-on-error (rmdir dir) dir)))
+ (const #t) ;skip
+ (lambda (file stat errno result) ;error
+ (format (current-error-port)
+ "warning: failed to delete ~a: ~a~%" file (strerror errno)))
+ #t (getcwd) lstat)))
+
(define (file-name-predicate regexp)
"Return a predicate that returns true when passed a file name whose base
name matches REGEXP."
base-commit: cd20619cfcb32c2631fb602729512740bc510550
--
2.48.1