From c0746cc9dbf178e0358e93034072a60b6dfc24a1 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Wed, 17 Oct 2012 23:06:17 +0200
Subject: utils: Add `copy-recursively'; use it.

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

* distro/packages/base.scm (%guile-static-stripped): Use it.
---
 guix/build/utils.scm | 29 +++++++++++++++++++++++++++++
 1 file changed, 29 insertions(+)

(limited to 'guix')

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.
-- 
cgit v1.2.3