diff options
| author | David Thompson <dthompson2@worcester.edu> | 2015-04-11 15:01:40 -0400 |
|---|---|---|
| committer | David Thompson <dthompson2@worcester.edu> | 2015-04-11 15:10:46 -0400 |
| commit | 11a3e70657ffe2727ed0d1164e77c6c9b3420cf4 (patch) | |
| tree | c593be84362a3bc4802519f007a59366d22b3d91 | |
| parent | 7c7b161885c65d870be2aac680a2d4903d5c468a (diff) | |
site: Add build-site procedure.
* haunt/utils.scm (absolute-file-name, clean-directory): New procedures.
* haunt/site.scm (build-site): New procedure.
| -rw-r--r-- | haunt/site.scm | 20 | ||||
| -rw-r--r-- | haunt/utils.scm | 16 |
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)) |