utils: Add `copy-recursively'; use it.

* guix/build/utils.scm (copy-recursively): New procedure.

* distro/packages/base.scm (%guile-static-stripped): Use it.

2 files changed, 30 insertions, 27 deletions

diff --git a/distro/packages/base.scm b/distro/packages/base.scm
index 7fb26881e2..1b3d96a93b 100644
--- a/distro/packages/base.scm
+++ b/distro/packages/base.scm
@@ -2096,33 +2096,7 @@ store.")
      `(#:modules ((guix build utils))
        #:builder
        (let ()
-         (use-modules (ice-9 ftw)
-                      (guix build utils))
-
-         (define (copy-recursively source destination)
-           ;; Copy SOURCE directory to DESTINATION.
-           (with-directory-excursion source
-             (file-system-fold (const #t)
-                               (lambda (file stat result) ; leaf
-                                 (format #t "copying `~s/~s' to `~s'...~%"
-                                         source file destination)
-                                 (copy-file file
-                                            (string-append destination
-                                                           "/" file)))
-                               (lambda (dir stat result)  ; down
-                                 (let ((dir (string-append destination
-                                                           "/" dir)))
-                                   (unless (file-exists? dir)
-                                     (mkdir dir))))
-                               (lambda (dir stat result)  ; up
-                                 result)
-                               (const #t)                 ; skip
-                               (lambda (file stat errno result)
-                                 (format (current-error-port)
-                                         "i/o error: ~a: ~a~%" file
-                                         (strerror errno)))
-                               #t
-                               ".")))
+         (use-modules (guix build utils))
 
          (let ((in  (assoc-ref %build-inputs "guile"))
                (out (assoc-ref %outputs "out")))
diff --git a/guix/build/utils.scm b/guix/build/utils.scm
index 0543ab48d5..741f5201bb 100644
--- a/guix/build/utils.scm
+++ b/guix/build/utils.scm
@@ -19,6 +19,7 @@
 (define-module (guix build utils)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
+  #:use-module (ice-9 ftw)
   #:use-module (ice-9 match)
   #:use-module (ice-9 regex)
   #:use-module (ice-9 rdelim)
@@ -27,6 +28,7 @@
   #:export (directory-exists?
             with-directory-excursion
             mkdir-p
+            copy-recursively
             set-path-environment-variable
             search-path-as-string->list
             list->search-path-as-string
@@ -88,6 +90,33 @@
                  (apply throw args))))))
       (() #t))))
 
+(define* (copy-recursively source destination
+                           #:optional (log (current-output-port)))
+  "Copy SOURCE directory to DESTINATION."
+  (define strip-source
+    (let ((len (string-length source)))
+      (lambda (file)
+        (substring file len))))
+
+  (file-system-fold (const #t)                    ; enter?
+                    (lambda (file stat result)    ; leaf
+                      (let ((dest (string-append destination
+                                                 (strip-source file))))
+                        (format log "`~a' -> `~a'~%" file dest)
+                        (copy-file file dest)))
+                    (lambda (dir stat result)     ; down
+                      (mkdir-p (string-append destination
+                                              (strip-source dir))))
+                    (lambda (dir stat result)     ; up
+                      result)
+                    (const #t)                    ; skip
+                    (lambda (file stat errno result)
+                      (format (current-error-port) "i/o error: ~a: ~a~%"
+                              file (strerror errno))
+                      #f)
+                    #t
+                    source))
+
 
 ;;;
 ;;; Search paths.