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.
This commit is contained in:
David Thompson 2015-10-12 19:32:05 -04:00
parent ec79e5ad1f
commit 1ddcff389d
8 changed files with 264 additions and 6 deletions

View File

@ -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 \

View File

@ -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
-----------------

View File

@ -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

View File

@ -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)

29
example/posts/baz.skr Normal file
View File

@ -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"))

44
haunt/reader/skribe.scm Normal file
View File

@ -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))

82
haunt/skribe.scm Normal file
View File

@ -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))

85
haunt/skribe/utils.scm Normal file
View File

@ -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)))