gnu: Use built-in delete-all-but.world-rebuild

* gnu/packages/astronomy.scm (phd2): Use built-in delete-all-but.
* gnu/packages/bioinformatics.scm (pynsptools-examples-files): Likewise.
* gnu/packages/containers.scm
  (go-github-com-opencontainers-image-spec-schema)
  (go-go-podman-io-common, go-go-podman-io-image-v5)
  (go-go-podman-io-storage): Likewise.
* gnu/packages/databases.scm (mysql): Likewise.
* gnu/packages/debug.scm (fandango): Likewise.
* gnu/packages/electronics.scm (hal, librepcb, nextpnr, surelog):
  Likewise.
* gnu/packages/emacs-xyz.scm (emacs-smartparens): Likewise.
* gnu/packages/emulators.scm (dolphin-emu, libretro-dolphin-emu)
  (libretro-slang-shaders, mgba, pcsx2, retroarch-minimal): Likewise.
* gnu/packages/game-development.scm (sfml): Likewise.
* gnu/packages/gnome.scm (gjs): Likewise.
* gnu/packages/golang-apps.scm (godoc): Likewise.
* gnu/packages/golang-build.scm (go-golang-org-x-tools-go-expect)
  (go-golang-org-x-tools-go-packages-packagestest)
  (go-golang-org-x-tools-godoc): Likewise.
* gnu/packages/golang-check.scm
  (go-github-com-go-openapi-swag-jsonutils-fixtures-test): Likewise.
* gnu/packages/golang-web.scm (go-github-com-containerd-containerd-api)
  (go-cloud-google-com-go-auth, go-cloud-google-com-go-auth-oauth2adapt)
  (go-cloud-google-com-go-iam, go-cloud-google-com-go-kms)
  (go-cloud-google-com-go-logging, go-cloud-google-com-go-longrunning)
  (go-cloud-google-com-go-monitoring, go-cloud-google-com-go-profiler)
  (go-cloud-google-com-go-security, go-cloud-google-com-go-spanner)
  (go-cloud-google-com-go-storage, go-cloud-google-com-go-trace)
  (go-github-com-aws-aws-sdk-go-v2-config)
  (go-github-com-aws-aws-sdk-go-v2-credentials)
  (go-github-com-aws-aws-sdk-go-v2-feature-ec2-imds)
  (go-github-com-aws-aws-sdk-go-v2-internal-configsources)
  (go-github-com-aws-aws-sdk-go-v2-internal-endpoints-v2)
  (go-github-com-aws-aws-sdk-go-v2-service-cloudwatchlogs)
  (go-github-com-aws-aws-sdk-go-v2-service-kms)
  (go-github-com-aws-aws-sdk-go-v2-service-sns)
  (go-github-com-aws-aws-sdk-go-v2-service-sqs)
  (go-github-com-aws-aws-sdk-go-v2-service-ssm)
  (go-github-com-aws-smithy-go-metrics-smithyotelmetrics)
  (go-github-com-azure-azure-sdk-for-go-sdk-azcore)
  (go-github-com-azure-azure-sdk-for-go-sdk-azidentity)
  (go-github-com-azure-azure-sdk-for-go-sdk-internal)
  (go-github-com-azure-azure-sdk-for-go-sdk-security-keyvault-azkeys)
  (go-github-com-azure-azure-sdk-for-go-sdk-security-keyvault-internal)
  (go-github-com-azure-azure-sdk-for-go-sdk-storage-azblob)
  (go-github-com-azure-azure-sdk-for-go-sdk-storage-azfile)
  (go-github-com-envoyproxy-go-control-plane-envoy)
  (go-github-com-go-openapi-swag-loading)
  (go-github-com-googlecloudplatform-opentelemetry-operations-go-exporter-metric)
  (go-github-com-googlecloudplatform-opentelemetry-operations-go-exporter-trace)
  (go-github-com-googlecloudplatform-opentelemetry-operations-go-internal-cloudmock)
  (go-github-com-googlecloudplatform-opentelemetry-operations-go-internal-resourcemapping)
  (go-github-com-grpc-ecosystem-go-grpc-middleware-providers-prometh)
  (go-github-com-hashicorp-go-secure-stdlib-parseutil)
  (go-github-com-jtolio-crawlspace-tools)
  (go-github-com-moby-moby-client)
  (go-github-com-opentracing-contrib-go-grpc-test)
  (go-github-com-sigstore-sigstore-pkg-signature-kms-aws)
  (go-github-com-sigstore-sigstore-pkg-signature-kms-azure)
  (go-github-com-sigstore-sigstore-pkg-signature-kms-gcp)
  (go-github-com-sigstore-sigstore-pkg-signature-kms-hashivault)
  (go-go-etcd-io-etcd-api-v3, go-go-etcd-io-etcd-client-pkg-v3)
  (go-go-opentelemetry-io-auto-sdk)
  (go-go-opentelemetry-io-contrib-detectors-aws-ec2-v2)
  (go-go-opentelemetry-io-contrib-detectors-aws-ecs)
  (go-go-opentelemetry-io-contrib-detectors-gcp)
  (go-go-opentelemetry-io-contrib-instrumentation-net-http-httptrace)
  (go-go-opentelemetry-io-contrib-propagators-autoprop)
  (go-go-opentelemetry-io-otel-bridge-opentracing)
  (go-go-opentelemetry-io-otel-exporters-otlp-otlpmetric-otlpmetricgrpc)
  (go-go-opentelemetry-io-otel-exporters-otlp-otlpmetric-otlpmetrichttp)
  (go-go-opentelemetry-io-otel-exporters-otlp-otlptrace)
  (go-go-opentelemetry-io-otel-exporters-otlp-otlptrace-otlptracegrpc)
  (go-go-opentelemetry-io-otel-exporters-otlp-otlptrace-otlptracehttp)
  (go-go-opentelemetry-io-otel-exporters-prometheus)
  (go-go-opentelemetry-io-otel-exporters-stdout-stdoutmetric)
  (go-go-opentelemetry-io-otel-exporters-stdout-stdouttrace)
  (go-go-opentelemetry-io-otel-exporters-zipkin)
  (go-go-opentelemetry-io-otel-log)
  (go-go-opentelemetry-io-otel-metric-x)
  (go-go-opentelemetry-io-otel-sdk, go-go-opentelemetry-io-otel-sdk-log)
  (go-go-opentelemetry-io-otel-sdk-metric)
  (go-golang-getoutline-org-sdk-x)
  (go-google-golang-org-genproto-googleapis-api)
  (go-google-golang-org-genproto-googleapis-bytestream)
  (go-google-golang-org-grpc-cmd-protoc-gen-go-grpc)
  (go-google-golang-org-grpc-examples)
  (go-k8s-io-kube-openapi-test-integration): Likewise.
* gnu/packages/golang-xyz.scm (go-github-com-ajstarks-deck-generate)
  (go-github-com-charmbracelet-x-ansi)
  (go-github-com-charmbracelet-x-cellbuf)
  (go-github-com-charmbracelet-x-errors)
  (go-github-com-charmbracelet-x-term)
  (go-github-com-charmbracelet-x-xpty)
  (go-github-com-containerd-errdefs-pkg)
  (go-github-com-go-openapi-swag-jsonutils)
  (go-github-com-go-openapi-swag-yamlutils)
  (go-github-com-moby-sys-atomicwriter, go-github-com-moby-sys-devices)
  (go-github-com-moby-sys-mount, go-go-uber-org-zap-exp)
  (go-modernc-org-ccgo-v4, go-sigs-k8s-io-kustomize-cmd-config):
  Likewise.
* gnu/packages/image-processing.scm (opencv): Likewise.
* gnu/packages/ipfs.scm (go-github-com-ipfs-shipyard-nopfs-ipfs):
  Likewise.
* gnu/packages/kubernetes.scm (go-go-etcd-io-etcd-client-v3)
  go-go-etcd-io-etcd-pkg-v3, go-go-etcd-io-etcd-server-v3): Likewise.
* gnu/packages/mail.scm (neomutt): Likewise.
* gnu/packages/mpi.scm (openmpi-5): Likewise.
* gnu/packages/protobuf.scm (protobuf-6): Likewise.
* gnu/packages/python-science.scm (python-vaex-core): Likewise.
* gnu/packages/specifications.scm (specification-astropy-data):
  Likewise.
* gnu/packages/taler.scm (taler-docs): Likewise.
* gnu/packages/version-control.scm (libfossil): Likewise.
* gnu/packages/vnc.scm (turbovnc): Likewise.

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>
Co-authored-by: Nguyễn Gia Phong <cnx@loang.net>
Signed-off-by: Nguyễn Gia Phong <cnx@loang.net>

1 files changed, 5 insertions, 80 deletions

diff --git a/gnu/packages/emulators.scm b/gnu/packages/emulators.scm
index eed81854fca..ea62c24d1b7 100644
--- a/gnu/packages/emulators.scm
+++ b/gnu/packages/emulators.scm
@@ -557,13 +557,6 @@ It aims to support Nintendo DSi and 3DS as well.")
                     (srfi srfi-26)))
          (snippet
           #~(begin
-              (define (delete-all-but directory . preserve)
-                (with-directory-excursion directory
-                  (let* ((pred (negate (cut member <>
-                                            (cons* "." ".." preserve))))
-                         (items (scandir "." pred)))
-                    (for-each (cut delete-file-recursively <>) items))))
-
               ;; Clean up the source from bundled libraries we don't need.
               (delete-all-but "Externals"
                               ;; XXX: The build system is currently hard-coded
@@ -760,14 +753,6 @@ turbo speed, networked multiplayer, and graphical enhancements.")
                     (srfi srfi-26)))
          (snippet
           #~(begin
-              ;; XXX: 'delete-all-but' is copied from the turbovnc package.
-              (define (delete-all-but directory . preserve)
-                (with-directory-excursion directory
-                  (let* ((pred (negate (cut member <>
-                                            (cons* "." ".." preserve))))
-                         (items (scandir "." pred)))
-                    (for-each (cut delete-file-recursively <>) items))))
-
               ;; Clean up the source from bundled libraries we don't need.
               (delete-all-but "Externals"
                               ;; XXX: The build system is currently hard-coded
@@ -1195,17 +1180,9 @@ The following systems are supported:
          (sha256
           (base32
            "0dfsz4dsh49dc9xx9rjhfzfkg4h91i2ksgp2inlr9yhgldw9q8h3"))
-         (modules '((guix build utils)
-                    (ice-9 ftw)
-                    (srfi srfi-26)))
+         (modules '((guix build utils)))
          (snippet
           #~(begin
-              (define (delete-all-but directory . preserve)
-                (with-directory-excursion directory
-                  (let* ((pred (negate (cut member <> (cons* "." ".." preserve))))
-                         (items (scandir "." pred)))
-                    (for-each (cut delete-file-recursively <>) items))))
-
               (delete-all-but "src/third-party"
                               "blip_buf"
                               "inih")))))
@@ -2433,42 +2410,9 @@ physical device and the RetroPad virtual controller.")
          (modules '((guix build utils)))
          (snippet
           '(begin
-             (use-modules (guix build utils)
-                          (ice-9 ftw)
-                          (srfi srfi-1)
-                          (srfi srfi-26))
-             (define (delete-all-but . preserve)
-               ;; Walk the file tree and delete everything except the paths
-               ;; listed in PRESERVE.  Directories listed PRESERVE will cause
-               ;; their whole contents to be preserved.
-               (let ((preserve (map (compose (cut string-trim-right <> #\/)
-                                             (cut string-append "./" <>))
-                                    preserve)))
-                 (file-system-fold
-                  (lambda (path stat result) ;enter
-                    (or (any (lambda (x)
-                               (or (string-prefix? path x)
-                                   (string-prefix? x path)))
-                             preserve)
-                        (begin
-                          (delete-file-recursively path)
-                          #f)))
-                  (lambda (path stat result) ;leaf (file)
-                    (unless (any (cut string-prefix? <> path) preserve)
-                      (delete-file path)))
-                  (const #t)                 ;down (directory)
-                  (const #t)                 ;up (directory)
-                  (lambda (path stat result) ;skip
-                    (when (file-exists? path)
-                      (error "could not enter unreadable directory" path)))
-                  (lambda (path stat errno result) ;error
-                    (error "error processing" path (strerror errno)))
-                  0
-                  ".")))
-
              ;; This is an allow-list of the shaders explicitly licensed as
              ;; free software.
-             (delete-all-but
+             (delete-all-but "."
               "anamorphic/shaders/anamorphic.slang" ;expat
               "anamorphic/anamorphic.slangp"
               "annotated_passthru.slang" ;public license
@@ -3125,16 +3069,7 @@ GLSL (@file{.slang}) shaders for use with RetroArch.")
              (commit (string-append "v" version))))
        (snippet
         #~(begin
-            (use-modules (guix build utils)
-                         (ice-9 ftw)
-                         (srfi srfi-26))
-            ;; XXX: 'delete-all-but' is copied from the turbovnc package.
-            (define (delete-all-but directory . preserve)
-              (with-directory-excursion directory
-                (let* ((pred (negate (cut member <>
-                                          (cons* "." ".." preserve))))
-                       (items (scandir "." pred)))
-                  (for-each (cut delete-file-recursively <>) items))))
+            (use-modules (guix build utils))
             ;; Remove as much bundled sources as possible, shaving off about
             ;; 65 MiB.
             (delete-all-but "deps"
@@ -3975,24 +3910,14 @@ de-interlacing patches for use with PCSX2.")
        (file-name (git-file-name name version))
        (sha256
         (base32 "0nr53cjifqwnz3icxsj01yd3aw1vfsfxga4zz5zi8aqr175mvq27"))
-       (modules '((guix build utils)
-                  (ice-9 ftw)
-                  (srfi srfi-26)))
+       (modules '((guix build utils)))
        (snippet
         #~(begin
             (substitute* "cmake/Pcsx2Utils.cmake"
               (("(PCSX2_GIT_REV \")Unknown" _ prefix)
                (string-append prefix #$version "-guix")))
             (delete-file "3rdparty/include/Packet32.h") ;"not open source"
-            ;; XXX: 'delete-all-but' is copied from the turbovnc package.
-            (define (delete-all-but directory . preserve)
-              (with-directory-excursion directory
-                (let* ((pred (negate (cut member <>
-                                          (cons* "." ".." preserve))))
-                       (items (scandir "." pred)))
-                  (for-each (cut delete-file-recursively <>) items))))
-            (delete-all-but
-             "3rdparty"
+            (delete-all-but "3rdparty"
              ;; asl2.0 and cc0
              "glad"                     ;Is tailored.
              ;; bsd-3