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

Previous Next

Full log

View this message in rfc822 format

From: Andrew Wong <wongandj <at> icloud.com>
To: 76492 <at> debbugs.gnu.org
Cc: Andrew Wong <wongandj <at> icloud.com>, Andreas Enge <andreas <at> enge.fr>, Janneke Nieuwenhuizen <janneke <at> gnu.org>, Ludovic Courtès <ludo <at> gnu.org>, Zheng Junjie <z572 <at> z572.online>
Subject: [bug#76492] [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.