Add flat pages builder.

3 files changed, 140 insertions, 0 deletions

diff --git a/Makefile.am b/Makefile.am
index cfe85bd..dece665 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -59,6 +59,7 @@ SOURCES =					\
   haunt/builder/blog.scm			\
   haunt/builder/rss.scm				\
   haunt/builder/redirects.scm			\
+  haunt/builder/flat-pages.scm			\
   haunt/reader/texinfo.scm			\
   haunt/publisher/rsync.scm			\
   haunt/publisher/sourcehut.scm			\
diff --git a/doc/haunt.texi b/doc/haunt.texi
index 7857b38..50d1cf8 100644
--- a/doc/haunt.texi
+++ b/doc/haunt.texi
@@ -818,6 +818,7 @@ specification of Markdown, learn more about CommomMark
 
 @menu
 * Static Assets::              Images, CSS, JavaScript, etc.
+* Flat pages::                 Simple static pages.
 * Blog::                       Dear diary...
 * Atom::                       Atom feeds.
 * RSS::                        RSS feeds.
@@ -846,6 +847,64 @@ and copies them into @var{dest}, a prefix relative to a site's target
 output directory.  By default, @var{dest} is @var{directory}.
 @end deffn
 
+@node Flat pages
+@subsection Flat pages
+
+@example
+(use-modules (haunt builder flat-pages))
+@end example
+
+Flat pages cover the simple case of converting a tree of files written
+in some markup language to full web pages.  Flat pages work great for
+the more informational parts of a website that don't require any fancy
+programming to generate, like an ``About me'' page.
+
+@deffn {Procedure} flat-pages directory [#:template] [#:prefix]
+
+Return a procedure that parses the files in @var{directory} and
+returns a list of HTML pages, one for each file.  The files are parsed
+using the readers configured for the current site.
+
+Each flat page starts with a metadata header.  Only a single piece of
+metadata is used, though: the title.
+
+Here's what a flat page written in Markdown might look like:
+
+@example
+title: About me
+---
+
+# About me
+
+Hello, I am Alice!  I'm a fictitious person made up for the purposes
+of demonstrating Haunt's flat page functionality.  I live here in this
+manual with my two cats: Bob and Carol.
+@end example
+
+The content of each flat page is inserted into a complete HTML
+document by the @var{template} procedure.  This procedure takes three
+arguments:
+
+@itemize
+@item the site object
+@item the page title string (from the metadata header)
+@item an SXML tree of the page body
+@end itemize
+
+@var{template} should return a single value: a new SXML tree
+representing a complete HTML page that presumably wraps the page body.
+
+Conveniently, the signature of @var{template} matches the blog theme
+layout procedure so that it can be reused for flat pages.  @xref{Blog}
+for more information.
+
+The structure of @var{directory} is preserved in the resulting pages
+and may be optionally nested within the directory @var{prefix}.  If no
+prefix is specified, the files are placed starting at the root of the
+site.
+
+@end deffn
+
 @node Blog
 @subsection Blog
 
diff --git a/haunt/builder/flat-pages.scm b/haunt/builder/flat-pages.scm
new file mode 100644
index 0000000..98913c0
--- /dev/null
+++ b/haunt/builder/flat-pages.scm
@@ -0,0 +1,80 @@
+;;; Haunt --- Static site generator for GNU Guile
+;;; Copyright © 2015 David Thompson <davet@gnu.org>
+;;; Copyright © 2016 Christopher Allan Webber <cwebber@dustycloud.org>
+;;;
+;;; This file is part of Haunt.
+;;;
+;;; Haunt is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; Haunt is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with Haunt.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; Simple static web pages.
+;;
+;;; Code:
+
+(define-module (haunt builder flat-pages)
+  #:use-module (haunt artifact)
+  #:use-module (haunt html)
+  #:use-module (haunt post)
+  #:use-module (haunt reader)
+  #:use-module (haunt site)
+  #:use-module (haunt utils)
+  #:use-module (ice-9 ftw)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-11)
+  #:export (flat-pages))
+
+(define* (flat-pages directory #:key
+                     template
+                     prefix)
+  "Return a procedure that parses the files in DIRECTORY and returns a
+list of HTML pages, one for each file.  The files are parsed using the
+readers configured for the current site.  The structure of DIRECTORY
+is preserved in the resulting pages and may be optionally nested
+within the directory PREFIX.
+
+The content of each flat page is inserted into a complete HTML
+document by the TEMPLATE procedure.  This procedure takes three
+arguments: the site object, the page title string, and an SXML tree of
+the page body.  It returns one value: a new SXML tree representing a
+complete HTML page that presumably wraps the page body."
+  (lambda (site posts)
+    ;; Recursively scan the directory and generate a page for each
+    ;; file found.
+    (define (enter? file-name stat memo) #t)
+    (define (noop file-name stat memo) memo)
+    (define keep? (site-file-filter site))
+    (define (leaf file-name stat memo)
+      (if (keep? file-name) (cons file-name memo) memo))
+    (define (err file-name stat errno memo)
+      (error "flat page directory scanning failed" file-name errno))
+    (define src-files
+      (file-system-fold enter? leaf noop noop noop err '() directory))
+    (define (strip-extension file-name)
+      (basename file-name
+                (string-append "." (file-extension file-name))))
+    (map (lambda (file-name)
+           (match (reader-find (site-readers site) file-name)
+             (reader
+              (let-values (((metadata body) (reader-read reader file-name)))
+                (let* ((dir (substring (dirname file-name)
+                                       (string-length directory)))
+                       (out (string-append (or prefix "/") dir
+                                           (if (string-null? dir) "" "/")
+                                           (strip-extension file-name) ".html"))
+                       (title (or (assq-ref metadata 'title) "Untitled")))
+                  (serialized-artifact out (template site title body)
+                                       sxml->html))))
+             (#f (error "no reader available for page" file-name))))
+         src-files)))