summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--haunt/site.scm2
-rw-r--r--haunt/utils.scm34
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)