Add support for Skribe document format.

* haunt/skribe.scm: New file.
* haunt/skribe/utils.scm: New file.
* haunt/reader/skribe.scm: New file.
* configure.ac: Check for guile-reader.
* Makefile.am (SOURCES): Add Skribe modules when guile-reader is
  available.
* example/haunt.scm: Include Skribe reader.
* example/posts/baz.skr: New file.
* README.md ("Requirements"): Mention guile-reader as optional dependency.

8 files changed, 264 insertions, 6 deletions

diff --git a/Makefile.am b/Makefile.am
index b6094c6..541d17f 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -60,6 +60,15 @@ SOURCES =					\
   haunt/serve/mime-types.scm			\
   haunt/serve/web-server.scm
 
+if HAVE_GUILE_READER
+
+SOURCES +=					\
+  haunt/skribe.scm				\
+  haunt/skribe/utils.scm			\
+  haunt/reader/skribe.scm
+
+endif
+
 EXTRA_DIST +=					\
   pre-inst-env.in				\
   README.md					\
diff --git a/README.md b/README.md
index a0bd76f..1d856a5 100644
--- a/README.md
+++ b/README.md
@@ -50,7 +50,11 @@ To view your creation, run `haunt serve` and browse to
 Requirements
 ------------
 
-GNU Guile >= 2.0.11
+- GNU Guile >= 2.0.11
+
+Optional:
+
+- guile-reader (for Skribe support)
 
 Building from Git
 -----------------
diff --git a/configure.ac b/configure.ac
index 46b186c..c623045 100644
--- a/configure.ac
+++ b/configure.ac
@@ -12,4 +12,8 @@ AC_CONFIG_FILES([scripts/haunt], [chmod +x scripts/haunt])
 
 GUILE_PROGS([2.0.11])
 
+dnl Guile-reader is needed for Skribe support
+GUILE_MODULE_AVAILABLE([have_guile_reader], [(system reader)])
+AM_CONDITIONAL([HAVE_GUILE_READER], [test "x$have_guile_reader" = "xyes"])
+
 AC_OUTPUT
diff --git a/example/haunt.scm b/example/haunt.scm
index b292c9c..4095f87 100644
--- a/example/haunt.scm
+++ b/example/haunt.scm
@@ -1,16 +1,17 @@
-(use-modules (haunt site)
-             (haunt reader)
-             (haunt asset)
+(use-modules (haunt asset)
              (haunt builder blog)
              (haunt builder atom)
-             (haunt builder assets))
+             (haunt builder assets)
+             (haunt reader)
+             (haunt reader skribe)
+             (haunt site))
 
 (site #:title "Built with Guile"
       #:domain "example.com"
       #:default-metadata
       '((author . "Eva Luator")
         (email  . "eva@example.com"))
-      #:readers (list sxml-reader html-reader)
+      #:readers (list skribe-reader sxml-reader html-reader)
       #:builders (list (blog)
                        (atom-feed)
                        (atom-feeds-by-tag)
diff --git a/example/posts/baz.skr b/example/posts/baz.skr
new file mode 100644
index 0000000..abfb51a
--- /dev/null
+++ b/example/posts/baz.skr
@@ -0,0 +1,29 @@
+(post
+ :title "Hello, Skribe!"
+ :date (make-date* 2015 10 09 23 00)
+ :tags '("foo" "bar" "baz")
+
+ (h1 [Hello!])
+
+ (p [This is a Skribe document!])
+
+ (p [Skribe is a ,(em [really]) cool document authoring format that
+     provides all the power of Scheme whilst giving the user a
+     means to write literal text without stuffing it into a string
+     literal.  If this sort of thing suits you, be sure to check out
+     ,(anchor "Skribilo" "http://www.nongnu.org/skribilo/"), too.])
+
+ (p [Here's a simple list generated by Scheme code:])
+
+ (ul (map li '("foo" "bar" "baz")))
+
+ (p [And here's a code snippet of how I build Haunt using GNU Guix:])
+
+ (source-code
+  "guix environment -l package.scm
+./configure
+make")
+
+ (p [And finally, here's an image:])
+
+ (image "/images/guile-banner.small.png"))
diff --git a/haunt/reader/skribe.scm b/haunt/reader/skribe.scm
new file mode 100644
index 0000000..cf88504
--- /dev/null
+++ b/haunt/reader/skribe.scm
@@ -0,0 +1,44 @@
+;;; Haunt --- Static site generator for GNU Guile
+;;; Copyright © 2015 David Thompson <davet@gnu.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:
+;;
+;; Skribe post reader.
+;;
+;;; Code:
+
+(define-module (haunt reader skribe)
+  #:use-module (haunt reader)
+  #:use-module (haunt skribe)
+  #:use-module (haunt skribe utils)
+  #:use-module (haunt utils)
+  #:export (make-skribe-reader
+            skribe-reader))
+
+(define* (make-skribe-reader #:key (modules '((haunt skribe utils))))
+  "Return a new Skribe post reader that imports MODULES by default
+before reading a document."
+  (make-reader (make-file-extension-matcher "skr")
+               (lambda (file)
+                 (let ((file (absolute-file-name file)))
+                   (save-module-excursion
+                    (lambda ()
+                      (set-current-module (make-user-module modules))
+                      (load file %skribe-reader)))))))
+
+(define skribe-reader (make-skribe-reader))
diff --git a/haunt/skribe.scm b/haunt/skribe.scm
new file mode 100644
index 0000000..7ce5457
--- /dev/null
+++ b/haunt/skribe.scm
@@ -0,0 +1,82 @@
+;;; Haunt --- Static site generator for GNU Guile
+;;; Copyright © 2015 David Thompson <davet@gnu.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:
+;;
+;; Skribe reader.
+;;
+;;; Code:
+
+(define-module (haunt skribe)
+  #:use-module ((system reader) #:renamer (symbol-prefix-proc 'r:))
+  #:export (%skribe-reader))
+
+;; Taken from Skribilo
+(define (make-colon-free-token-reader tr)
+  ;; Stolen from `guile-reader' 0.3.
+  "If token reader @var{tr} handles the @code{:} (colon) character, remove it
+from its specification and return the new token reader."
+  (let* ((spec (r:token-reader-specification tr))
+	 (proc (r:token-reader-procedure tr)))
+    (r:make-token-reader (filter (lambda (chr)
+				   (not (char=? chr #\:)))
+				 spec)
+			 proc)))
+
+(define &sharp-reader
+  ;; The reader for what comes after a `#' character.
+  (let* ((dsssl-keyword-reader  ;; keywords à la `#!key'
+          (r:make-token-reader #\!
+ 			       (r:token-reader-procedure
+ 				(r:standard-token-reader 'keyword)))))
+      (r:make-reader (cons dsssl-keyword-reader
+			   (map r:standard-token-reader
+				'(character srfi-4 vector
+				  number+radix boolean
+				  srfi30-block-comment
+				  srfi62-sexp-comment)))
+		     #f ;; use default fault handler
+		     'reader/record-positions)))
+
+(define (make-skribe-reader)
+  (let ((colon-keywords ;; keywords à la `:key' fashion
+	 (r:make-token-reader #\:
+			      (r:token-reader-procedure
+			       (r:standard-token-reader 'keyword))))
+	(symbol-misc-chars-tr
+	 ;; Make sure `:' is handled only by the keyword token reader.
+	 (make-colon-free-token-reader
+	  (r:standard-token-reader 'r6rs-symbol-misc-chars))))
+
+    ;; Note: we use the `r6rs-symbol-*' and `r6rs-number' token readers since
+    ;; they consider square brackets as delimiters.
+    (r:make-reader (cons* (r:make-token-reader #\# &sharp-reader)
+			  colon-keywords
+			  symbol-misc-chars-tr
+			  (map r:standard-token-reader
+			       `(whitespace
+				 sexp string r6rs-number
+				 r6rs-symbol-lower-case
+				 r6rs-symbol-upper-case
+				 quote-quasiquote-unquote
+				 semicolon-comment
+				 skribe-exp)))
+		   #f ;; use the default fault handler
+		   'reader/record-positions)))
+
+(define %skribe-reader (make-skribe-reader))
diff --git a/haunt/skribe/utils.scm b/haunt/skribe/utils.scm
new file mode 100644
index 0000000..edd9977
--- /dev/null
+++ b/haunt/skribe/utils.scm
@@ -0,0 +1,85 @@
+;;; Haunt --- Static site generator for GNU Guile
+;;; Copyright © 2015 David Thompson <davet@gnu.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:
+;;
+;; Skribe helper procedures.
+;;
+;;; Code:
+
+(define-module (haunt skribe utils)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-19)
+  #:export (post
+
+            p blockquote em
+            h1 h2 h3 h4
+            code pre strong
+            ul li dl dt dd
+            anchor
+            image
+            source-code
+
+            make-date*))
+
+(define (post . metadata+sxml)
+  "Create a new Skribe post by parsing out the metadata and SXML
+contents from METADATA+SXML."
+  (let loop ((stuff metadata+sxml)
+             (metadata '()))
+    (match stuff
+      (() (values metadata '()))
+      (((and (? keyword?) (= keyword->symbol key)) value . rest)
+       (loop rest (alist-cons key value metadata)))
+      (_ (values metadata stuff)))))
+
+;; Basic SXML constructors.
+(define-syntax-rule (define-simple-sxml-constructors tag ...)
+  (begin
+    (define (tag . contents)
+      `(tag ,@contents)) ...))
+
+(define-simple-sxml-constructors
+  p blockquote
+  em strong
+  code samp pre kbd var
+  cite dfn abbr
+  h1 h2 h3 h4
+  ul ol li dl dt dd)
+
+(define (anchor text uri)
+  "Return an anchor SXML node that contains TEXT and points to to URI."
+  `(a (@ (href ,uri)) ,text))
+
+(define* (image uri #:key (alt-text ""))
+  "Return an image SXML node that points to a URI for an image.
+Optionally, the ALT-TEXT keyword argument may be a string that
+contains a description of the image."
+  `(img (@ (src ,uri) (alt ,alt-text))))
+
+(define (source-code . code)
+  "Return an SXML node that wraps CODE in a 'pre' and 'code' tag to
+create a code block."
+  `(pre (code ,code)))
+
+(define* (make-date* year month day #:optional (hour 0) (minute 0))
+  "Create a SRFI-19 date for the given YEAR, MONTH, DAY, HOUR (24-hour
+format), and MINUTE."
+  (let ((tzoffset (tm:gmtoff (localtime (time-second (current-time))))))
+    (make-date 0 0 minute hour day month year tzoffset)))