summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--haunt/site.scm20
-rw-r--r--haunt/utils.scm16
2 files changed, 34 insertions, 2 deletions
diff --git a/haunt/site.scm b/haunt/site.scm
index b731e9b..e686ecf 100644
--- a/haunt/site.scm
+++ b/haunt/site.scm
@@ -24,6 +24,10 @@
(define-module (haunt site)
#:use-module (srfi srfi-9)
+ #:use-module (srfi srfi-26)
+ #:use-module (haunt utils)
+ #:use-module (haunt reader)
+ #:use-module (haunt page)
#:export (site
site?
site-title
@@ -31,7 +35,8 @@
site-build-directory
site-default-metadata
site-readers
- site-builders))
+ site-builders
+ build-site))
(define-record-type <site>
(make-site title posts-directory build-directory default-metadata
@@ -62,3 +67,16 @@ READERS: A list of reader objects for processing posts
BUILDERS: A list of procedures for building pages from posts"
(make-site title posts-directory build-directory
default-metadata readers builders))
+
+(define (build-site site)
+ "Build SITE in the appropriate build directory."
+ (let ((posts (read-posts (site-posts-directory site)
+ (site-readers site)
+ (site-default-metadata site)))
+ (build-dir (absolute-file-name (site-build-directory site))))
+ (clean-directory build-dir)
+ (for-each (lambda (page)
+ (format #t "writing ~a" (page-file-name page))
+ (write-page page build-dir)
+ (format #t " ✓~%"))
+ (flat-map (cut <> site posts) (site-builders site)))))
diff --git a/haunt/utils.scm b/haunt/utils.scm
index 504d6e2..8923e13 100644
--- a/haunt/utils.scm
+++ b/haunt/utils.scm
@@ -29,7 +29,9 @@
#:use-module (srfi srfi-26)
#:export (flatten
flat-map
- string-split-at))
+ string-split-at
+ absolute-file-name
+ clean-directory))
(define* (flatten lst #:optional depth)
"Return a list that recursively concatenates the sub-lists of LST,
@@ -56,3 +58,15 @@ flattened."
(string-drop str (1+ i)))
(list str))))
+(define (absolute-file-name file-name)
+ (if (absolute-file-name? file-name)
+ 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)
+
+ (ftw dir delete-other-files))