ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 05:18:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

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

Browse source 
* 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 @@ (define %guile-static-stripped
`(#: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")))

29
guix/build/utils.scm
View file

@ -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 @@ (define-module (guix build utils)
#: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 @@ (define not-slash
(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.