dan
/
haunt
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

site: Fix cleaning step before building. 

Cleaning the build directory failed when a subdirectory existed.

* haunt/utils.scm (clean-directory): Remove.
  (delete-file-recursively): New procedure.
* haunt/site.scm (build-site): Use delete-file-recursively.
This commit is contained in:
David Thompson 2015-04-11 23:29:20 -04:00
parent 325ecc7934
commit 06321fbdd8
2 changed files with 27 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
haunt/site.scm
View File

@ -77,7 +77,7 @@ BUILDERS: A list of procedures for building pages from posts"
(site-readers site) (site-readers site)
(site-default-metadata site))) (site-default-metadata site)))
(build-dir (absolute-file-name (site-build-directory site)))) (build-dir (absolute-file-name (site-build-directory site))))
(clean-directory build-dir) (delete-file-recursively build-dir)
(for-each (lambda (page) (for-each (lambda (page)
(format #t "writing '~a'~%" (page-file-name page)) (format #t "writing '~a'~%" (page-file-name page))
(write-page page build-dir)) (write-page page build-dir))

34
haunt/utils.scm
View File

@ -1,6 +1,6 @@
;;; Haunt --- Static site generator for GNU Guile ;;; Haunt --- Static site generator for GNU Guile
;;; Copyright © 2015 David Thompson <davet@gnu.org> ;;; Copyright © 2015 David Thompson <davet@gnu.org>
;;; Copyright © 2012 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of Haunt. ;;; This file is part of Haunt.
;;; ;;;
@ -33,7 +33,7 @@
flat-map flat-map
string-split-at string-split-at
absolute-file-name absolute-file-name
clean-directory delete-file-recursively
mkdir-p mkdir-p
string->date* string->date*
take-up-to)) take-up-to))
@ -68,13 +68,31 @@ flattened."
file-name file-name
(string-append (getcwd) "/" file-name))) (string-append (getcwd) "/" file-name)))
(define (clean-directory dir) ;; Written by Ludovic Courtès for GNU Guix.
(define (delete-other-files file-name stat flag) (define* (delete-file-recursively dir
(unless (string=? dir file-name) #:key follow-mounts?)
(delete-file file-name)) "Delete DIR recursively, like `rm -rf', without following symlinks. Don't
#t) follow mount points either, unless FOLLOW-MOUNTS? is true. Report but ignore
errors."
(let ((dev (stat:dev (lstat dir))))
(file-system-fold (lambda (dir stat result) ; enter?
(or follow-mounts?
(= dev (stat:dev stat))))
(lambda (file stat result) ; leaf
(delete-file file))
(const #t) ; down
(lambda (dir stat result) ; up
(rmdir dir))
(const #t) ; skip
(lambda (file stat errno result)
(format (current-error-port)
"warning: failed to delete ~a: ~a~%"
file (strerror errno)))
#t
dir
(ftw dir delete-other-files)) ;; Don't follow symlinks.
lstat)))
;; Written by Ludovic Courtès for GNU Guix. ;; Written by Ludovic Courtès for GNU Guix.
(define (mkdir-p dir) (define (mkdir-p dir)