diff options
| -rw-r--r-- | haunt/page.scm | 3 | ||||
| -rw-r--r-- | haunt/utils.scm | 30 |
2 files changed, 31 insertions, 2 deletions
diff --git a/haunt/page.scm b/haunt/page.scm index c496c45..85b2ae6 100644 --- a/haunt/page.scm +++ b/haunt/page.scm @@ -26,7 +26,7 @@ #:use-module (ice-9 match) #:use-module (srfi srfi-9) #:use-module (srfi srfi-26) - #:use-module (haunt build html) + #:use-module (haunt utils) #:export (make-page page? page-file-name @@ -46,4 +46,5 @@ (match page (($ <page> file-name contents writer) (let ((output (string-append output-directory "/" file-name))) + (mkdir-p (dirname output)) (call-with-output-file output (cut writer contents <>)))))) 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)))) |