diff options
| author | David Thompson <dthompson2@worcester.edu> | 2015-04-11 23:29:20 -0400 |
|---|---|---|
| committer | David Thompson <dthompson2@worcester.edu> | 2015-04-11 23:29:20 -0400 |
| commit | 06321fbdd8ee13aba3ac1a058cfa56efad56b287 (patch) | |
| tree | 973d9020394f6032ac5956d8cc33561bf52be97f | |
| parent | 325ecc79340d10d436c35785ebc20cd670d9cb15 (diff) | |
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.
| -rw-r--r-- | haunt/site.scm | 2 | ||||
| -rw-r--r-- | haunt/utils.scm | 34 |
2 files changed, 27 insertions, 9 deletions
diff --git a/haunt/site.scm b/haunt/site.scm index 92146e8..c60e110 100644 --- a/haunt/site.scm +++ b/haunt/site.scm @@ -77,7 +77,7 @@ BUILDERS: A list of procedures for building pages from posts" (site-readers site) (site-default-metadata site))) (build-dir (absolute-file-name (site-build-directory site)))) - (clean-directory build-dir) + (delete-file-recursively build-dir) (for-each (lambda (page) (format #t "writing '~a'~%" (page-file-name page)) (write-page page build-dir)) diff --git a/haunt/utils.scm b/haunt/utils.scm index 7eb1583..a84429d 100644 --- a/haunt/utils.scm +++ b/haunt/utils.scm @@ -1,6 +1,6 @@ ;;; Haunt --- Static site generator for GNU Guile ;;; 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. ;;; @@ -33,7 +33,7 @@ flat-map string-split-at absolute-file-name - clean-directory + delete-file-recursively mkdir-p string->date* take-up-to)) @@ -68,13 +68,31 @@ flattened." file-name (string-append (getcwd) "/" file-name))) -(define (clean-directory dir) - (define (delete-other-files file-name stat flag) - (unless (string=? dir file-name) - (delete-file file-name)) - #t) +;; Written by Ludovic Courtès for GNU Guix. +(define* (delete-file-recursively dir + #:key follow-mounts?) + "Delete DIR recursively, like `rm -rf', without following symlinks. Don'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. (define (mkdir-p dir) |