guix: build: utils: Add delete-all-but.

* guix/build/utils.scm (delete-all-but): New variable.

Merges: https://codeberg.org/guix/guix/pulls/5312
Reviewed-by: Maxim Cournoyer <maxim@guixotic.coop>
Reviewed-by: Cayetano Santos <csantosb@inventati.org>
Reviewed-by: Gabriel Wicki <gabriel@erlikon.ch>
Signed-off-by: Nguyễn Gia Phong <cnx@loang.net>

1 files changed, 9 insertions, 0 deletions

diff --git a/guix/build/utils.scm b/guix/build/utils.scm
index 99d4626acf9..2d88b865b01 100644
--- a/guix/build/utils.scm
+++ b/guix/build/utils.scm
@@ -78,6 +78,7 @@
             make-file-writable
             copy-recursively
             delete-file-recursively
+            delete-all-but
             file-name-predicate
             find-files
             false-if-file-not-found
@@ -523,6 +524,14 @@ errors."
                       ;; Don't follow symlinks.
                       lstat)))
 
+(define (delete-all-but directory . preserve)
+  "Delete DIRECTORY recursively except for the files in PRESERVE immediately
+found under it."
+  (with-directory-excursion directory
+    (let* ((pred (negate (cut member <> (cons* "." ".." preserve))))
+           (items (scandir "." pred)))
+      (for-each (cut delete-file-recursively <>) items))))
+
 (define (file-name-predicate regexp)
   "Return a predicate that returns true when passed a file name whose base
 name matches REGEXP."