diff options
| -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) |