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

pull: Simplify the builder.

Browse source 
* guix/scripts/pull.scm (unpack)[builder]: Use 'copy-recursively' and
  'copy-file' instead of 'file-system-fold'.
This commit is contained in:
Ludovic Courtès 2013-10-12 23:45:57 +02:00
parent ab5d72ad2b
commit 52af657aee
1 changed files with 5 additions and 21 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

26
guix/scripts/pull.scm
View file

@ -47,6 +47,8 @@ (define builder
(ice-9 ftw)
(ice-9 match))
(setvbuf (current-output-port) _IOLBF)
(setvbuf (current-error-port) _IOLBF)
(let ((out (assoc-ref %outputs "out"))
(tar (assoc-ref %build-inputs "tar"))
(gzip (assoc-ref %build-inputs "gzip"))
@ -66,27 +68,9 @@ (define builder
(format #t "copying and compiling Guix to `~a'...~%" out)
;; Copy everything under guix/ and gnu/ plus guix.scm.
(file-system-fold (lambda (dir stat result) ; enter?
(or (string-prefix? "./guix" dir)
(string-prefix? "./gnu" dir)
(string=? "." dir)))
(lambda (file stat result) ; leaf
(when (or (not (string=? (dirname file) "."))
(string=? (basename file) "guix.scm"))
(let ((target (string-drop file 1)))
(copy-file file
(string-append out target)))))
(lambda (dir stat result) ; down
(mkdir (string-append out
(string-drop dir 1))))
(const #t) ; up
(const #t) ; skip
(lambda (file stat errno result)
(error "cannot access file"
file (strerror errno)))
#f
"."
lstat)
(copy-recursively "guix" (string-append out "/guix"))
(copy-recursively "gnu" (string-append out "/gnu"))
(copy-file "guix.scm" (string-append out "/guix.scm"))
;; Add a fake (guix config) module to allow the other modules to be
;; compiled. The user's (guix config) is the one that will be used.