summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--haunt/reader.scm17
-rw-r--r--haunt/site.scm29
2 files changed, 36 insertions, 10 deletions
diff --git a/haunt/reader.scm b/haunt/reader.scm
index 7610482..d078594 100644
--- a/haunt/reader.scm
+++ b/haunt/reader.scm
@@ -63,16 +63,19 @@ metadata with DEFAULT-METADATA."
(append metadata default-metadata)
sxml)))
-(define* (read-posts directory readers #:optional (default-metadata '()))
- "Read all of the files in DIRECTORY as post objects. The READERS
-list must contain a matching reader for every post."
+(define* (read-posts directory ignore? readers #:optional (default-metadata '()))
+ "Read all of the files in DIRECTORY that do not match IGNORE? as
+post objects. The READERS list must contain a matching reader for
+every post."
(define enter? (const #t))
(define (leaf file-name stat memo)
- (let ((reader (find (cut reader-match? <> file-name) readers)))
- (if reader
- (cons (read-post reader file-name default-metadata) memo)
- (error "no reader available for post: " file-name))))
+ (if (ignore? file-name)
+ memo
+ (let ((reader (find (cut reader-match? <> file-name) readers)))
+ (if reader
+ (cons (read-post reader file-name default-metadata) memo)
+ (error "no reader available for post: " file-name)))))
(define (noop file-name stat result)
result)
diff --git a/haunt/site.scm b/haunt/site.scm
index e6604cb..44fd6b3 100644
--- a/haunt/site.scm
+++ b/haunt/site.scm
@@ -23,9 +23,11 @@
;;; Code:
(define-module (haunt site)
+ #:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-26)
#:use-module (ice-9 match)
+ #:use-module (ice-9 regex)
#:use-module (haunt utils)
#:use-module (haunt reader)
#:use-module (haunt page)
@@ -36,21 +38,26 @@
site-title
site-domain
site-posts-directory
+ site-post-filter
site-build-directory
site-default-metadata
site-make-slug
site-readers
site-builders
site-post-slug
- build-site))
+ build-site
+
+ make-file-name-filter
+ default-file-name-filter))
(define-record-type <site>
- (make-site title domain posts-directory build-directory
+ (make-site title domain posts-directory post-filter build-directory
default-metadata make-slug readers builders)
site?
(title site-title)
(domain site-domain)
(posts-directory site-posts-directory)
+ (post-filter site-post-filter)
(build-directory site-build-directory)
(default-metadata site-default-metadata)
(make-slug site-make-slug)
@@ -61,6 +68,7 @@
(title "This Place is Haunted")
(domain "example.com")
(posts-directory "posts")
+ (post-filter default-file-name-filter)
(build-directory "site")
(default-metadata '())
(make-slug post-slug)
@@ -70,13 +78,15 @@
TITLE: The name of the site
POSTS-DIRECTORY: The directory where posts are found
+POST-FILTER: A predicate procedure that returns #t when a post file
+should be ignored (ignores Emacs temp files by default)
BUILD-DIRECTORY: The directory that generated pages are stored in
DEFAULT-METADATA: An alist of arbitrary default metadata for posts
whose keys are symbols
MAKE-SLUG: A procedure generating a file name slug from a post
READERS: A list of reader objects for processing posts
BUILDERS: A list of procedures for building pages from posts"
- (make-site title domain posts-directory build-directory
+ (make-site title domain posts-directory post-filter build-directory
default-metadata make-slug readers builders))
(define (site-post-slug site post)
@@ -86,6 +96,7 @@ BUILDERS: A list of procedures for building pages from posts"
(define (build-site site)
"Build SITE in the appropriate build directory."
(let ((posts (read-posts (site-posts-directory site)
+ (site-post-filter site)
(site-readers site)
(site-default-metadata site)))
(build-dir (absolute-file-name (site-build-directory site))))
@@ -104,3 +115,15 @@ BUILDERS: A list of procedures for building pages from posts"
(obj
(error "unrecognized site object: " obj)))
(flat-map (cut <> site posts) (site-builders site)))))
+
+(define (make-file-name-filter patterns)
+ (let ((patterns (map make-regexp patterns)))
+ (lambda (file-name)
+ (any (lambda (regexp)
+ (regexp-match?
+ (regexp-exec regexp (basename file-name))))
+ patterns))))
+
+;; Filter out Emacs temporary files by default.
+(define default-file-name-filter
+ (make-file-name-filter '("^\\.#")))