nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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

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

* distro/packages/base.scm (%guile-static-stripped): Use it.
This commit is contained in:
Ludovic Courtès 2012-10-17 23:06:17 +02:00
parent 7da95264f1
commit c0746cc9db
2 changed files with 30 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
distro/packages/base.scm
View File

@ -2096,33 +2096,7 @@ store.")
`(#:modules ((guix build utils)) `(#:modules ((guix build utils))
#:builder #:builder
(let () (let ()
(use-modules (ice-9 ftw) (use-modules (guix build utils))
(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
".")))
(let ((in (assoc-ref %build-inputs "guile")) (let ((in (assoc-ref %build-inputs "guile"))
(out (assoc-ref %outputs "out"))) (out (assoc-ref %outputs "out")))

29
guix/build/utils.scm
View File

@ -19,6 +19,7 @@
(define-module (guix build utils) (define-module (guix build utils)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-11) #:use-module (srfi srfi-11)
#:use-module (ice-9 ftw)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 regex) #:use-module (ice-9 regex)
#:use-module (ice-9 rdelim) #:use-module (ice-9 rdelim)
@ -27,6 +28,7 @@
#:export (directory-exists? #:export (directory-exists?
with-directory-excursion with-directory-excursion
mkdir-p mkdir-p
copy-recursively
set-path-environment-variable set-path-environment-variable
search-path-as-string->list search-path-as-string->list
list->search-path-as-string list->search-path-as-string
@ -88,6 +90,33 @@
(apply throw args)))))) (apply throw args))))))
(() #t)))) (() #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. ;;; Search paths.