GNU bug report logs - #76492
[PATCH] build/utils: Add delete-all-but

Previous Next

To reply to this bug, email your comments to 76492 AT debbugs.gnu.org.
There is no need to reopen the bug first.

Toggle the display of automated, internal messages from the tracker.

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Andrew Wong <wongandj <at> icloud.com>
To: guix-patches <at> gnu.org
Cc: Andrew Wong <wongandj <at> icloud.com>
Subject: [PATCH] build/utils: Add delete-all-but
Date: Sat, 22 Feb 2025 20:18:58 -0500

* 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(+)

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 <at> telenet.be>
 ;;; Copyright © 2021 Brendan Tildesley <mail <at> brendan.scot>
 ;;; Copyright © 2023 Carlo Zancanaro <carlo <at> zancanaro.id.au>
+;;; Copyright © 2025 Andrew Wong <wongandj <at> 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

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.