summaryrefslogtreecommitdiff
path: root/haunt/utils.scm
diff options
context:
space:
mode:
authorDavid Thompson <dthompson2@worcester.edu>2015-04-11 15:14:27 -0400
committerDavid Thompson <dthompson2@worcester.edu>2015-04-11 15:16:33 -0400
commitd4ff34e7122c9832de599c5b34f070634b6c5116 (patch)
tree60aac937a4741235cf5a2f37183fd076a2074679 /haunt/utils.scm
parent3320a67edb789c764fb539e97656ae811227065d (diff)
page: Ensure output directory exists before writing.
* haunt/utils.scm (mkdir-p): New procedure. * haunt/page.scm (write-page): Create missing directories before writing.
Diffstat (limited to 'haunt/utils.scm')
-rw-r--r--haunt/utils.scm30
1 files changed, 29 insertions, 1 deletions
diff --git a/haunt/utils.scm b/haunt/utils.scm
index 8923e13..b49af4e 100644
--- a/haunt/utils.scm
+++ b/haunt/utils.scm
@@ -1,5 +1,6 @@
;;; Haunt --- Static site generator for GNU Guile
;;; Copyright © 2015 David Thompson <davet@gnu.org>
+;;; Copyright © 2012 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of Haunt.
;;;
@@ -31,7 +32,8 @@
flat-map
string-split-at
absolute-file-name
- clean-directory))
+ clean-directory
+ mkdir-p))
(define* (flatten lst #:optional depth)
"Return a list that recursively concatenates the sub-lists of LST,
@@ -70,3 +72,29 @@ flattened."
#t)
(ftw dir delete-other-files))
+
+;; Written by Ludovic Courtès for GNU Guix.
+(define (mkdir-p dir)
+ "Create directory DIR and all its ancestors."
+ (define absolute?
+ (string-prefix? "/" dir))
+
+ (define not-slash
+ (char-set-complement (char-set #\/)))
+
+ (let loop ((components (string-tokenize dir not-slash))
+ (root (if absolute?
+ ""
+ ".")))
+ (match components
+ ((head tail ...)
+ (let ((path (string-append root "/" head)))
+ (catch 'system-error
+ (lambda ()
+ (mkdir path)
+ (loop tail path))
+ (lambda args
+ (if (= EEXIST (system-error-errno args))
+ (loop tail path)
+ (apply throw args))))))
+ (() #t))))