~ruther/guix-local

c0746cc9dbf178e0358e93034072a60b6dfc24a1 — Ludovic Courtès 13 years ago 7da9526
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(-)

M distro/packages/base.scm
M guix/build/utils.scm
M distro/packages/base.scm => distro/packages/base.scm +1 -27
@@ 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")))

M guix/build/utils.scm => guix/build/utils.scm +29 -0
@@ 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.