3 | ##
4 | ## This file is part of Haunt.
5 | ##
6 | ## Haunt is free software; you can redistribute it and/or modify it
7 | ## under the terms of the GNU General Public License as published by
8 | ## the Free Software Foundation; either version 3 of the License, or
9 | ## (at your option) any later version.
10 | ##
11 | ## Haunt is distributed in the hope that it will be useful, but
12 | ## WITHOUT ANY WARRANTY; without even the implied warranty of
13 | ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
14 | ## General Public License for more details.
15 | ##
16 | ## You should have received a copy of the GNU General Public License
17 | ## along with Haunt. If not, see .
18 |
19 | exampledir = $(pkgdatadir)/example
20 | nobase_dist_example_DATA = \
21 | haunt.scm \
22 | images/guile-banner.small.png \
23 | posts/foo.sxml \
24 | posts/bar.html
25 |
--------------------------------------------------------------------------------
/example/haunt.scm:
--------------------------------------------------------------------------------
1 | (use-modules (haunt site)
2 | (haunt reader)
3 | (haunt asset)
4 | (haunt builder blog)
5 | (haunt builder atom)
6 | (haunt builder assets))
7 |
8 | (site #:title "Built with Guile"
9 | #:domain "example.com"
10 | #:default-metadata
11 | '((author . "Eva Luator")
12 | (email . "eva@example.com"))
13 | #:readers (list sxml-reader html-reader)
14 | #:builders (list (blog)
15 | (atom-feed)
16 | (atom-feeds-by-tag)
17 | (static-directory "images")))
18 |
--------------------------------------------------------------------------------
/example/images/guile-banner.small.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/guildhall/guile-haunt/c67e8e924c664ae4035862cc7b439cd7ec4bcef6/example/images/guile-banner.small.png
--------------------------------------------------------------------------------
/example/posts/bar.html:
--------------------------------------------------------------------------------
1 | title: A Foo Walks Into a Bar
2 | date: 2015-04-11 20:00
3 | tags: bar
4 | ---
5 |
6 | This is an example using raw HTML, because Guile doesn't have a
7 | Markdown parser.
8 |
9 |
--------------------------------------------------------------------------------
/example/posts/foo.sxml:
--------------------------------------------------------------------------------
1 | ;;; -*- scheme -*-
2 |
3 | (use-modules (srfi srfi-41)
4 | (haunt utils))
5 |
6 | (define fib
7 | (stream-cons 0 (stream-cons 1 (stream-map + fib (stream-cdr fib)))))
8 |
9 | (define count 20)
10 |
11 | `((title . "Hello, world!")
12 | (date . ,(string->date* "2015-04-10 23:00"))
13 | (tags "foo" "bar")
14 | (summary . "Just a test")
15 | (content
16 | ((h2 "What is this thing?")
17 | (p "This is Haunt. A static site generator for GNU Guile.")
18 | (p "SXML is cool because you can evaluate Scheme code in your blog
19 | posts. Here are the first "
20 | ,count
21 | " fibonacci numbers, computed with SRFI-41!")
22 | (pre ,(object->string
23 | (stream->list
24 | (stream-take count fib))))
25 | (p "Guile Scheme is great, eh?")
26 | (img (@ (src "/images/guile-banner.small.png"))))))
27 |
--------------------------------------------------------------------------------
/haunt/asset.scm:
--------------------------------------------------------------------------------
1 | ;;; Haunt --- Static site generator for GNU Guile
2 | ;;; Copyright © 2015 David Thompson
3 | ;;;
4 | ;;; This file is part of Haunt.
5 | ;;;
6 | ;;; Haunt is free software; you can redistribute it and/or modify it
7 | ;;; under the terms of the GNU General Public License as published by
8 | ;;; the Free Software Foundation; either version 3 of the License, or
9 | ;;; (at your option) any later version.
10 | ;;;
11 | ;;; Haunt is distributed in the hope that it will be useful, but
12 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
13 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
14 | ;;; General Public License for more details.
15 | ;;;
16 | ;;; You should have received a copy of the GNU General Public License
17 | ;;; along with Haunt. If not, see .
18 |
19 | ;;; Commentary:
20 | ;;
21 | ;; Static asset data type.
22 | ;;
23 | ;;; Code:
24 |
25 | (define-module (haunt asset)
26 | #:use-module (srfi srfi-1)
27 | #:use-module (srfi srfi-9)
28 | #:use-module (ice-9 ftw)
29 | #:use-module (ice-9 match)
30 | #:use-module (haunt utils)
31 | #:export (make-asset
32 | asset?
33 | asset-source
34 | asset-target
35 | install-asset
36 | directory-assets))
37 |
38 | ;; Assets are static files that are copied verbatim from a site's
39 | ;; source directory to the target output directory, such as images,
40 | ;; CSS, and JavaScript files. The 'source' and 'target' fields are
41 | ;; file names that are relative to a source and target directory,
42 | ;; respectively.
43 | (define-record-type
44 | (make-asset source target)
45 | asset?
46 | (source asset-source)
47 | (target asset-target))
48 |
49 | (define (install-asset asset prefix)
50 | "Install ASSET source file into destination directory within
51 | PREFIX."
52 | (match asset
53 | (($ source target)
54 | (let ((target* (string-append prefix "/" target)))
55 | (mkdir-p (dirname target*))
56 | (copy-file source target*)))))
57 |
58 | (define (directory-assets directory keep? dest)
59 | "Create a list of asset objects to be stored within DEST for all
60 | files in DIRECTORY that match KEEP?, recursively."
61 | (define enter? (const #t))
62 |
63 | ;; In order to do accurate file name manipulation, every file name
64 | ;; is converted into a list of components, manipulated, then
65 | ;; converted back into a string.
66 | (define leaf
67 | (let ((base-length (length (file-name-components directory)))
68 | (dest* (file-name-components dest)))
69 | (lambda (file-name stat memo)
70 | (if (keep? file-name)
71 | (let* ((file-name* (file-name-components file-name))
72 | (target (join-file-name-components
73 | (append dest* (drop file-name* base-length)))))
74 | (cons (make-asset file-name target) memo))
75 | memo))))
76 |
77 | (define (noop file-name stat memo) memo)
78 |
79 | (define (err file-name stat errno memo)
80 | (error "asset processing failed with errno: " file-name errno))
81 |
82 | (file-system-fold enter? leaf noop noop noop err '() directory))
83 |
--------------------------------------------------------------------------------
/haunt/builder/assets.scm:
--------------------------------------------------------------------------------
1 | ;;; Haunt --- Static site generator for GNU Guile
2 | ;;; Copyright © 2015 David Thompson
3 | ;;;
4 | ;;; This file is part of Haunt.
5 | ;;;
6 | ;;; Haunt is free software; you can redistribute it and/or modify it
7 | ;;; under the terms of the GNU General Public License as published by
8 | ;;; the Free Software Foundation; either version 3 of the License, or
9 | ;;; (at your option) any later version.
10 | ;;;
11 | ;;; Haunt is distributed in the hope that it will be useful, but
12 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
13 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
14 | ;;; General Public License for more details.
15 | ;;;
16 | ;;; You should have received a copy of the GNU General Public License
17 | ;;; along with Haunt. If not, see .
18 |
19 | ;;; Commentary:
20 | ;;
21 | ;; Static asset builder.
22 | ;;
23 | ;;; Code:
24 |
25 | (define-module (haunt builder assets)
26 | #:use-module (srfi srfi-1)
27 | #:use-module (srfi srfi-9)
28 | #:use-module (ice-9 ftw)
29 | #:use-module (ice-9 match)
30 | #:use-module (haunt asset)
31 | #:use-module (haunt site)
32 | #:export (static-directory))
33 |
34 | (define* (static-directory directory #:optional (dest directory))
35 | "Return a builder procedure that recursively copies all of the files
36 | in DIRECTORY, a file names relative to a site's source directory, and
37 | copies them into DEST, a prefix relative to a site's target output
38 | directory. By default, DEST is DIRECTORY."
39 | (lambda (site posts)
40 | (directory-assets directory (site-file-filter site) dest)))
41 |
--------------------------------------------------------------------------------
/haunt/builder/atom.scm:
--------------------------------------------------------------------------------
1 | ;;; Haunt --- Static site generator for GNU Guile
2 | ;;; Copyright © 2015 David Thompson
3 | ;;;
4 | ;;; This file is part of Haunt.
5 | ;;;
6 | ;;; Haunt is free software; you can redistribute it and/or modify it
7 | ;;; under the terms of the GNU General Public License as published by
8 | ;;; the Free Software Foundation; either version 3 of the License, or
9 | ;;; (at your option) any later version.
10 | ;;;
11 | ;;; Haunt is distributed in the hope that it will be useful, but
12 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
13 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
14 | ;;; General Public License for more details.
15 | ;;;
16 | ;;; You should have received a copy of the GNU General Public License
17 | ;;; along with Haunt. If not, see .
18 |
19 | ;;; Commentary:
20 | ;;
21 | ;; Atom feed builder.
22 | ;;
23 | ;;; Code:
24 |
25 | (define-module (haunt builder atom)
26 | #:use-module (srfi srfi-19)
27 | #:use-module (srfi srfi-26)
28 | #:use-module (ice-9 match)
29 | #:use-module (sxml simple)
30 | #:use-module (haunt site)
31 | #:use-module (haunt post)
32 | #:use-module (haunt page)
33 | #:use-module (haunt utils)
34 | #:use-module (haunt html)
35 | #:export (atom-feed
36 | atom-feeds-by-tag))
37 |
38 | (define (sxml->xml* sxml port)
39 | "Write SXML to PORT, preceded by an tag."
40 | (display "" port)
41 | (sxml->xml sxml port))
42 |
43 | (define (date->string* date)
44 | "Convert date to ISO-8601 formatted string."
45 | (date->string date "~4"))
46 |
47 | (define (post->atom-entry site post)
48 | "Convert POST into an Atom XML node."
49 | `(entry
50 | (title ,(post-ref post 'title))
51 | (author
52 | (name ,(post-ref post 'author))
53 | ,(let ((email (post-ref post 'email)))
54 | (if email `(email ,email) '())))
55 | (updated ,(date->string* (post-date post)))
56 | (link (@ (href ,(string-append "/" (site-post-slug site post) ".html"))
57 | (rel "alternate")))
58 | (summary (@ (type "html"))
59 | ,(sxml->html-string (post-sxml post)))))
60 |
61 | (define* (atom-feed #:key
62 | (file-name "feed.xml")
63 | (subtitle "Recent Posts")
64 | (filter posts/reverse-chronological)
65 | (max-entries 20))
66 | "Return a builder procedure that renders a list of posts as an Atom
67 | feed. All arguments are optional:
68 |
69 | FILE-NAME: The page file name
70 | SUBTITLE: The feed subtitle
71 | FILTER: The procedure called to manipulate the posts list before rendering
72 | MAX-ENTRIES: The maximum number of posts to render in the feed"
73 | (lambda (site posts)
74 | (make-page file-name
75 | `(feed (@ (xmlns "http://www.w3.org/2005/Atom"))
76 | (title ,(site-title site))
77 | (subtitle ,subtitle)
78 | (updated ,(date->string* (current-date)))
79 | (link (@ (href ,(string-append "/" file-name))
80 | (rel "self")))
81 | (link (@ (href ,(site-domain site))))
82 | ,@(map (cut post->atom-entry site <>)
83 | (take-up-to max-entries (filter posts))))
84 | sxml->xml*)))
85 |
86 | (define* (atom-feeds-by-tag #:key
87 | (prefix "feeds/tags")
88 | (filter posts/reverse-chronological)
89 | (max-entries 20))
90 | "Return a builder procedure that renders an atom feed for every tag
91 | used in a post. All arguments are optional:
92 |
93 | PREFIX: The directory in which to write the feeds
94 | FILTER: The procedure called to manipulate the posts list before rendering
95 | MAX-ENTRIES: The maximum number of posts to render in each feed"
96 | (lambda (site posts)
97 | (let ((tag-groups (posts/group-by-tag posts)))
98 | (map (match-lambda
99 | ((tag . posts)
100 | ((atom-feed #:file-name (string-append prefix "/" tag ".xml")
101 | #:subtitle (string-append "Tag: " tag)
102 | #:filter filter
103 | #:max-entries max-entries)
104 | site posts)))
105 | tag-groups))))
106 |
--------------------------------------------------------------------------------
/haunt/builder/blog.scm:
--------------------------------------------------------------------------------
1 | ;;; Haunt --- Static site generator for GNU Guile
2 | ;;; Copyright © 2015 David Thompson
3 | ;;;
4 | ;;; This file is part of Haunt.
5 | ;;;
6 | ;;; Haunt is free software; you can redistribute it and/or modify it
7 | ;;; under the terms of the GNU General Public License as published by
8 | ;;; the Free Software Foundation; either version 3 of the License, or
9 | ;;; (at your option) any later version.
10 | ;;;
11 | ;;; Haunt is distributed in the hope that it will be useful, but
12 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
13 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
14 | ;;; General Public License for more details.
15 | ;;;
16 | ;;; You should have received a copy of the GNU General Public License
17 | ;;; along with Haunt. If not, see .
18 |
19 | ;;; Commentary:
20 | ;;
21 | ;; Page builders
22 | ;;
23 | ;;; Code:
24 |
25 | (define-module (haunt builder blog)
26 | #:use-module (ice-9 match)
27 | #:use-module (srfi srfi-9)
28 | #:use-module (srfi srfi-19)
29 | #:use-module (haunt site)
30 | #:use-module (haunt post)
31 | #:use-module (haunt page)
32 | #:use-module (haunt utils)
33 | #:use-module (haunt html)
34 | #:export (theme
35 | theme?
36 | theme-name
37 | theme-layout
38 | theme-post-template
39 | theme-collection-template
40 | with-layout
41 |
42 | date->string*
43 |
44 | blog))
45 |
46 | (define-record-type
47 | (make-theme name layout post-template collection-template)
48 | theme?
49 | (name theme-name)
50 | (layout theme-layout)
51 | (post-template theme-post-template)
52 | (collection-template theme-collection-template))
53 |
54 | (define* (theme #:key
55 | (name "Untitled")
56 | layout
57 | post-template
58 | collection-template)
59 | (make-theme name layout post-template collection-template))
60 |
61 | (define (with-layout theme site title body)
62 | ((theme-layout theme) site title body))
63 |
64 | (define (render-post theme site post)
65 | (let ((title (post-ref post 'title))
66 | (body ((theme-post-template theme) post)))
67 | (with-layout theme site title body)))
68 |
69 | (define (render-collection theme site title posts prefix)
70 | (let ((body ((theme-collection-template theme) site title posts prefix)))
71 | (with-layout theme site title body)))
72 |
73 | (define (date->string* date)
74 | "Convert DATE to human readable string."
75 | (date->string date "~a ~d ~B ~Y"))
76 |
77 | (define ugly-theme
78 | (theme #:name "Ugly"
79 | #:layout
80 | (lambda (site title body)
81 | `((doctype "html")
82 | (head
83 | (meta (@ (charset "utf-8")))
84 | (title ,(string-append title " — " (site-title site))))
85 | (body
86 | (h1 ,(site-title site))
87 | ,body)))
88 | #:post-template
89 | (lambda (post)
90 | `((h2 ,(post-ref post 'title))
91 | (h3 "by " ,(post-ref post 'author)
92 | " — " ,(date->string* (post-date post)))
93 | (div ,(post-sxml post))))
94 | #:collection-template
95 | (lambda (site title posts prefix)
96 | (define (post-uri post)
97 | (string-append "/" (or prefix "")
98 | (site-post-slug site post) ".html"))
99 |
100 | `((h3 ,title)
101 | (ul
102 | ,@(map (lambda (post)
103 | `(li
104 | (a (@ (href ,(post-uri post)))
105 | ,(post-ref post 'title)
106 | " — "
107 | ,(date->string* (post-date post)))))
108 | posts))))))
109 |
110 | (define* (blog #:key (theme ugly-theme) prefix
111 | (collections
112 | `(("Recent Posts" "index.html" ,posts/reverse-chronological))))
113 | "Return a procedure that transforms a list of posts into pages
114 | decorated by THEME, whose URLs start with PREFIX."
115 | (define (make-file-name base-name)
116 | (if prefix
117 | (string-append prefix "/" base-name)
118 | base-name))
119 |
120 | (lambda (site posts)
121 | (define (post->page post)
122 | (let ((base-name (string-append (site-post-slug site post)
123 | ".html")))
124 | (make-page (make-file-name base-name)
125 | (render-post theme site post)
126 | sxml->html)))
127 |
128 | (define collection->page
129 | (match-lambda
130 | ((title file-name filter)
131 | (make-page (make-file-name file-name)
132 | (render-collection theme site title (filter posts) prefix)
133 | sxml->html))))
134 |
135 | (append (map post->page posts)
136 | (map collection->page collections))))
137 |
--------------------------------------------------------------------------------
/haunt/config.scm.in:
--------------------------------------------------------------------------------
1 | ;;; Haunt --- Static site generator for GNU Guile
2 | ;;; Copyright © 2015 David Thompson
3 | ;;;
4 | ;;; This file is part of Haunt.
5 | ;;;
6 | ;;; Haunt is free software; you can redistribute it and/or modify it
7 | ;;; under the terms of the GNU General Public License as published by
8 | ;;; the Free Software Foundation; either version 3 of the License, or
9 | ;;; (at your option) any later version.
10 | ;;;
11 | ;;; Haunt is distributed in the hope that it will be useful, but
12 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
13 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
14 | ;;; General Public License for more details.
15 | ;;;
16 | ;;; You should have received a copy of the GNU General Public License
17 | ;;; along with Haunt. If not, see .
18 |
19 | ;;; Commentary:
20 | ;;
21 | ;; Haunt configuration.
22 | ;;
23 | ;;; Code:
24 |
25 | (define-module (haunt config)
26 | #:export (%haunt-version))
27 |
28 | (define %haunt-version "@PACKAGE_VERSION@")
29 |
--------------------------------------------------------------------------------
/haunt/html.scm:
--------------------------------------------------------------------------------
1 | ;;; Haunt --- Static site generator for GNU Guile
2 | ;;; Copyright © 2015 David Thompson
3 | ;;;
4 | ;;; This file is part of Haunt.
5 | ;;;
6 | ;;; Haunt is free software; you can redistribute it and/or modify it
7 | ;;; under the terms of the GNU General Public License as published by
8 | ;;; the Free Software Foundation; either version 3 of the License, or
9 | ;;; (at your option) any later version.
10 | ;;;
11 | ;;; Haunt is distributed in the hope that it will be useful, but
12 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
13 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
14 | ;;; General Public License for more details.
15 | ;;;
16 | ;;; You should have received a copy of the GNU General Public License
17 | ;;; along with Haunt. If not, see .
18 |
19 | ;;; Commentary:
20 | ;;
21 | ;; SXML to HTML conversion.
22 | ;;
23 | ;;; Code:
24 |
25 | (define-module (haunt html)
26 | #:use-module (sxml simple)
27 | #:use-module (srfi srfi-26)
28 | #:use-module (ice-9 match)
29 | #:use-module (ice-9 format)
30 | #:use-module (ice-9 hash-table)
31 | #:export (sxml->html
32 | sxml->html-string))
33 |
34 | (define %void-elements
35 | '(area
36 | base
37 | br
38 | col
39 | command
40 | embed
41 | hr
42 | img
43 | input
44 | keygen
45 | link
46 | meta
47 | param
48 | source
49 | track
50 | wbr))
51 |
52 | (define (void-element? tag)
53 | "Return #t if TAG is a void element."
54 | (pair? (memq tag %void-elements)))
55 |
56 | (define %escape-chars
57 | (alist->hash-table
58 | '((#\" . "quot")
59 | (#\& . "amp")
60 | (#\' . "apos")
61 | (#\< . "lt")
62 | (#\> . "gt"))))
63 |
64 | (define (string->escaped-html s port)
65 | "Write the HTML escaped form of S to PORT."
66 | (define (escape c)
67 | (let ((escaped (hash-ref %escape-chars c)))
68 | (if escaped
69 | (format port "&~a;" escaped)
70 | (display c port))))
71 | (string-for-each escape s))
72 |
73 | (define (object->escaped-html obj port)
74 | "Write the HTML escaped form of OBJ to PORT."
75 | (string->escaped-html
76 | (call-with-output-string (cut display obj <>))
77 | port))
78 |
79 | (define (attribute-value->html value port)
80 | "Write the HTML escaped form of VALUE to PORT."
81 | (if (string? value)
82 | (string->escaped-html value port)
83 | (object->escaped-html value port)))
84 |
85 | (define (attribute->html attr value port)
86 | "Write ATTR and VALUE to PORT."
87 | (format port "~a=\"" attr)
88 | (attribute-value->html value port)
89 | (display #\" port))
90 |
91 | (define (element->html tag attrs body port)
92 | "Write the HTML TAG to PORT, where TAG has the attributes in the
93 | list ATTRS and the child nodes in BODY."
94 | (format port "<~a" tag)
95 | (for-each (match-lambda
96 | ((attr value)
97 | (display #\space port)
98 | (attribute->html attr value port)))
99 | attrs)
100 | (if (and (null? body) (void-element? tag))
101 | (display " />" port)
102 | (begin
103 | (display #\> port)
104 | (for-each (cut sxml->html <> port) body)
105 | (format port "" tag))))
106 |
107 | (define (doctype->html doctype port)
108 | (format port "" doctype))
109 |
110 | (define* (sxml->html tree #:optional (port (current-output-port)))
111 | "Write the serialized HTML form of TREE to PORT."
112 | (match tree
113 | (() *unspecified*)
114 | (('doctype type)
115 | (doctype->html type port))
116 | ;; Unescaped, raw HTML output.
117 | (('raw html)
118 | (display html port))
119 | (((? symbol? tag) ('@ attrs ...) body ...)
120 | (element->html tag attrs body port))
121 | (((? symbol? tag) body ...)
122 | (element->html tag '() body port))
123 | ((nodes ...)
124 | (for-each (cut sxml->html <> port) nodes))
125 | ((? string? text)
126 | (string->escaped-html text port))
127 | ;; Render arbitrary Scheme objects, too.
128 | (obj (object->escaped-html obj port))))
129 |
130 | (define (sxml->html-string sxml)
131 | "Render SXML as an HTML string."
132 | (call-with-output-string
133 | (lambda (port)
134 | (sxml->html sxml port))))
135 |
--------------------------------------------------------------------------------
/haunt/page.scm:
--------------------------------------------------------------------------------
1 | ;;; Haunt --- Static site generator for GNU Guile
2 | ;;; Copyright © 2015 David Thompson
3 | ;;;
4 | ;;; This file is part of Haunt.
5 | ;;;
6 | ;;; Haunt is free software; you can redistribute it and/or modify it
7 | ;;; under the terms of the GNU General Public License as published by
8 | ;;; the Free Software Foundation; either version 3 of the License, or
9 | ;;; (at your option) any later version.
10 | ;;;
11 | ;;; Haunt is distributed in the hope that it will be useful, but
12 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
13 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
14 | ;;; General Public License for more details.
15 | ;;;
16 | ;;; You should have received a copy of the GNU General Public License
17 | ;;; along with Haunt. If not, see .
18 |
19 | ;;; Commentary:
20 | ;;
21 | ;; Page data type.
22 | ;;
23 | ;;; Code:
24 |
25 | (define-module (haunt page)
26 | #:use-module (ice-9 match)
27 | #:use-module (srfi srfi-9)
28 | #:use-module (srfi srfi-26)
29 | #:use-module (haunt utils)
30 | #:export (make-page
31 | page?
32 | page-file-name
33 | page-contents
34 | page-writer
35 | write-page))
36 |
37 | (define-record-type
38 | (make-page file-name contents writer)
39 | page?
40 | (file-name page-file-name)
41 | (contents page-contents)
42 | (writer page-writer))
43 |
44 | (define (write-page page output-directory)
45 | "Write PAGE to OUTPUT-DIRECTORY."
46 | (match page
47 | (($ file-name contents writer)
48 | (let ((output (string-append output-directory "/" file-name)))
49 | (mkdir-p (dirname output))
50 | (call-with-output-file output (cut writer contents <>))))))
51 |
--------------------------------------------------------------------------------
/haunt/post.scm:
--------------------------------------------------------------------------------
1 | ;;; Haunt --- Static site generator for GNU Guile
2 | ;;; Copyright © 2015 David Thompson
3 | ;;;
4 | ;;; This file is part of Haunt.
5 | ;;;
6 | ;;; Haunt is free software; you can redistribute it and/or modify it
7 | ;;; under the terms of the GNU General Public License as published by
8 | ;;; the Free Software Foundation; either version 3 of the License, or
9 | ;;; (at your option) any later version.
10 | ;;;
11 | ;;; Haunt is distributed in the hope that it will be useful, but
12 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
13 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
14 | ;;; General Public License for more details.
15 | ;;;
16 | ;;; You should have received a copy of the GNU General Public License
17 | ;;; along with Haunt. If not, see .
18 |
19 | ;;; Commentary:
20 | ;;
21 | ;; Post data type.
22 | ;;
23 | ;;; Code:
24 |
25 | (define-module (haunt post)
26 | #:use-module (srfi srfi-1)
27 | #:use-module (srfi srfi-9)
28 | #:use-module (srfi srfi-19)
29 | #:use-module (haunt utils)
30 | #:export (make-post
31 | post?
32 | post-file-name
33 | post-sxml
34 | post-metadata
35 | post-ref
36 | post-slug
37 | %default-date
38 | post-date
39 | posts/reverse-chronological
40 | posts/group-by-tag
41 |
42 | register-metdata-parser!
43 | parse-metadata))
44 |
45 | (define-record-type
46 | (make-post file-name metadata sxml)
47 | post?
48 | (file-name post-file-name)
49 | (metadata post-metadata)
50 | (sxml post-sxml))
51 |
52 | (define (post-ref post key)
53 | "Return the metadata corresponding to KEY within POST."
54 | (assq-ref (post-metadata post) key))
55 |
56 | (define (post-slug post)
57 | "Transform the title of POST into a URL slug."
58 | (string-join (map (lambda (s)
59 | (string-filter char-set:letter+digit s))
60 | (string-split (string-downcase (post-ref post 'title))
61 | char-set:whitespace))
62 | "-"))
63 |
64 | (define %default-date
65 | (make-date 0 0 0 0 1 1 1970 0)) ; UNIX epoch
66 |
67 | (define (post-date post)
68 | "Return the date for POST, or '%default-date' if no date is
69 | specified."
70 | (or (post-ref post 'date) %default-date))
71 |
72 | (define (post-time post)
73 | (date->time-utc (post-ref post 'date)))
74 |
75 | (define (posts/reverse-chronological posts)
76 | "Returns POSTS sorted in reverse chronological order."
77 | (sort posts
78 | (lambda (a b)
79 | (time>? (post-time a) (post-time b)))))
80 |
81 | (define (posts/group-by-tag posts)
82 | "Return an alist of tags mapped to the posts that used them."
83 | (let ((table (make-hash-table)))
84 | (for-each (lambda (post)
85 | (for-each (lambda (tag)
86 | (let ((current (hash-ref table tag)))
87 | (if current
88 | (hash-set! table tag (cons post current))
89 | (hash-set! table tag (list post)))))
90 | (or (post-ref post 'tags) '())))
91 | posts)
92 | (hash-fold alist-cons '() table)))
93 |
94 | ;;;
95 | ;;; Metadata
96 | ;;;
97 |
98 | (define %metadata-parsers
99 | (make-hash-table))
100 |
101 | (define (metadata-parser key)
102 | (or (hash-ref %metadata-parsers key) identity))
103 |
104 | (define (register-metadata-parser! name parser)
105 | (hash-set! %metadata-parsers name parser))
106 |
107 | (define (parse-metadata key value)
108 | ((metadata-parser key) value))
109 |
110 | (register-metadata-parser!
111 | 'tags
112 | (lambda (str)
113 | (map string-trim-both (string-split str #\,))))
114 |
115 | (register-metadata-parser! 'date string->date*)
116 |
--------------------------------------------------------------------------------
/haunt/reader.scm:
--------------------------------------------------------------------------------
1 | ;;; Haunt --- Static site generator for GNU Guile
2 | ;;; Copyright © 2015 David Thompson
3 | ;;;
4 | ;;; This file is part of Haunt.
5 | ;;;
6 | ;;; Haunt is free software; you can redistribute it and/or modify it
7 | ;;; under the terms of the GNU General Public License as published by
8 | ;;; the Free Software Foundation; either version 3 of the License, or
9 | ;;; (at your option) any later version.
10 | ;;;
11 | ;;; Haunt is distributed in the hope that it will be useful, but
12 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
13 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
14 | ;;; General Public License for more details.
15 | ;;;
16 | ;;; You should have received a copy of the GNU General Public License
17 | ;;; along with Haunt. If not, see .
18 |
19 | ;;; Commentary:
20 | ;;
21 | ;; Post readers.
22 | ;;
23 | ;;; Code:
24 |
25 | (define-module (haunt reader)
26 | #:use-module (srfi srfi-1)
27 | #:use-module (srfi srfi-9)
28 | #:use-module (srfi srfi-11)
29 | #:use-module (srfi srfi-26)
30 | #:use-module (ice-9 ftw)
31 | #:use-module (ice-9 match)
32 | #:use-module (ice-9 regex)
33 | #:use-module (ice-9 rdelim)
34 | #:use-module (haunt post)
35 | #:use-module (haunt utils)
36 | #:export (make-reader
37 | reader?
38 | reader-matcher
39 | reader-proc
40 | reader-match?
41 | read-post
42 | read-posts
43 |
44 | make-file-extension-matcher
45 | sxml-reader
46 | html-reader))
47 |
48 | (define-record-type
49 | (make-reader matcher proc)
50 | reader?
51 | (matcher reader-matcher)
52 | (proc reader-proc))
53 |
54 | (define (reader-match? reader file-name)
55 | "Return #t if FILE-NAME is a file supported by READER."
56 | ((reader-matcher reader) file-name))
57 |
58 | (define* (read-post reader file-name #:optional (default-metadata '()))
59 | "Read a post object from FILE-NAME using READER, merging its
60 | metadata with DEFAULT-METADATA."
61 | (let-values (((metadata sxml) ((reader-proc reader) file-name)))
62 | (make-post file-name
63 | (append metadata default-metadata)
64 | sxml)))
65 |
66 | (define* (read-posts directory keep? readers #:optional (default-metadata '()))
67 | "Read all of the files in DIRECTORY that match KEEP? as post
68 | objects. The READERS list must contain a matching reader for every
69 | post."
70 | (define enter? (const #t))
71 |
72 | (define (leaf file-name stat memo)
73 | (if (keep? file-name)
74 | (let ((reader (find (cut reader-match? <> file-name) readers)))
75 | (if reader
76 | (cons (read-post reader file-name default-metadata) memo)
77 | (error "no reader available for post: " file-name)))
78 | memo))
79 |
80 | (define (noop file-name stat result)
81 | result)
82 |
83 | (define (err file-name stat errno result)
84 | (error "file processing failed with errno: " file-name errno))
85 |
86 | (file-system-fold enter? leaf noop noop noop err '() directory))
87 |
88 | ;;;
89 | ;;; Simple readers
90 | ;;;
91 |
92 | (define (make-file-extension-matcher ext)
93 | "Return a procedure that returns #t when a file name ends with
94 | '.EXT'."
95 | (let ((regexp (make-regexp (string-append "\\." ext "$"))))
96 | (lambda (file-name)
97 | (regexp-match? (regexp-exec regexp file-name)))))
98 |
99 | (define sxml-reader
100 | (make-reader (make-file-extension-matcher "sxml")
101 | (lambda (file-name)
102 | (let ((contents (load (absolute-file-name file-name))))
103 | (values (alist-delete 'content contents eq?)
104 | (assq-ref contents 'content))))))
105 |
106 | (define (read-html-post port)
107 | (let loop ((metadata '()))
108 | (let ((line (read-line port)))
109 | (cond
110 | ((eof-object? line)
111 | (error "end of file while reading metadata: " (port-filename port)))
112 | ((string=? line "---")
113 | (values metadata `(raw ,(read-string port))))
114 | (else
115 | (match (map string-trim-both (string-split-at line #\:))
116 | (((= string->symbol key) value)
117 | (loop (alist-cons key (parse-metadata key value) metadata)))
118 | (_ (error "invalid metadata format: " line))))))))
119 |
120 | (define html-reader
121 | (make-reader (make-file-extension-matcher "html")
122 | (cut call-with-input-file <> read-html-post)))
123 |
--------------------------------------------------------------------------------
/haunt/serve/mime-types.scm:
--------------------------------------------------------------------------------
1 | ;;; Haunt --- Static site generator for GNU Guile
2 | ;;; Copyright © 2015 David Thompson
3 | ;;;
4 | ;;; This file is part of Haunt.
5 | ;;;
6 | ;;; Haunt is free software; you can redistribute it and/or modify it
7 | ;;; under the terms of the GNU General Public License as published by
8 | ;;; the Free Software Foundation; either version 3 of the License, or
9 | ;;; (at your option) any later version.
10 | ;;;
11 | ;;; Haunt is distributed in the hope that it will be useful, but
12 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
13 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
14 | ;;; General Public License for more details.
15 | ;;;
16 | ;;; You should have received a copy of the GNU General Public License
17 | ;;; along with Haunt. If not, see .
18 |
19 | ;;; Commentary:
20 | ;;
21 | ;; Simple MIME type guesser.
22 | ;;
23 | ;;; Code:
24 |
25 | (define-module (haunt serve mime-types)
26 | #:use-module (ice-9 hash-table)
27 | #:use-module (ice-9 regex)
28 | #:export (mime-type))
29 |
30 | (define %mime-types
31 | (alist->hash-table
32 | '(("ez" . application/andrew-inset)
33 | ("anx" . application/annodex)
34 | ("atom" . application/atom+xml)
35 | ("atomcat" . application/atomcat+xml)
36 | ("atomsrv" . application/atomserv+xml)
37 | ("lin" . application/bbolin)
38 | ("cap" . application/cap)
39 | ("pcap" . application/cap)
40 | ("cu" . application/cu-seeme)
41 | ("davmount" . application/davmount+xml)
42 | ("tsp" . application/dsptype)
43 | ("es" . application/ecmascript)
44 | ("spl" . application/futuresplash)
45 | ("hta" . application/hta)
46 | ("jar" . application/java-archive)
47 | ("ser" . application/java-serialized-object)
48 | ("class" . application/java-vm)
49 | ("js" . application/javascript)
50 | ("m3g" . application/m3g)
51 | ("hqx" . application/mac-binhex40)
52 | ("cpt" . application/mac-compactpro)
53 | ("nb" . application/mathematica)
54 | ("nbp" . application/mathematica)
55 | ("mdb" . application/msaccess)
56 | ("doc" . application/msword)
57 | ("dot" . application/msword)
58 | ("mxf" . application/mxf)
59 | ("bin" . application/octet-stream)
60 | ("oda" . application/oda)
61 | ("ogx" . application/ogg)
62 | ("pdf" . application/pdf)
63 | ("key" . application/pgp-keys)
64 | ("pgp" . application/pgp-signature)
65 | ("prf" . application/pics-rules)
66 | ("ps" . application/postscript)
67 | ("ai" . application/postscript)
68 | ("eps" . application/postscript)
69 | ("epsi" . application/postscript)
70 | ("epsf" . application/postscript)
71 | ("eps2" . application/postscript)
72 | ("eps3" . application/postscript)
73 | ("rar" . application/rar)
74 | ("rdf" . application/rdf+xml)
75 | ("rss" . application/rss+xml)
76 | ("rtf" . application/rtf)
77 | ("smi" . application/smil)
78 | ("smil" . application/smil)
79 | ("xhtml" . application/xhtml+xml)
80 | ("xht" . application/xhtml+xml)
81 | ("xml" . application/xml)
82 | ("xsl" . application/xml)
83 | ("xsd" . application/xml)
84 | ("xspf" . application/xspf+xml)
85 | ("zip" . application/zip)
86 | ("apk" . application/vnd.android.package-archive)
87 | ("cdy" . application/vnd.cinderella)
88 | ("kml" . application/vnd.google-earth.kml+xml)
89 | ("kmz" . application/vnd.google-earth.kmz)
90 | ("xul" . application/vnd.mozilla.xul+xml)
91 | ("xls" . application/vnd.ms-excel)
92 | ("xlb" . application/vnd.ms-excel)
93 | ("xlt" . application/vnd.ms-excel)
94 | ("cat" . application/vnd.ms-pki.seccat)
95 | ("stl" . application/vnd.ms-pki.stl)
96 | ("ppt" . application/vnd.ms-powerpoint)
97 | ("pps" . application/vnd.ms-powerpoint)
98 | ("odc" . application/vnd.oasis.opendocument.chart)
99 | ("odb" . application/vnd.oasis.opendocument.database)
100 | ("odf" . application/vnd.oasis.opendocument.formula)
101 | ("odg" . application/vnd.oasis.opendocument.graphics)
102 | ("otg" . application/vnd.oasis.opendocument.graphics-template)
103 | ("odi" . application/vnd.oasis.opendocument.image)
104 | ("odp" . application/vnd.oasis.opendocument.presentation)
105 | ("otp" . application/vnd.oasis.opendocument.presentation-template)
106 | ("ods" . application/vnd.oasis.opendocument.spreadsheet)
107 | ("ots" . application/vnd.oasis.opendocument.spreadsheet-template)
108 | ("odt" . application/vnd.oasis.opendocument.text)
109 | ("odm" . application/vnd.oasis.opendocument.text-master)
110 | ("ott" . application/vnd.oasis.opendocument.text-template)
111 | ("oth" . application/vnd.oasis.opendocument.text-web)
112 | ("xlsx" . application/vnd.openxmlformats-officedocument.spreadsheetml.sheet)
113 | ("xltx" . application/vnd.openxmlformats-officedocument.spreadsheetml.template)
114 | ("pptx" . application/vnd.openxmlformats-officedocument.presentationml.presentation)
115 | ("ppsx" . application/vnd.openxmlformats-officedocument.presentationml.slideshow)
116 | ("potx" . application/vnd.openxmlformats-officedocument.presentationml.template)
117 | ("docx" . application/vnd.openxmlformats-officedocument.wordprocessingml.document)
118 | ("dotx" . application/vnd.openxmlformats-officedocument.wordprocessingml.template)
119 | ("cod" . application/vnd.rim.cod)
120 | ("mmf" . application/vnd.smaf)
121 | ("sdc" . application/vnd.stardivision.calc)
122 | ("sds" . application/vnd.stardivision.chart)
123 | ("sda" . application/vnd.stardivision.draw)
124 | ("sdd" . application/vnd.stardivision.impress)
125 | ("sdf" . application/vnd.stardivision.math)
126 | ("sdw" . application/vnd.stardivision.writer)
127 | ("sgl" . application/vnd.stardivision.writer-global)
128 | ("sxc" . application/vnd.sun.xml.calc)
129 | ("stc" . application/vnd.sun.xml.calc.template)
130 | ("sxd" . application/vnd.sun.xml.draw)
131 | ("std" . application/vnd.sun.xml.draw.template)
132 | ("sxi" . application/vnd.sun.xml.impress)
133 | ("sti" . application/vnd.sun.xml.impress.template)
134 | ("sxm" . application/vnd.sun.xml.math)
135 | ("sxw" . application/vnd.sun.xml.writer)
136 | ("sxg" . application/vnd.sun.xml.writer.global)
137 | ("stw" . application/vnd.sun.xml.writer.template)
138 | ("sis" . application/vnd.symbian.install)
139 | ("vsd" . application/vnd.visio)
140 | ("wbxml" . application/vnd.wap.wbxml)
141 | ("wmlc" . application/vnd.wap.wmlc)
142 | ("wmlsc" . application/vnd.wap.wmlscriptc)
143 | ("wpd" . application/vnd.wordperfect)
144 | ("wp5" . application/vnd.wordperfect5.1)
145 | ("wk" . application/x-123)
146 | ("7z" . application/x-7z-compressed)
147 | ("bz2" . application/x-bzip2)
148 | ("gz" . application/x-gzip)
149 | ("abw" . application/x-abiword)
150 | ("dmg" . application/x-apple-diskimage)
151 | ("bcpio" . application/x-bcpio)
152 | ("torrent" . application/x-bittorrent)
153 | ("cab" . application/x-cab)
154 | ("cbr" . application/x-cbr)
155 | ("cbz" . application/x-cbz)
156 | ("cdf" . application/x-cdf)
157 | ("cda" . application/x-cdf)
158 | ("vcd" . application/x-cdlink)
159 | ("pgn" . application/x-chess-pgn)
160 | ("cpio" . application/x-cpio)
161 | ("csh" . application/x-csh)
162 | ("deb" . application/x-debian-package)
163 | ("udeb" . application/x-debian-package)
164 | ("dcr" . application/x-director)
165 | ("dir" . application/x-director)
166 | ("dxr" . application/x-director)
167 | ("dms" . application/x-dms)
168 | ("wad" . application/x-doom)
169 | ("dvi" . application/x-dvi)
170 | ("rhtml" . application/x-httpd-eruby)
171 | ("pfa" . application/x-font)
172 | ("pfb" . application/x-font)
173 | ("gsf" . application/x-font)
174 | ("pcf" . application/x-font)
175 | ("pcf.Z" . application/x-font)
176 | ("mm" . application/x-freemind)
177 | ("spl" . application/x-futuresplash)
178 | ("gnumeric" . application/x-gnumeric)
179 | ("sgf" . application/x-go-sgf)
180 | ("gcf" . application/x-graphing-calculator)
181 | ("gtar" . application/x-gtar)
182 | ("tgz" . application/x-gtar)
183 | ("taz" . application/x-gtar)
184 | ("tar.gz" . application/x-gtar)
185 | ("tar.bz2" . application/x-gtar)
186 | ("tbz2" . application/x-gtar)
187 | ("hdf" . application/x-hdf)
188 | ("phtml" . application/x-httpd-php)
189 | ("pht" . application/x-httpd-php)
190 | ("php" . application/x-httpd-php)
191 | ("phps" . application/x-httpd-php-source)
192 | ("php3" . application/x-httpd-php3)
193 | ("php3p" . application/x-httpd-php3-preprocessed)
194 | ("php4" . application/x-httpd-php4)
195 | ("php5" . application/x-httpd-php5)
196 | ("ica" . application/x-ica)
197 | ("info" . application/x-info)
198 | ("ins" . application/x-internet-signup)
199 | ("isp" . application/x-internet-signup)
200 | ("iii" . application/x-iphone)
201 | ("iso" . application/x-iso9660-image)
202 | ("jam" . application/x-jam)
203 | ("jnlp" . application/x-java-jnlp-file)
204 | ("jmz" . application/x-jmol)
205 | ("chrt" . application/x-kchart)
206 | ("kil" . application/x-killustrator)
207 | ("skp" . application/x-koan)
208 | ("skd" . application/x-koan)
209 | ("skt" . application/x-koan)
210 | ("skm" . application/x-koan)
211 | ("kpr" . application/x-kpresenter)
212 | ("kpt" . application/x-kpresenter)
213 | ("ksp" . application/x-kspread)
214 | ("kwd" . application/x-kword)
215 | ("kwt" . application/x-kword)
216 | ("latex" . application/x-latex)
217 | ("lha" . application/x-lha)
218 | ("lyx" . application/x-lyx)
219 | ("lzh" . application/x-lzh)
220 | ("lzx" . application/x-lzx)
221 | ("frm" . application/x-maker)
222 | ("maker" . application/x-maker)
223 | ("frame" . application/x-maker)
224 | ("fm" . application/x-maker)
225 | ("fb" . application/x-maker)
226 | ("book" . application/x-maker)
227 | ("fbdoc" . application/x-maker)
228 | ("mif" . application/x-mif)
229 | ("wmd" . application/x-ms-wmd)
230 | ("wmz" . application/x-ms-wmz)
231 | ("com" . application/x-msdos-program)
232 | ("exe" . application/x-msdos-program)
233 | ("bat" . application/x-msdos-program)
234 | ("dll" . application/x-msdos-program)
235 | ("msi" . application/x-msi)
236 | ("nc" . application/x-netcdf)
237 | ("pac" . application/x-ns-proxy-autoconfig)
238 | ("dat" . application/x-ns-proxy-autoconfig)
239 | ("nwc" . application/x-nwc)
240 | ("o" . application/x-object)
241 | ("oza" . application/x-oz-application)
242 | ("p7r" . application/x-pkcs7-certreqresp)
243 | ("crl" . application/x-pkcs7-crl)
244 | ("pyc" . application/x-python-code)
245 | ("pyo" . application/x-python-code)
246 | ("qgs" . application/x-qgis)
247 | ("shp" . application/x-qgis)
248 | ("shx" . application/x-qgis)
249 | ("qtl" . application/x-quicktimeplayer)
250 | ("rpm" . application/x-redhat-package-manager)
251 | ("rb" . application/x-ruby)
252 | ("sh" . application/x-sh)
253 | ("shar" . application/x-shar)
254 | ("swf" . application/x-shockwave-flash)
255 | ("swfl" . application/x-shockwave-flash)
256 | ("scr" . application/x-silverlight)
257 | ("sit" . application/x-stuffit)
258 | ("sitx" . application/x-stuffit)
259 | ("sv4cpio" . application/x-sv4cpio)
260 | ("sv4crc" . application/x-sv4crc)
261 | ("tar" . application/x-tar)
262 | ("tcl" . application/x-tcl)
263 | ("gf" . application/x-tex-gf)
264 | ("pk" . application/x-tex-pk)
265 | ("texinfo" . application/x-texinfo)
266 | ("texi" . application/x-texinfo)
267 | ("~" . application/x-trash)
268 | ("%" . application/x-trash)
269 | ("bak" . application/x-trash)
270 | ("old" . application/x-trash)
271 | ("sik" . application/x-trash)
272 | ("t" . application/x-troff)
273 | ("tr" . application/x-troff)
274 | ("roff" . application/x-troff)
275 | ("man" . application/x-troff-man)
276 | ("me" . application/x-troff-me)
277 | ("ms" . application/x-troff-ms)
278 | ("ustar" . application/x-ustar)
279 | ("src" . application/x-wais-source)
280 | ("wz" . application/x-wingz)
281 | ("crt" . application/x-x509-ca-cert)
282 | ("xcf" . application/x-xcf)
283 | ("fig" . application/x-xfig)
284 | ("xpi" . application/x-xpinstall)
285 | ("amr" . audio/amr)
286 | ("awb" . audio/amr-wb)
287 | ("amr" . audio/amr)
288 | ("awb" . audio/amr-wb)
289 | ("axa" . audio/annodex)
290 | ("au" . audio/basic)
291 | ("snd" . audio/basic)
292 | ("flac" . audio/flac)
293 | ("mid" . audio/midi)
294 | ("midi" . audio/midi)
295 | ("kar" . audio/midi)
296 | ("mpga" . audio/mpeg)
297 | ("mpega" . audio/mpeg)
298 | ("mp2" . audio/mpeg)
299 | ("mp3" . audio/mpeg)
300 | ("m4a" . audio/mpeg)
301 | ("m3u" . audio/mpegurl)
302 | ("oga" . audio/ogg)
303 | ("ogg" . audio/ogg)
304 | ("spx" . audio/ogg)
305 | ("sid" . audio/prs.sid)
306 | ("aif" . audio/x-aiff)
307 | ("aiff" . audio/x-aiff)
308 | ("aifc" . audio/x-aiff)
309 | ("gsm" . audio/x-gsm)
310 | ("m3u" . audio/x-mpegurl)
311 | ("wma" . audio/x-ms-wma)
312 | ("wax" . audio/x-ms-wax)
313 | ("ra" . audio/x-pn-realaudio)
314 | ("rm" . audio/x-pn-realaudio)
315 | ("ram" . audio/x-pn-realaudio)
316 | ("ra" . audio/x-realaudio)
317 | ("pls" . audio/x-scpls)
318 | ("sd2" . audio/x-sd2)
319 | ("wav" . audio/x-wav)
320 | ("alc" . chemical/x-alchemy)
321 | ("cac" . chemical/x-cache)
322 | ("cache" . chemical/x-cache)
323 | ("csf" . chemical/x-cache-csf)
324 | ("cbin" . chemical/x-cactvs-binary)
325 | ("cascii" . chemical/x-cactvs-binary)
326 | ("ctab" . chemical/x-cactvs-binary)
327 | ("cdx" . chemical/x-cdx)
328 | ("cer" . chemical/x-cerius)
329 | ("c3d" . chemical/x-chem3d)
330 | ("chm" . chemical/x-chemdraw)
331 | ("cif" . chemical/x-cif)
332 | ("cmdf" . chemical/x-cmdf)
333 | ("cml" . chemical/x-cml)
334 | ("cpa" . chemical/x-compass)
335 | ("bsd" . chemical/x-crossfire)
336 | ("csml" . chemical/x-csml)
337 | ("csm" . chemical/x-csml)
338 | ("ctx" . chemical/x-ctx)
339 | ("cxf" . chemical/x-cxf)
340 | ("cef" . chemical/x-cxf)
341 | ("emb" . chemical/x-embl-dl-nucleotide)
342 | ("embl" . chemical/x-embl-dl-nucleotide)
343 | ("spc" . chemical/x-galactic-spc)
344 | ("inp" . chemical/x-gamess-input)
345 | ("gam" . chemical/x-gamess-input)
346 | ("gamin" . chemical/x-gamess-input)
347 | ("fch" . chemical/x-gaussian-checkpoint)
348 | ("fchk" . chemical/x-gaussian-checkpoint)
349 | ("cub" . chemical/x-gaussian-cube)
350 | ("gau" . chemical/x-gaussian-input)
351 | ("gjc" . chemical/x-gaussian-input)
352 | ("gjf" . chemical/x-gaussian-input)
353 | ("gal" . chemical/x-gaussian-log)
354 | ("gcg" . chemical/x-gcg8-sequence)
355 | ("gen" . chemical/x-genbank)
356 | ("hin" . chemical/x-hin)
357 | ("istr" . chemical/x-isostar)
358 | ("ist" . chemical/x-isostar)
359 | ("jdx" . chemical/x-jcamp-dx)
360 | ("dx" . chemical/x-jcamp-dx)
361 | ("kin" . chemical/x-kinemage)
362 | ("mcm" . chemical/x-macmolecule)
363 | ("mmd" . chemical/x-macromodel-input)
364 | ("mmod" . chemical/x-macromodel-input)
365 | ("mol" . chemical/x-mdl-molfile)
366 | ("rd" . chemical/x-mdl-rdfile)
367 | ("rxn" . chemical/x-mdl-rxnfile)
368 | ("sd" . chemical/x-mdl-sdfile)
369 | ("sdf" . chemical/x-mdl-sdfile)
370 | ("tgf" . chemical/x-mdl-tgf)
371 | ("mcif" . chemical/x-mmcif)
372 | ("mol2" . chemical/x-mol2)
373 | ("b" . chemical/x-molconn-Z)
374 | ("gpt" . chemical/x-mopac-graph)
375 | ("mop" . chemical/x-mopac-input)
376 | ("mopcrt" . chemical/x-mopac-input)
377 | ("mpc" . chemical/x-mopac-input)
378 | ("zmt" . chemical/x-mopac-input)
379 | ("moo" . chemical/x-mopac-out)
380 | ("mvb" . chemical/x-mopac-vib)
381 | ("asn" . chemical/x-ncbi-asn1)
382 | ("prt" . chemical/x-ncbi-asn1-ascii)
383 | ("ent" . chemical/x-ncbi-asn1-ascii)
384 | ("val" . chemical/x-ncbi-asn1-binary)
385 | ("aso" . chemical/x-ncbi-asn1-binary)
386 | ("asn" . chemical/x-ncbi-asn1-spec)
387 | ("pdb" . chemical/x-pdb)
388 | ("ent" . chemical/x-pdb)
389 | ("ros" . chemical/x-rosdal)
390 | ("sw" . chemical/x-swissprot)
391 | ("vms" . chemical/x-vamas-iso14976)
392 | ("vmd" . chemical/x-vmd)
393 | ("xtel" . chemical/x-xtel)
394 | ("xyz" . chemical/x-xyz)
395 | ("gif" . image/gif)
396 | ("ief" . image/ief)
397 | ("jpeg" . image/jpeg)
398 | ("jpg" . image/jpeg)
399 | ("jpe" . image/jpeg)
400 | ("pcx" . image/pcx)
401 | ("png" . image/png)
402 | ("svg" . image/svg+xml)
403 | ("svgz" . image/svg+xml)
404 | ("tiff" . image/tiff)
405 | ("tif" . image/tiff)
406 | ("djvu" . image/vnd.djvu)
407 | ("djv" . image/vnd.djvu)
408 | ("wbmp" . image/vnd.wap.wbmp)
409 | ("cr2" . image/x-canon-cr2)
410 | ("crw" . image/x-canon-crw)
411 | ("ras" . image/x-cmu-raster)
412 | ("cdr" . image/x-coreldraw)
413 | ("pat" . image/x-coreldrawpattern)
414 | ("cdt" . image/x-coreldrawtemplate)
415 | ("cpt" . image/x-corelphotopaint)
416 | ("erf" . image/x-epson-erf)
417 | ("ico" . image/x-icon)
418 | ("art" . image/x-jg)
419 | ("jng" . image/x-jng)
420 | ("bmp" . image/x-ms-bmp)
421 | ("nef" . image/x-nikon-nef)
422 | ("orf" . image/x-olympus-orf)
423 | ("psd" . image/x-photoshop)
424 | ("pnm" . image/x-portable-anymap)
425 | ("pbm" . image/x-portable-bitmap)
426 | ("pgm" . image/x-portable-graymap)
427 | ("ppm" . image/x-portable-pixmap)
428 | ("rgb" . image/x-rgb)
429 | ("xbm" . image/x-xbitmap)
430 | ("xpm" . image/x-xpixmap)
431 | ("xwd" . image/x-xwindowdump)
432 | ("eml" . message/rfc822)
433 | ("igs" . model/iges)
434 | ("iges" . model/iges)
435 | ("msh" . model/mesh)
436 | ("mesh" . model/mesh)
437 | ("silo" . model/mesh)
438 | ("wrl" . model/vrml)
439 | ("vrml" . model/vrml)
440 | ("x3dv" . model/x3d+vrml)
441 | ("x3d" . model/x3d+xml)
442 | ("x3db" . model/x3d+binary)
443 | ("manifest" . text/cache-manifest)
444 | ("ics" . text/calendar)
445 | ("icz" . text/calendar)
446 | ("css" . text/css)
447 | ("csv" . text/csv)
448 | ("323" . text/h323)
449 | ("html" . text/html)
450 | ("htm" . text/html)
451 | ("shtml" . text/html)
452 | ("uls" . text/iuls)
453 | ("mml" . text/mathml)
454 | ("asc" . text/plain)
455 | ("txt" . text/plain)
456 | ("text" . text/plain)
457 | ("pot" . text/plain)
458 | ("brf" . text/plain)
459 | ("rtx" . text/richtext)
460 | ("sct" . text/scriptlet)
461 | ("wsc" . text/scriptlet)
462 | ("tm" . text/texmacs)
463 | ("ts" . text/texmacs)
464 | ("tsv" . text/tab-separated-values)
465 | ("jad" . text/vnd.sun.j2me.app-descriptor)
466 | ("wml" . text/vnd.wap.wml)
467 | ("wmls" . text/vnd.wap.wmlscript)
468 | ("bib" . text/x-bibtex)
469 | ("boo" . text/x-boo)
470 | ("h++" . text/x-c++hdr)
471 | ("hpp" . text/x-c++hdr)
472 | ("hxx" . text/x-c++hdr)
473 | ("hh" . text/x-c++hdr)
474 | ("c++" . text/x-c++src)
475 | ("cpp" . text/x-c++src)
476 | ("cxx" . text/x-c++src)
477 | ("cc" . text/x-c++src)
478 | ("h" . text/x-chdr)
479 | ("htc" . text/x-component)
480 | ("csh" . text/x-csh)
481 | ("c" . text/x-csrc)
482 | ("d" . text/x-dsrc)
483 | ("diff" . text/x-diff)
484 | ("patch" . text/x-diff)
485 | ("hs" . text/x-haskell)
486 | ("java" . text/x-java)
487 | ("lhs" . text/x-literate-haskell)
488 | ("moc" . text/x-moc)
489 | ("p" . text/x-pascal)
490 | ("pas" . text/x-pascal)
491 | ("gcd" . text/x-pcs-gcd)
492 | ("pl" . text/x-perl)
493 | ("pm" . text/x-perl)
494 | ("py" . text/x-python)
495 | ("scala" . text/x-scala)
496 | ("etx" . text/x-setext)
497 | ("sh" . text/x-sh)
498 | ("tcl" . text/x-tcl)
499 | ("tk" . text/x-tcl)
500 | ("tex" . text/x-tex)
501 | ("ltx" . text/x-tex)
502 | ("sty" . text/x-tex)
503 | ("cls" . text/x-tex)
504 | ("vcs" . text/x-vcalendar)
505 | ("vcf" . text/x-vcard)
506 | ("json" . text/javascript)
507 | ("3gp" . video/3gpp)
508 | ("axv" . video/annodex)
509 | ("dl" . video/dl)
510 | ("dif" . video/dv)
511 | ("dv" . video/dv)
512 | ("fli" . video/fli)
513 | ("gl" . video/gl)
514 | ("mpeg" . video/mpeg)
515 | ("mpg" . video/mpeg)
516 | ("mpe" . video/mpeg)
517 | ("mp4" . video/mp4)
518 | ("qt" . video/quicktime)
519 | ("mov" . video/quicktime)
520 | ("ogv" . video/ogg)
521 | ("mxu" . video/vnd.mpegurl)
522 | ("flv" . video/x-flv)
523 | ("lsf" . video/x-la-asf)
524 | ("lsx" . video/x-la-asf)
525 | ("mng" . video/x-mng)
526 | ("asf" . video/x-ms-asf)
527 | ("asx" . video/x-ms-asf)
528 | ("wm" . video/x-ms-wm)
529 | ("wmv" . video/x-ms-wmv)
530 | ("wmx" . video/x-ms-wmx)
531 | ("wvx" . video/x-ms-wvx)
532 | ("avi" . video/x-msvideo)
533 | ("movie" . video/x-sgi-movie)
534 | ("mpv" . video/x-matroska)
535 | ("mkv" . video/x-matroska)
536 | ("ice" . x-conference/x-cooltalk)
537 | ("sisx" . x-epoc/x-sisx-app)
538 | ("vrm" . x-world/x-vrml)
539 | ("vrml" . x-world/x-vrml)
540 | ("wrl" . x-world/x-vrml))))
541 |
542 | (define %file-ext-regexp
543 | (make-regexp "(\\.(.*)|[~%])$"))
544 |
545 | (define (file-extension file-name)
546 | "Return the file extension for FILE-NAME, or #f if one is not
547 | found."
548 | (and=> (regexp-exec %file-ext-regexp file-name)
549 | (lambda (match)
550 | (or (match:substring match 2)
551 | (match:substring match 1)))))
552 |
553 | (define (mime-type file-name)
554 | "Guess the MIME type for FILE-NAME based upon its file extension."
555 | (or (hash-ref %mime-types (file-extension file-name))
556 | 'text/plain))
557 |
--------------------------------------------------------------------------------
/haunt/serve/web-server.scm:
--------------------------------------------------------------------------------
1 | ;;; Haunt --- Static site generator for GNU Guile
2 | ;;; Copyright © 2015 David Thompson
3 | ;;;
4 | ;;; This file is part of Haunt.
5 | ;;;
6 | ;;; Haunt is free software; you can redistribute it and/or modify it
7 | ;;; under the terms of the GNU General Public License as published by
8 | ;;; the Free Software Foundation; either version 3 of the License, or
9 | ;;; (at your option) any later version.
10 | ;;;
11 | ;;; Haunt is distributed in the hope that it will be useful, but
12 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
13 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
14 | ;;; General Public License for more details.
15 | ;;;
16 | ;;; You should have received a copy of the GNU General Public License
17 | ;;; along with Haunt. If not, see .
18 |
19 | ;;; Commentary:
20 | ;;
21 | ;; Simple HTTP server.
22 | ;;
23 | ;;; Code:
24 |
25 | (define-module (haunt serve web-server)
26 | #:use-module (ice-9 format)
27 | #:use-module (ice-9 ftw)
28 | #:use-module (ice-9 match)
29 | #:use-module (ice-9 popen)
30 | #:use-module (ice-9 rdelim)
31 | #:use-module (ice-9 binary-ports)
32 | #:use-module (srfi srfi-1)
33 | #:use-module (srfi srfi-26)
34 | #:use-module (sxml simple)
35 | #:use-module (web server)
36 | #:use-module (web request)
37 | #:use-module (web response)
38 | #:use-module (web uri)
39 | #:use-module (haunt utils)
40 | #:use-module (haunt serve mime-types)
41 | #:export (serve))
42 |
43 | (define (stat:directory? stat)
44 | "Return #t if STAT is a directory."
45 | (eq? (stat:type stat) 'directory))
46 |
47 | (define (directory? file-name)
48 | "Return #t if FILE-NAME is a directory."
49 | (stat:directory? (stat file-name)))
50 |
51 | (define (directory-contents dir)
52 | "Return a list of the files contained within DIR."
53 | (define name+directory?
54 | (match-lambda
55 | ((name stat)
56 | (list name (stat:directory? stat)))))
57 |
58 | (define (same-dir? other stat)
59 | (string=? dir other))
60 |
61 | (match (file-system-tree dir same-dir?)
62 | ;; We are not interested in the parent directory, only the
63 | ;; children.
64 | ((_ _ children ...)
65 | (map name+directory? children))))
66 |
67 | (define (work-dir+path->file-name work-dir path)
68 | "Convert the URI PATH to an absolute file name relative to the
69 | directory WORK-DIR."
70 | (string-append work-dir path))
71 |
72 | (define (request-path-components request)
73 | "Split the URI path of REQUEST into a list of component strings. For
74 | example: \"/foo/bar\" yields '(\"foo\" \"bar\")."
75 | (split-and-decode-uri-path (uri-path (request-uri request))))
76 |
77 | (define (request-file-name request)
78 | "Return the relative file name corresponding to the REQUEST URI."
79 | (let ((components (request-path-components request)))
80 | (if (null? components)
81 | "/"
82 | (string-join components "/" 'prefix))))
83 |
84 | (define (resolve-file-name file-name)
85 | "If FILE-NAME is a directory with an 'index.html' file,
86 | return that file name. If FILE-NAME does not exist, return #f.
87 | Otherwise, return FILE-NAME as-is."
88 | (let ((index-file-name (string-append file-name "/index.html")))
89 | (cond
90 | ((file-exists? index-file-name) index-file-name)
91 | ((file-exists? file-name) file-name)
92 | (else #f))))
93 |
94 | (define (render-file file-name)
95 | "Return a 200 OK HTTP response that renders the contents of
96 | FILE-NAME."
97 | (values `((content-type . (,(mime-type file-name))))
98 | (call-with-input-file file-name get-bytevector-all)))
99 |
100 | (define (render-directory path dir)
101 | "Render the contents of DIR represented by the URI PATH."
102 | (define (concat+uri-encode . file-names)
103 | "Concatenate FILE-NAMES, preserving the correct file separators."
104 | (string-join (map uri-encode
105 | (remove string-null?
106 | (flat-map (cut string-split <> #\/) file-names)))
107 | "/" 'prefix))
108 |
109 | (define render-child
110 | (match-lambda
111 | ((file-name directory?)
112 | `(li
113 | (a (@ (href ,(concat+uri-encode path file-name)))
114 | ,(if directory?
115 | (string-append file-name "/")
116 | file-name))))))
117 |
118 | (define file-name<
119 | (match-lambda*
120 | (((name-a _) (name-b _))
121 | (string< name-a name-b))))
122 |
123 | (let* ((children (sort (directory-contents dir) file-name<))
124 | (title (string-append "Directory listing for " path))
125 | (view `(html
126 | (head
127 | (title ,title))
128 | (body
129 | (h1 ,title)
130 | (ul ,@(map render-child children))))))
131 | (values '((content-type . (text/html)))
132 | (lambda (port)
133 | (display "" port)
134 | (sxml->xml view port)))))
135 |
136 | (define (not-found path)
137 | "Return a 404 not found HTTP response for PATH."
138 | (values (build-response #:code 404)
139 | (string-append "Resource not found: " path)))
140 |
141 | (define (serve-file work-dir path)
142 | "Return an HTTP response for the file represented by PATH."
143 | (match (resolve-file-name
144 | (work-dir+path->file-name work-dir path))
145 | (#f (not-found path))
146 | ((? directory? dir)
147 | (render-directory path dir))
148 | (file-name
149 | (render-file file-name))))
150 |
151 | (define (make-handler work-dir)
152 | (lambda (request body)
153 | "Serve the file asked for in REQUEST."
154 | (format #t "~a ~a~%"
155 | (request-method request)
156 | (uri-path (request-uri request)))
157 | (serve-file work-dir (request-file-name request))))
158 |
159 | (define* (serve work-dir #:key (open-params '()))
160 | "Run a simple HTTP server that serves files in WORK-DIR."
161 | (run-server (make-handler work-dir) 'http open-params))
162 |
--------------------------------------------------------------------------------
/haunt/site.scm:
--------------------------------------------------------------------------------
1 | ;;; Haunt --- Static site generator for GNU Guile
2 | ;;; Copyright © 2015 David Thompson
3 | ;;;
4 | ;;; This file is part of Haunt.
5 | ;;;
6 | ;;; Haunt is free software; you can redistribute it and/or modify it
7 | ;;; under the terms of the GNU General Public License as published by
8 | ;;; the Free Software Foundation; either version 3 of the License, or
9 | ;;; (at your option) any later version.
10 | ;;;
11 | ;;; Haunt is distributed in the hope that it will be useful, but
12 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
13 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
14 | ;;; General Public License for more details.
15 | ;;;
16 | ;;; You should have received a copy of the GNU General Public License
17 | ;;; along with Haunt. If not, see .
18 |
19 | ;;; Commentary:
20 | ;;
21 | ;; Site configuration data type.
22 | ;;
23 | ;;; Code:
24 |
25 | (define-module (haunt site)
26 | #:use-module (srfi srfi-1)
27 | #:use-module (srfi srfi-9)
28 | #:use-module (srfi srfi-26)
29 | #:use-module (ice-9 match)
30 | #:use-module (ice-9 regex)
31 | #:use-module (haunt utils)
32 | #:use-module (haunt reader)
33 | #:use-module (haunt page)
34 | #:use-module (haunt post)
35 | #:use-module (haunt asset)
36 | #:export (site
37 | site?
38 | site-title
39 | site-domain
40 | site-posts-directory
41 | site-file-filter
42 | site-build-directory
43 | site-default-metadata
44 | site-make-slug
45 | site-readers
46 | site-builders
47 | site-post-slug
48 | build-site
49 |
50 | make-file-filter
51 | default-file-filter))
52 |
53 | (define-record-type
54 | (make-site title domain posts-directory file-filter build-directory
55 | default-metadata make-slug readers builders)
56 | site?
57 | (title site-title)
58 | (domain site-domain)
59 | (posts-directory site-posts-directory)
60 | (file-filter site-file-filter)
61 | (build-directory site-build-directory)
62 | (default-metadata site-default-metadata)
63 | (make-slug site-make-slug)
64 | (readers site-readers)
65 | (builders site-builders))
66 |
67 | (define* (site #:key
68 | (title "This Place is Haunted")
69 | (domain "example.com")
70 | (posts-directory "posts")
71 | (file-filter default-file-filter)
72 | (build-directory "site")
73 | (default-metadata '())
74 | (make-slug post-slug)
75 | (readers '())
76 | (builders '()))
77 | "Create a new site object. All arguments are optional:
78 |
79 | TITLE: The name of the site
80 | POSTS-DIRECTORY: The directory where posts are found
81 | FILE-FILTER: A predicate procedure that returns #f when a post file
82 | should be ignored, and #f otherwise. Emacs temp files are ignored by
83 | default.
84 | BUILD-DIRECTORY: The directory that generated pages are stored in
85 | DEFAULT-METADATA: An alist of arbitrary default metadata for posts
86 | whose keys are symbols
87 | MAKE-SLUG: A procedure generating a file name slug from a post
88 | READERS: A list of reader objects for processing posts
89 | BUILDERS: A list of procedures for building pages from posts"
90 | (make-site title domain posts-directory file-filter build-directory
91 | default-metadata make-slug readers builders))
92 |
93 | (define (site-post-slug site post)
94 | "Return a slug string for POST using the slug generator for SITE."
95 | ((site-make-slug site) post))
96 |
97 | (define (build-site site)
98 | "Build SITE in the appropriate build directory."
99 | (let ((posts (if (file-exists? (site-posts-directory site))
100 | (read-posts (site-posts-directory site)
101 | (site-file-filter site)
102 | (site-readers site)
103 | (site-default-metadata site))
104 | '()))
105 | (build-dir (absolute-file-name (site-build-directory site))))
106 | (when (file-exists? build-dir)
107 | (delete-file-recursively build-dir)
108 | (mkdir build-dir))
109 | (for-each (match-lambda
110 | ((? page? page)
111 | (format #t "writing page '~a'~%" (page-file-name page))
112 | (write-page page build-dir))
113 | ((? asset? asset)
114 | (format #t "copying asset '~a' → '~a'~%"
115 | (asset-source asset)
116 | (asset-target asset))
117 | (install-asset asset build-dir))
118 | (obj
119 | (error "unrecognized site object: " obj)))
120 | (flat-map (cut <> site posts) (site-builders site)))))
121 |
122 | (define (make-file-filter patterns)
123 | (let ((patterns (map make-regexp patterns)))
124 | (lambda (file-name)
125 | (not (any (lambda (regexp)
126 | (regexp-match?
127 | (regexp-exec regexp (basename file-name))))
128 | patterns)))))
129 |
130 | ;; Filter out Emacs temporary files by default.
131 | (define default-file-filter
132 | (make-file-filter '("^\\." "^#")))
133 |
--------------------------------------------------------------------------------
/haunt/ui.scm:
--------------------------------------------------------------------------------
1 | ;;; Haunt --- Static site generator for GNU Guile
2 | ;;; Copyright © 2015 David Thompson
3 | ;;;
4 | ;;; This file is part of Haunt.
5 | ;;;
6 | ;;; Haunt is free software; you can redistribute it and/or modify it
7 | ;;; under the terms of the GNU General Public License as published by
8 | ;;; the Free Software Foundation; either version 3 of the License, or
9 | ;;; (at your option) any later version.
10 | ;;;
11 | ;;; Haunt is distributed in the hope that it will be useful, but
12 | ;;; WITnnnHOUT ANY WARRANTY; without even the implied warranty of
13 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
14 | ;;; General Public License for more details.
15 | ;;;
16 | ;;; You should have received a copy of the GNU General Public License
17 | ;;; along with Haunt. If not, see .
18 |
19 | ;;; Commentary:
20 | ;;
21 | ;; Haunt user interface.
22 | ;;
23 | ;;; Code:
24 |
25 | (define-module (haunt ui)
26 | #:use-module (ice-9 format)
27 | #:use-module (ice-9 ftw)
28 | #:use-module (ice-9 match)
29 | #:use-module (srfi srfi-1)
30 | #:use-module (srfi srfi-26)
31 | #:use-module (srfi srfi-37)
32 | #:use-module (haunt config)
33 | #:use-module (haunt site)
34 | #:use-module (haunt utils)
35 | #:export (program-name
36 | show-version-and-exit
37 | simple-args-fold
38 | %common-options
39 | %default-common-options
40 | show-common-options-help
41 | leave
42 | string->number*
43 | load-config
44 | option?
45 | haunt-main))
46 |
47 | (define commands
48 | '("build" "serve"))
49 |
50 | (define program-name (make-parameter 'haunt))
51 |
52 | (define (show-haunt-help)
53 | (format #t "Usage: haunt COMMAND ARGS...
54 | Run COMMAND with ARGS.~%~%")
55 | (format #t "COMMAND must be one of the sub-commands listed below:~%~%")
56 | (format #t "~{ ~a~%~}" (sort commands string
66 | This is free software: you are free to change and redistribute it.
67 | There is NO WARRANTY, to the extent permitted by law.~%"
68 | name %haunt-version)
69 | (exit 0))
70 |
71 | (define (leave format-string . args)
72 | "Display error message and exist."
73 | (apply format (current-error-port) format-string args)
74 | (newline)
75 | (exit 1))
76 |
77 | (define (string->number* str)
78 | "Like `string->number', but error out with an error message on failure."
79 | (or (string->number str)
80 | (leave "~a: invalid number" str)))
81 |
82 | (define (simple-args-fold args options default-options)
83 | (args-fold args options
84 | (lambda (opt name arg result)
85 | (leave "~A: unrecognized option" name))
86 | (lambda (arg result)
87 | (leave "~A: extraneuous argument" arg))
88 | default-options))
89 |
90 | (define %common-options
91 | (list (option '(#\c "config") #t #f
92 | (lambda (opt name arg result)
93 | (alist-cons 'config arg result)))))
94 |
95 | (define %default-common-options
96 | '((config . "haunt.scm")))
97 |
98 | (define (show-common-options-help)
99 | (display "
100 | -c, --config configuration file to load"))
101 |
102 | (define (option? str)
103 | (string-prefix? "-" str))
104 |
105 | (define* (load-config file-name)
106 | "Load configuration from FILE-NAME."
107 | (if (file-exists? file-name)
108 | (let ((obj (load (absolute-file-name file-name))))
109 | (if (site? obj)
110 | obj
111 | (leave "configuration object must be a site, got: ~a" obj)))
112 | (leave "configuration file not found: ~a" file-name)))
113 |
114 | (define (run-haunt-command command . args)
115 | (let* ((module
116 | (catch 'misc-error
117 | (lambda ()
118 | (resolve-interface `(haunt ui ,command)))
119 | (lambda -
120 | (format (current-error-port) "~a: invalid subcommand~%" command)
121 | (show-haunt-usage))))
122 | (command-main (module-ref module (symbol-append 'haunt- command))))
123 | (parameterize ((program-name command))
124 | (apply command-main args))))
125 |
126 | (define* (haunt-main arg0 . args)
127 | (setlocale LC_ALL "")
128 | (match args
129 | (()
130 | (show-haunt-usage))
131 | ((or ("-h") ("--help"))
132 | (show-haunt-help))
133 | (("--version")
134 | (show-version-and-exit "haunt"))
135 | (((? option? opt) _ ...)
136 | (format (current-error-port)
137 | "haunt: unrecognized option '~a'~%"
138 | opt)
139 | (show-haunt-usage))
140 | ((command args ...)
141 | (apply run-haunt-command (string->symbol command) args))))
142 |
--------------------------------------------------------------------------------
/haunt/ui/build.scm:
--------------------------------------------------------------------------------
1 | ;;; Haunt --- Static site generator for GNU Guile
2 | ;;; Copyright © 2015 David Thompson
3 | ;;;
4 | ;;; This file is part of Haunt.
5 | ;;;
6 | ;;; Haunt is free software; you can redistribute it and/or modify it
7 | ;;; under the terms of the GNU General Public License as published by
8 | ;;; the Free Software Foundation; either version 3 of the License, or
9 | ;;; (at your option) any later version.
10 | ;;;
11 | ;;; Haunt is distributed in the hope that it will be useful, but
12 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
13 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
14 | ;;; General Public License for more details.
15 | ;;;
16 | ;;; You should have received a copy of the GNU General Public License
17 | ;;; along with Haunt. If not, see .
18 |
19 | ;;; Commentary:
20 | ;;
21 | ;; Haunt build sub-command.
22 | ;;
23 | ;;; Code:
24 |
25 | (define-module (haunt ui build)
26 | #:use-module (srfi srfi-37)
27 | #:use-module (ice-9 match)
28 | #:use-module (haunt site)
29 | #:use-module (haunt config)
30 | #:use-module (haunt ui)
31 | #:export (haunt-build))
32 |
33 | (define (show-help)
34 | (format #t "Usage: haunt build [OPTION]
35 | Compile the site defined in the current directory.~%")
36 | (show-common-options-help)
37 | (newline)
38 | (display "
39 | -h, --help display this help and exit")
40 | (display "
41 | --version display version information and exit")
42 | (newline))
43 |
44 | (define %options
45 | (cons* (option '(#\h "help") #f #f
46 | (lambda _
47 | (show-help)
48 | (exit 0)))
49 | (option '(#\V "version") #f #f
50 | (lambda _
51 | (show-version-and-exit "haunt build")))
52 | %common-options))
53 |
54 | (define %default-options %default-common-options)
55 |
56 | (define (haunt-build . args)
57 | (let* ((opts (simple-args-fold args %options %default-options))
58 | (site (load-config (assq-ref opts 'config))))
59 | (format #t "building pages in '~a'...~%" (site-build-directory site))
60 | (build-site site)
61 | (display "build completed successfully\n")))
62 |
--------------------------------------------------------------------------------
/haunt/ui/serve.scm:
--------------------------------------------------------------------------------
1 | ;;; Haunt --- Static site generator for GNU Guile
2 | ;;; Copyright © 2015 David Thompson
3 | ;;;
4 | ;;; This file is part of Haunt.
5 | ;;;
6 | ;;; Haunt is free software; you can redistribute it and/or modify it
7 | ;;; under the terms of the GNU General Public License as published by
8 | ;;; the Free Software Foundation; either version 3 of the License, or
9 | ;;; (at your option) any later version.
10 | ;;;
11 | ;;; Haunt is distributed in the hope that it will be useful, but
12 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
13 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
14 | ;;; General Public License for more details.
15 | ;;;
16 | ;;; You should have received a copy of the GNU General Public License
17 | ;;; along with Haunt. If not, see .
18 |
19 | ;;; Commentary:
20 | ;;
21 | ;; Haunt serve sub-command.
22 | ;;
23 | ;;; Code:
24 |
25 | (define-module (haunt ui serve)
26 | #:use-module (srfi srfi-1)
27 | #:use-module (srfi srfi-37)
28 | #:use-module (ice-9 match)
29 | #:use-module (ice-9 format)
30 | #:use-module (ice-9 ftw)
31 | #:use-module (haunt site)
32 | #:use-module (haunt config)
33 | #:use-module (haunt ui)
34 | #:use-module (haunt serve web-server)
35 | #:export (haunt-serve))
36 |
37 | (define (show-help)
38 | (format #t "Usage: haunt serve [OPTION]
39 | Start an HTTP server for the current site.~%")
40 | (display "
41 | -p, --port port to listen on")
42 | (display "
43 | -w, --watch rebuild site when files change")
44 | (newline)
45 | (show-common-options-help)
46 | (newline)
47 | (display "
48 | -h, --help display this help and exit")
49 | (display "
50 | -V, --version display version and exit")
51 | (newline))
52 |
53 | (define %options
54 | (cons* (option '(#\h "help") #f #f
55 | (lambda _
56 | (show-help)
57 | (exit 0)))
58 | (option '(#\V "version") #f #f
59 | (lambda _
60 | (show-version-and-exit "haunt serve")))
61 | (option '(#\p "port") #t #f
62 | (lambda (opt name arg result)
63 | (alist-cons 'port (string->number* arg) result)))
64 | (option '(#\w "watch") #f #f
65 | (lambda (opt name arg result)
66 | (alist-cons 'watch? #t result)))
67 | %common-options))
68 |
69 | (define %default-options
70 | (cons '(port . 8080)
71 | %default-common-options))
72 |
73 | ;; XXX: Make this less naive.
74 | (define (watch config-file check-dir? check-file?)
75 | "Watch the current working directory for changes to any of its files
76 | that match CHECK-FILE? and any subdirectories that match CHECK-DIR?.
77 | When a file has been changed, reload CONFIG-FILE and rebuild the
78 | site."
79 |
80 | (define cwd (getcwd))
81 |
82 | (define (any-files-changed? time)
83 | (define (enter? name stat result)
84 | ;; Don't bother descending if we already know that a file has
85 | ;; changed.
86 | (and (not result) (check-dir? name)))
87 |
88 | (define (leaf name stat result)
89 | ;; Test if file has been modified since the last time we
90 | ;; checked.
91 | (or result
92 | (and (check-file? name)
93 | (or (>= (stat:mtime stat) time)
94 | (>= (stat:ctime stat) time)))))
95 |
96 | (define (no-op name stat result) result)
97 |
98 | (file-system-fold enter? leaf no-op no-op no-op no-op #f cwd))
99 |
100 | (let loop ((time (current-time)))
101 | (when (any-files-changed? time)
102 | (display "rebuilding...\n")
103 | (build-site (load-config config-file)))
104 | (let ((next-time (current-time)))
105 | (sleep 1)
106 | (loop next-time))))
107 |
108 | (define (haunt-serve . args)
109 | (let* ((opts (simple-args-fold args %options %default-options))
110 | (port (assq-ref opts 'port))
111 | (watch? (assq-ref opts 'watch?))
112 | (config (assq-ref opts 'config))
113 | (site (load-config config))
114 | (doc-root (site-build-directory site)))
115 | (format #t "serving ~a on port ~d~%" doc-root port)
116 |
117 | (when watch?
118 | (call-with-new-thread
119 | (lambda ()
120 | (watch config
121 | (let ((cwd (getcwd))
122 | (build-dir (site-build-directory site)))
123 | (lambda (dir)
124 | (not
125 | (string-prefix? (string-append cwd "/" build-dir) dir))))
126 | (site-file-filter site)))))
127 |
128 | (serve doc-root)))
129 |
--------------------------------------------------------------------------------
/haunt/utils.scm:
--------------------------------------------------------------------------------
1 | ;;; Haunt --- Static site generator for GNU Guile
2 | ;;; Copyright © 2015 David Thompson
3 | ;;; Copyright © 2012, 2013, 2014 Ludovic Courtès
4 | ;;;
5 | ;;; This file is part of Haunt.
6 | ;;;
7 | ;;; Haunt is free software; you can redistribute it and/or modify it
8 | ;;; under the terms of the GNU General Public License as published by
9 | ;;; the Free Software Foundation; either version 3 of the License, or
10 | ;;; (at your option) any later version.
11 | ;;;
12 | ;;; Haunt is distributed in the hope that it will be useful, but
13 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
14 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15 | ;;; General Public License for more details.
16 | ;;;
17 | ;;; You should have received a copy of the GNU General Public License
18 | ;;; along with Haunt. If not, see .
19 |
20 | ;;; Commentary:
21 | ;;
22 | ;; Miscellaneous utility procedures.
23 | ;;
24 | ;;; Code:
25 |
26 | (define-module (haunt utils)
27 | #:use-module (ice-9 ftw)
28 | #:use-module (ice-9 match)
29 | #:use-module (srfi srfi-1)
30 | #:use-module (srfi srfi-19)
31 | #:use-module (srfi srfi-26)
32 | #:export (flatten
33 | flat-map
34 | string-split-at
35 | file-name-components
36 | join-file-name-components
37 | absolute-file-name
38 | delete-file-recursively
39 | mkdir-p
40 | string->date*
41 | take-up-to))
42 |
43 | (define* (flatten lst #:optional depth)
44 | "Return a list that recursively concatenates the sub-lists of LST,
45 | up to DEPTH levels deep. When DEPTH is #f, the entire tree is
46 | flattened."
47 | (if (and (number? depth) (zero? depth))
48 | lst
49 | (fold-right (match-lambda*
50 | (((sub-list ...) memo)
51 | (append (flatten sub-list (and depth (1- depth)))
52 | memo))
53 | ((elem memo)
54 | (cons elem memo)))
55 | '()
56 | lst)))
57 |
58 | (define (flat-map proc . lsts)
59 | (flatten (apply map proc lsts) 1))
60 |
61 | (define (string-split-at str char-pred)
62 | (let ((i (string-index str char-pred)))
63 | (if i
64 | (list (string-take str i)
65 | (string-drop str (1+ i)))
66 | (list str))))
67 |
68 | (define (file-name-components file-name)
69 | "Split FILE-NAME into the components delimited by '/'."
70 | (if (string-null? file-name)
71 | '()
72 | (string-split file-name #\/)))
73 |
74 | (define (join-file-name-components components)
75 | "Join COMPONENTS into a file name string."
76 | (string-join components "/"))
77 |
78 | (define (absolute-file-name file-name)
79 | (if (absolute-file-name? file-name)
80 | file-name
81 | (string-append (getcwd) "/" file-name)))
82 |
83 | ;; Written by Ludovic Courtès for GNU Guix.
84 | (define* (delete-file-recursively dir
85 | #:key follow-mounts?)
86 | "Delete DIR recursively, like `rm -rf', without following symlinks. Don't
87 | follow mount points either, unless FOLLOW-MOUNTS? is true. Report but ignore
88 | errors."
89 | (let ((dev (stat:dev (lstat dir))))
90 | (file-system-fold (lambda (dir stat result) ; enter?
91 | (or follow-mounts?
92 | (= dev (stat:dev stat))))
93 | (lambda (file stat result) ; leaf
94 | (delete-file file))
95 | (const #t) ; down
96 | (lambda (dir stat result) ; up
97 | (rmdir dir))
98 | (const #t) ; skip
99 | (lambda (file stat errno result)
100 | (format (current-error-port)
101 | "warning: failed to delete ~a: ~a~%"
102 | file (strerror errno)))
103 | #t
104 | dir
105 |
106 | ;; Don't follow symlinks.
107 | lstat)))
108 |
109 | ;; Written by Ludovic Courtès for GNU Guix.
110 | (define (mkdir-p dir)
111 | "Create directory DIR and all its ancestors."
112 | (define absolute?
113 | (string-prefix? "/" dir))
114 |
115 | (define not-slash
116 | (char-set-complement (char-set #\/)))
117 |
118 | (let loop ((components (string-tokenize dir not-slash))
119 | (root (if absolute?
120 | ""
121 | ".")))
122 | (match components
123 | ((head tail ...)
124 | (let ((path (string-append root "/" head)))
125 | (catch 'system-error
126 | (lambda ()
127 | (mkdir path)
128 | (loop tail path))
129 | (lambda args
130 | (if (= EEXIST (system-error-errno args))
131 | (loop tail path)
132 | (apply throw args))))))
133 | (() #t))))
134 |
135 | (define (string->date* str)
136 | "Convert STR, a string in '~Y~m~d ~H:~M' format, into a SRFI-19 date
137 | object."
138 | (string->date str "~Y~m~d ~H:~M"))
139 |
140 | (define (take-up-to n lst)
141 | "Return the first N elements of LST or an equivalent list if there
142 | are fewer than N elements."
143 | (if (zero? n)
144 | '()
145 | (match lst
146 | (() '())
147 | ((head . tail)
148 | (cons head (take-up-to (1- n) tail))))))
149 |
--------------------------------------------------------------------------------
/package.scm:
--------------------------------------------------------------------------------
1 | ;;; Haunt --- Static site generator for GNU Guile
2 | ;;; Copyright © 2015 David Thompson
3 | ;;;
4 | ;;; This file is part of Haunt.
5 | ;;;
6 | ;;; Haunt is free software; you can redistribute it and/or modify it
7 | ;;; under the terms of the GNU General Public License as published by
8 | ;;; the Free Software Foundation; either version 3 of the License, or
9 | ;;; (at your option) any later version.
10 | ;;;
11 | ;;; Haunt is distributed in the hope that it will be useful, but
12 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
13 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
14 | ;;; General Public License for more details.
15 | ;;;
16 | ;;; You should have received a copy of the GNU General Public License
17 | ;;; along with Haunt. If not, see .
18 |
19 | ;;; Commentary:
20 | ;;
21 | ;; GNU Guix development package. To build and install, run:
22 | ;;
23 | ;; guix package -e '(primitive-load "package.scm")'
24 | ;;
25 | ;; To use as the basis for a development environment, run:
26 | ;;
27 | ;; guix environment -l package.scm
28 | ;;
29 | ;;; Code:
30 |
31 | (use-modules (guix packages)
32 | (guix licenses)
33 | (guix git-download)
34 | (guix build-system gnu)
35 | (gnu packages)
36 | (gnu packages autotools)
37 | (gnu packages guile))
38 |
39 | (package
40 | (name "haunt")
41 | (version "0.1")
42 | (source (origin
43 | (method git-fetch)
44 | (uri (git-reference
45 | (url "git://dthompson.us/haunt.git")
46 | (commit "f012747")))
47 | (sha256
48 | (base32
49 | "0gj4xw79g3q87m6js0mbvv437zf7df5d2xg4sx65mpgc85j7zafs"))))
50 | (build-system gnu-build-system)
51 | (arguments
52 | '(#:phases
53 | (modify-phases %standard-phases
54 | (add-after 'unpack 'bootstrap
55 | (lambda _ (zero? (system* "sh" "bootstrap")))))))
56 | (native-inputs
57 | `(("autoconf" ,autoconf)
58 | ("automake" ,automake)))
59 | (inputs
60 | `(("guile" ,guile-2.0)))
61 | (synopsis "Functional static site generator")
62 | (description "Haunt is a static site generator written in Guile
63 | Scheme. Haunt features a functional build system and an extensible
64 | interface for reading articles in any format.")
65 | (home-page "http://haunt.dthompson.us")
66 | (license gpl3+))
67 |
--------------------------------------------------------------------------------
/pre-inst-env.in:
--------------------------------------------------------------------------------
1 | #!/bin/sh
2 |
3 | # Haunt --- Static site generator for GNU Guile
4 | # Copyright © 2015 David Thompson
5 | #
6 | # This file is part of Haunt.
7 | #
8 | # Haunt is free software; you can redistribute it and/or modify it
9 | # under the terms of the GNU General Public License as published by
10 | # the Free Software Foundation; either version 3 of the License, or
11 | # (at your option) any later version.
12 | #
13 | # Haunt is distributed in the hope that it will be useful, but WITHOUT
14 | # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
15 | # or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public
16 | # License for more details.
17 | #
18 | # You should have received a copy of the GNU General Public License
19 | # along with Haunt. If not, see .
20 |
21 | abs_top_srcdir="`cd "@abs_top_srcdir@" > /dev/null; pwd`"
22 | abs_top_builddir="`cd "@abs_top_builddir@" > /dev/null; pwd`"
23 |
24 | GUILE_LOAD_COMPILED_PATH="$abs_top_builddir${GUILE_LOAD_COMPILED_PATH:+:}$GUILE_LOAD_COMPILED_PATH"
25 | GUILE_LOAD_PATH="$abs_top_builddir:$abs_top_srcdir${GUILE_LOAD_PATH:+:}:$GUILE_LOAD_PATH"
26 | export GUILE_LOAD_COMPILED_PATH GUILE_LOAD_PATH
27 |
28 | PATH="$abs_top_builddir/scripts:$PATH"
29 | export PATH
30 |
31 | exec "$@"
32 |
--------------------------------------------------------------------------------
/scripts/haunt.in:
--------------------------------------------------------------------------------
1 | #!@GUILE@ --no-auto-compile
2 | -*- scheme -*-
3 | !#
4 | ;;; Haunt --- Static site generator for GNU Guile
5 | ;;; Copyright © 2015 David Thompson
6 | ;;;
7 | ;;; This file is part of Haunt.
8 | ;;;
9 | ;;; Haunt is free software; you can redistribute it and/or modify it
10 | ;;; under the terms of the GNU General Public License as published by
11 | ;;; the Free Software Foundation; either version 3 of the License, or
12 | ;;; (at your option) any later version.
13 | ;;;
14 | ;;; Haunt is distributed in the hope that it will be useful, but
15 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
16 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
17 | ;;; General Public License for more details.
18 | ;;;
19 | ;;; You should have received a copy of the GNU General Public License
20 | ;;; along with Haunt. If not, see .
21 |
22 | (use-modules (haunt ui))
23 |
24 | (apply haunt-main (command-line))
25 |
--------------------------------------------------------------------------------
/website/Makefile.am:
--------------------------------------------------------------------------------
1 | ## Haunt --- Static site generator for GNU Guile
2 | ## Copyright © 2015 David Thompson
3 | ##
4 | ## This file is part of Haunt.
5 | ##
6 | ## Haunt is free software; you can redistribute it and/or modify it
7 | ## under the terms of the GNU General Public License as published by
8 | ## the Free Software Foundation; either version 3 of the License, or
9 | ## (at your option) any later version.
10 | ##
11 | ## Haunt is distributed in the hope that it will be useful, but
12 | ## WITHOUT ANY WARRANTY; without even the implied warranty of
13 | ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
14 | ## General Public License for more details.
15 | ##
16 | ## You should have received a copy of the GNU General Public License
17 | ## along with Haunt. If not, see .
18 |
19 | dist_noinst_DATA = \
20 | haunt.scm \
21 | css/main.css \
22 | css/reset.css \
23 | images/haunt.png \
24 | js/piwik.js \
25 | posts/0.1-release.sxml
26 |
27 | publish:
28 | rsync -P -rvz --delete site/ blog@dthompson.us:/var/www/haunt --cvs-exclude
29 |
--------------------------------------------------------------------------------
/website/css/main.css:
--------------------------------------------------------------------------------
1 | html {
2 | font-size: 10px;
3 |
4 | -webkit-tap-highlight-color: rgba(0, 0, 0, 0);
5 | }
6 |
7 | body {
8 | font-family: "Helvetica Neue", Helvetica, Arial, sans-serif;
9 | font-size: 14px;
10 | line-height: 1.42857143;
11 | color: #333;
12 | background-color: #fff;
13 | }
14 |
15 | .container {
16 | padding-right: 15px;
17 | padding-left: 15px;
18 | margin-right: auto;
19 | margin-left: auto;
20 | }
21 |
22 | @media (min-width: 768px) {
23 | .container {
24 | width: 750px;
25 | }
26 | }
27 |
28 | @media (min-width: 992px) {
29 | .container {
30 | width: 970px;
31 | }
32 | }
33 |
34 | @media (min-width: 1200px) {
35 | .container {
36 | width: 1170px;
37 | }
38 | }
39 |
40 | .text-center {
41 | text-align: center;
42 | }
43 |
44 | .full-width {
45 | width: 100%;
46 | }
47 |
48 | .center {
49 | margin-left: auto;
50 | margin-right: auto;
51 | }
52 |
53 | .navbar {
54 | padding: 0;
55 | min-height: 40px;
56 | margin-bottom: 20px;
57 | background-color: #333;
58 | border-top: 1px solid #a1a1a1;
59 | border-bottom: 1px solid #a1a1a1;
60 | }
61 |
62 | .navbar .container {
63 | padding: 0;
64 | position: relative;
65 | min-height: 40px;
66 | }
67 |
68 | .navbar ul {
69 | padding: 0;
70 | height: 100%;
71 | }
72 |
73 | .navbar li {
74 | display: inline;
75 | text-decoration: none;
76 | padding-right: 30px;
77 | font-size: 20px;
78 | height: 100%;
79 | }
80 |
81 | .navbar .logo {
82 | float: left;
83 | }
84 |
85 | .navbar a {
86 | color: #fff;
87 | text-decoration: none;
88 | }
89 |
90 | .jumbotron {
91 | padding: 30px;
92 | margin-bottom: 30px;
93 | color: inherit;
94 | background-color: #eee;
95 | font-size: 20px;
96 | }
97 |
98 | .row {
99 | display: table;
100 | margin-right: -15px;
101 | margin-left: -15px;
102 | width: 100%;
103 | }
104 |
105 | .column-logo, .column-info {
106 | position: relative;
107 | min-height: 1px;
108 | padding-left: 15px;
109 | padding-right: 15px;
110 | }
111 |
112 | .column-logo {
113 | width: 40%;
114 | float: left;
115 | }
116 |
117 | .column-info {
118 | width: 50%;
119 | float: left;
120 | }
121 |
122 | .big-logo {
123 | display: block;
124 | margin-left: auto;
125 | margin-right: auto;
126 | }
127 |
128 | .btn {
129 | display: inline-block;
130 | padding: 6px 12px;
131 | margin-bottom: 0;
132 | font-size: 14px;
133 | font-weight: normal;
134 | line-height: 1.42857143;
135 | text-align: center;
136 | white-space: nowrap;
137 | vertical-align: middle;
138 | cursor: pointer;
139 | -webkit-user-select: none;
140 | -moz-user-select: none;
141 | -ms-user-select: none;
142 | user-select: none;
143 | background-image: none;
144 | border: 1px solid transparent;
145 | border-radius: 4px;
146 | text-decoration: none;
147 | }
148 |
149 | .btn:focus,
150 | .btn:active:focus,
151 | .btn.active:focus {
152 | outline: thin dotted;
153 | outline: 5px auto -webkit-focus-ring-color;
154 | outline-offset: -2px;
155 | }
156 |
157 | .btn:hover,
158 | .btn:focus {
159 | color: #286090;
160 | text-decoration: none;
161 | }
162 |
163 | .btn:active,
164 | .btn.active {
165 | background-image: none;
166 | outline: 0;
167 | -webkit-box-shadow: inset 0 3px 5px rgba(0, 0, 0, .125);
168 | box-shadow: inset 0 3px 5px rgba(0, 0, 0, .125);
169 | }
170 |
171 | .btn-primary {
172 | color: #fff;
173 | background-color: #428bca;
174 | border-color: #357ebd;
175 | }
176 |
177 | .btn-primary:hover,
178 | .btn-primary:focus,
179 | .btn-primary:active,
180 | .btn-primary.active {
181 | color: #fff;
182 | background-color: #3071a9;
183 | border-color: #285e8e;
184 | }
185 |
186 | .btn-primary:active,
187 | .btn-primary.active {
188 | background-image: none;
189 | }
190 |
191 | .btn-lg,
192 | .btn-group-lg > .btn {
193 | padding: 10px 16px;
194 | font-size: 18px;
195 | line-height: 1.33;
196 | border-radius: 6px;
197 | }
198 |
199 | pre,
200 | blockquote {
201 | border: 1px solid #999;
202 |
203 | page-break-inside: avoid;
204 | }
205 |
206 | pre {
207 | display: block;
208 | padding: 9.5px;
209 | margin: 0 0 10px;
210 | font-size: 13px;
211 | line-height: 1.42857143;
212 | color: #333;
213 | word-break: break-all;
214 | word-wrap: break-word;
215 | background-color: #f5f5f5;
216 | border: 1px solid #ccc;
217 | border-radius: 4px;
218 | }
219 |
220 | th {
221 | text-align: left;
222 | }
223 |
224 | .table {
225 | width: 100%;
226 | max-width: 100%;
227 | margin-bottom: 20px;
228 | }
229 |
230 | .table > thead > tr > th,
231 | .table > tbody > tr > th,
232 | .table > tfoot > tr > th,
233 | .table > thead > tr > td,
234 | .table > tbody > tr > td,
235 | .table > tfoot > tr > td {
236 | padding: 8px;
237 | line-height: 1.42857143;
238 | vertical-align: top;
239 | border-top: 1px solid #ddd;
240 | }
241 |
242 | .table > thead > tr > th {
243 | vertical-align: bottom;
244 | border-bottom: 2px solid #ddd;
245 | }
246 |
247 | .table > caption + thead > tr:first-child > th,
248 | .table > colgroup + thead > tr:first-child > th,
249 | .table > thead:first-child > tr:first-child > th,
250 | .table > caption + thead > tr:first-child > td,
251 | .table > colgroup + thead > tr:first-child > td,
252 | .table > thead:first-child > tr:first-child > td {
253 | border-top: 0;
254 | }
255 |
--------------------------------------------------------------------------------
/website/css/reset.css:
--------------------------------------------------------------------------------
1 | /*! normalize.css v3.0.2 | MIT License | git.io/normalize */
2 |
3 | /**
4 | * 1. Set default font family to sans-serif.
5 | * 2. Prevent iOS text size adjust after orientation change, without disabling
6 | * user zoom.
7 | */
8 |
9 | html {
10 | font-family: sans-serif; /* 1 */
11 | -ms-text-size-adjust: 100%; /* 2 */
12 | -webkit-text-size-adjust: 100%; /* 2 */
13 | }
14 |
15 | /**
16 | * Remove default margin.
17 | */
18 |
19 | body {
20 | margin: 0;
21 | }
22 |
23 | /* HTML5 display definitions
24 | ========================================================================== */
25 |
26 | /**
27 | * Correct `block` display not defined for any HTML5 element in IE 8/9.
28 | * Correct `block` display not defined for `details` or `summary` in IE 10/11
29 | * and Firefox.
30 | * Correct `block` display not defined for `main` in IE 11.
31 | */
32 |
33 | article,
34 | aside,
35 | details,
36 | figcaption,
37 | figure,
38 | footer,
39 | header,
40 | hgroup,
41 | main,
42 | menu,
43 | nav,
44 | section,
45 | summary {
46 | display: block;
47 | }
48 |
49 | /**
50 | * 1. Correct `inline-block` display not defined in IE 8/9.
51 | * 2. Normalize vertical alignment of `progress` in Chrome, Firefox, and Opera.
52 | */
53 |
54 | audio,
55 | canvas,
56 | progress,
57 | video {
58 | display: inline-block; /* 1 */
59 | vertical-align: baseline; /* 2 */
60 | }
61 |
62 | /**
63 | * Prevent modern browsers from displaying `audio` without controls.
64 | * Remove excess height in iOS 5 devices.
65 | */
66 |
67 | audio:not([controls]) {
68 | display: none;
69 | height: 0;
70 | }
71 |
72 | /**
73 | * Address `[hidden]` styling not present in IE 8/9/10.
74 | * Hide the `template` element in IE 8/9/11, Safari, and Firefox < 22.
75 | */
76 |
77 | [hidden],
78 | template {
79 | display: none;
80 | }
81 |
82 | /* Links
83 | ========================================================================== */
84 |
85 | /**
86 | * Remove the gray background color from active links in IE 10.
87 | */
88 |
89 | a {
90 | background-color: transparent;
91 | }
92 |
93 | /**
94 | * Improve readability when focused and also mouse hovered in all browsers.
95 | */
96 |
97 | a:active,
98 | a:hover {
99 | outline: 0;
100 | }
101 |
102 | /* Text-level semantics
103 | ========================================================================== */
104 |
105 | /**
106 | * Address styling not present in IE 8/9/10/11, Safari, and Chrome.
107 | */
108 |
109 | abbr[title] {
110 | border-bottom: 1px dotted;
111 | }
112 |
113 | /**
114 | * Address style set to `bolder` in Firefox 4+, Safari, and Chrome.
115 | */
116 |
117 | b,
118 | strong {
119 | font-weight: bold;
120 | }
121 |
122 | /**
123 | * Address styling not present in Safari and Chrome.
124 | */
125 |
126 | dfn {
127 | font-style: italic;
128 | }
129 |
130 | /**
131 | * Address variable `h1` font-size and margin within `section` and `article`
132 | * contexts in Firefox 4+, Safari, and Chrome.
133 | */
134 |
135 | h1 {
136 | font-size: 2em;
137 | margin: 0.67em 0;
138 | }
139 |
140 | /**
141 | * Address styling not present in IE 8/9.
142 | */
143 |
144 | mark {
145 | background: #ff0;
146 | color: #000;
147 | }
148 |
149 | /**
150 | * Address inconsistent and variable font size in all browsers.
151 | */
152 |
153 | small {
154 | font-size: 80%;
155 | }
156 |
157 | /**
158 | * Prevent `sub` and `sup` affecting `line-height` in all browsers.
159 | */
160 |
161 | sub,
162 | sup {
163 | font-size: 75%;
164 | line-height: 0;
165 | position: relative;
166 | vertical-align: baseline;
167 | }
168 |
169 | sup {
170 | top: -0.5em;
171 | }
172 |
173 | sub {
174 | bottom: -0.25em;
175 | }
176 |
177 | /* Embedded content
178 | ========================================================================== */
179 |
180 | /**
181 | * Remove border when inside `a` element in IE 8/9/10.
182 | */
183 |
184 | img {
185 | border: 0;
186 | }
187 |
188 | /**
189 | * Correct overflow not hidden in IE 9/10/11.
190 | */
191 |
192 | svg:not(:root) {
193 | overflow: hidden;
194 | }
195 |
196 | /* Grouping content
197 | ========================================================================== */
198 |
199 | /**
200 | * Address margin not present in IE 8/9 and Safari.
201 | */
202 |
203 | figure {
204 | margin: 1em 40px;
205 | }
206 |
207 | /**
208 | * Address differences between Firefox and other browsers.
209 | */
210 |
211 | hr {
212 | -moz-box-sizing: content-box;
213 | box-sizing: content-box;
214 | height: 0;
215 | }
216 |
217 | /**
218 | * Contain overflow in all browsers.
219 | */
220 |
221 | pre {
222 | overflow: auto;
223 | }
224 |
225 | /**
226 | * Address odd `em`-unit font size rendering in all browsers.
227 | */
228 |
229 | code,
230 | kbd,
231 | pre,
232 | samp {
233 | font-family: monospace, monospace;
234 | font-size: 1em;
235 | }
236 |
237 | /* Forms
238 | ========================================================================== */
239 |
240 | /**
241 | * Known limitation: by default, Chrome and Safari on OS X allow very limited
242 | * styling of `select`, unless a `border` property is set.
243 | */
244 |
245 | /**
246 | * 1. Correct color not being inherited.
247 | * Known issue: affects color of disabled elements.
248 | * 2. Correct font properties not being inherited.
249 | * 3. Address margins set differently in Firefox 4+, Safari, and Chrome.
250 | */
251 |
252 | button,
253 | input,
254 | optgroup,
255 | select,
256 | textarea {
257 | color: inherit; /* 1 */
258 | font: inherit; /* 2 */
259 | margin: 0; /* 3 */
260 | }
261 |
262 | /**
263 | * Address `overflow` set to `hidden` in IE 8/9/10/11.
264 | */
265 |
266 | button {
267 | overflow: visible;
268 | }
269 |
270 | /**
271 | * Address inconsistent `text-transform` inheritance for `button` and `select`.
272 | * All other form control elements do not inherit `text-transform` values.
273 | * Correct `button` style inheritance in Firefox, IE 8/9/10/11, and Opera.
274 | * Correct `select` style inheritance in Firefox.
275 | */
276 |
277 | button,
278 | select {
279 | text-transform: none;
280 | }
281 |
282 | /**
283 | * 1. Avoid the WebKit bug in Android 4.0.* where (2) destroys native `audio`
284 | * and `video` controls.
285 | * 2. Correct inability to style clickable `input` types in iOS.
286 | * 3. Improve usability and consistency of cursor style between image-type
287 | * `input` and others.
288 | */
289 |
290 | button,
291 | html input[type="button"], /* 1 */
292 | input[type="reset"],
293 | input[type="submit"] {
294 | -webkit-appearance: button; /* 2 */
295 | cursor: pointer; /* 3 */
296 | }
297 |
298 | /**
299 | * Re-set default cursor for disabled elements.
300 | */
301 |
302 | button[disabled],
303 | html input[disabled] {
304 | cursor: default;
305 | }
306 |
307 | /**
308 | * Remove inner padding and border in Firefox 4+.
309 | */
310 |
311 | button::-moz-focus-inner,
312 | input::-moz-focus-inner {
313 | border: 0;
314 | padding: 0;
315 | }
316 |
317 | /**
318 | * Address Firefox 4+ setting `line-height` on `input` using `!important` in
319 | * the UA stylesheet.
320 | */
321 |
322 | input {
323 | line-height: normal;
324 | }
325 |
326 | /**
327 | * It's recommended that you don't attempt to style these elements.
328 | * Firefox's implementation doesn't respect box-sizing, padding, or width.
329 | *
330 | * 1. Address box sizing set to `content-box` in IE 8/9/10.
331 | * 2. Remove excess padding in IE 8/9/10.
332 | */
333 |
334 | input[type="checkbox"],
335 | input[type="radio"] {
336 | box-sizing: border-box; /* 1 */
337 | padding: 0; /* 2 */
338 | }
339 |
340 | /**
341 | * Fix the cursor style for Chrome's increment/decrement buttons. For certain
342 | * `font-size` values of the `input`, it causes the cursor style of the
343 | * decrement button to change from `default` to `text`.
344 | */
345 |
346 | input[type="number"]::-webkit-inner-spin-button,
347 | input[type="number"]::-webkit-outer-spin-button {
348 | height: auto;
349 | }
350 |
351 | /**
352 | * 1. Address `appearance` set to `searchfield` in Safari and Chrome.
353 | * 2. Address `box-sizing` set to `border-box` in Safari and Chrome
354 | * (include `-moz` to future-proof).
355 | */
356 |
357 | input[type="search"] {
358 | -webkit-appearance: textfield; /* 1 */
359 | -moz-box-sizing: content-box;
360 | -webkit-box-sizing: content-box; /* 2 */
361 | box-sizing: content-box;
362 | }
363 |
364 | /**
365 | * Remove inner padding and search cancel button in Safari and Chrome on OS X.
366 | * Safari (but not Chrome) clips the cancel button when the search input has
367 | * padding (and `textfield` appearance).
368 | */
369 |
370 | input[type="search"]::-webkit-search-cancel-button,
371 | input[type="search"]::-webkit-search-decoration {
372 | -webkit-appearance: none;
373 | }
374 |
375 | /**
376 | * Define consistent border, margin, and padding.
377 | */
378 |
379 | fieldset {
380 | border: 1px solid #c0c0c0;
381 | margin: 0 2px;
382 | padding: 0.35em 0.625em 0.75em;
383 | }
384 |
385 | /**
386 | * 1. Correct `color` not being inherited in IE 8/9/10/11.
387 | * 2. Remove padding so people aren't caught out if they zero out fieldsets.
388 | */
389 |
390 | legend {
391 | border: 0; /* 1 */
392 | padding: 0; /* 2 */
393 | }
394 |
395 | /**
396 | * Remove default vertical scrollbar in IE 8/9/10/11.
397 | */
398 |
399 | textarea {
400 | overflow: auto;
401 | }
402 |
403 | /**
404 | * Don't inherit the `font-weight` (applied by a rule above).
405 | * NOTE: the default cannot safely be changed in Chrome and Safari on OS X.
406 | */
407 |
408 | optgroup {
409 | font-weight: bold;
410 | }
411 |
412 | /* Tables
413 | ========================================================================== */
414 |
415 | /**
416 | * Remove most spacing between table cells.
417 | */
418 |
419 | table {
420 | border-collapse: collapse;
421 | border-spacing: 0;
422 | }
423 |
424 | td,
425 | th {
426 | padding: 0;
427 | }
428 |
--------------------------------------------------------------------------------
/website/haunt.scm:
--------------------------------------------------------------------------------
1 | ;;; Haunt --- Static site generator for GNU Guile
2 | ;;; Copyright © 2015 David Thompson
3 | ;;;
4 | ;;; This file is part of Haunt.
5 | ;;;
6 | ;;; Haunt is free software; you can redistribute it and/or modify it
7 | ;;; under the terms of the GNU General Public License as published by
8 | ;;; the Free Software Foundation; either version 3 of the License, or
9 | ;;; (at your option) any later version.
10 | ;;;
11 | ;;; Haunt is distributed in the hope that it will be useful, but
12 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
13 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
14 | ;;; General Public License for more details.
15 | ;;;
16 | ;;; You should have received a copy of the GNU General Public License
17 | ;;; along with Haunt. If not, see .
18 |
19 | (use-modules (haunt site)
20 | (haunt reader)
21 | (haunt asset)
22 | (haunt page)
23 | (haunt post)
24 | (haunt html)
25 | (haunt utils)
26 | (haunt builder blog)
27 | (haunt builder atom)
28 | (haunt builder assets)
29 | (srfi srfi-19)
30 | (ice-9 rdelim)
31 | (ice-9 match)
32 | (web uri))
33 |
34 | (define %releases
35 | '(("0.1" "c81dbcdf33f9b0a19442d3701cffa3b60c8891ce")))
36 |
37 | (define (tarball-url version)
38 | (string-append "http://files.dthompson.us/haunt/haunt-"
39 | version ".tar.gz"))
40 |
41 | (define %download-button
42 | (match %releases
43 | (((version sha1) . _)
44 | `(a (@ (class "btn btn-primary btn-lg")
45 | (role "button")
46 | (href ,(tarball-url version)))
47 | "Download Haunt " ,version))))
48 |
49 | (define (stylesheet name)
50 | `(link (@ (rel "stylesheet")
51 | (href ,(string-append "/css/" name ".css")))))
52 |
53 | (define (anchor content uri)
54 | `(a (@ (href ,uri)) ,content))
55 |
56 | (define (logo src)
57 | `(img (@ (class "logo") (src ,(string-append "/images/" src)))))
58 |
59 | (define (jumbotron content)
60 | `(div (@ (class "jumbotron"))
61 | (div (@ (class "row"))
62 | (div (@ (class "column-logo"))
63 | (img (@ (class "big-logo")
64 | (src "/images/haunt.png"))))
65 | (div (@ (class "column-info")) ,content))))
66 |
67 | (define %cc-by-sa-link
68 | '(a (@ (href "https://creativecommons.org/licenses/by-sa/4.0/"))
69 | "Creative Commons Attribution Share-Alike 4.0 International"))
70 |
71 | (define %piwik-code
72 | '((script (@ (type "text/javascript") (src "/js/piwik.js")))
73 | (noscript
74 | (p (img (@ (src "//stats.dthompson.us/piwik.php?idsite=3")
75 | (style "border:0;")
76 | (alt "")))))))
77 |
78 | (define haunt-theme
79 | (theme #:name "Haunt"
80 | #:layout
81 | (lambda (site title body)
82 | `((doctype "html")
83 | (head
84 | (meta (@ (charset "utf-8")))
85 | (title ,(string-append title " — " (site-title site)))
86 | ,(stylesheet "reset")
87 | ,(stylesheet "main")
88 | ,%piwik-code)
89 | (body
90 | (header (@ (class "navbar"))
91 | (div (@ (class "container"))
92 | (ul
93 | (li ,(anchor "home" "/"))
94 | (li ,(anchor "downloads" "/downloads.html"))
95 | (li ,(anchor "git"
96 | "https://git.dthompson.us/haunt.git")))))
97 | (div (@ (class "container"))
98 | ,body
99 | (footer (@ (class "text-center"))
100 | (p (small "Copyright © 2015 David Thompson"))
101 | (p
102 | (small "The text and images on this site are free
103 | culture works available under the " ,%cc-by-sa-link " license.")))))))
104 | #:post-template
105 | (lambda (post)
106 | `((h2 ,(post-ref post 'title))
107 | (h3 "by " ,(post-ref post 'author)
108 | " — " ,(date->string* (post-date post)))
109 | (div ,(post-sxml post))))
110 | #:collection-template
111 | (lambda (site title posts prefix)
112 | (define (post-uri post)
113 | (string-append "/" (or prefix "")
114 | (site-post-slug site post) ".html"))
115 |
116 | `(,(jumbotron
117 | `((p "Haunt is a simple, functional, hackable static site
118 | generator written in Guile Scheme that gives authors the ability to
119 | treat websites as programs.")
120 | ,%download-button))
121 |
122 | (p "Haunt isn't your average static site generator. Its
123 | mission is to give authors the full expressive power of Scheme to
124 | define every aspect of their websites are generated. Haunt uses a
125 | simple, functional build system that allows any type of web page to be
126 | built by writing procedures that return page objects.")
127 | (p "Haunt has no opinion about what markup language
128 | authors should use to write posts. Just write the relevant reader
129 | procedure and Haunt will happily work with that format. Likewise,
130 | Haunt has no opinion about how authors structure their sites. Haunt
131 | ships with helpful builder procedures that generate simple blogs or
132 | Atom feeds, but authors should feel empowered to tweak them, write
133 | replacements, or add new builders to do things that the Haunt hackers
134 | didn't think of.")
135 | (p "Here's what a simple Haunt configuration looks
136 | like:")
137 | (pre
138 | ,(call-with-input-file "../example/haunt.scm" read-string))
139 |
140 | (p "With the above saved into a file named "
141 | (code "haunt.scm")
142 | " and a "
143 | (code "posts")
144 | " directory populated with the articles to publish,
145 | the site can be built by running "
146 | (code "haunt build")
147 | ". Once the site is built, running "
148 | (code "haunt serve")
149 | " and visiting "
150 | (code "localhost:8080")
151 | " in a web browser will show the results of the build
152 | without needing to upload the generated files to a web server.")
153 |
154 | (h2 "News")
155 | (ul
156 | ,@(map (lambda (post)
157 | `(li
158 | (a (@ (href ,(post-uri post)))
159 | ,(post-ref post 'title)
160 | " — "
161 | ,(date->string* (post-date post)))))
162 | (posts/reverse-chronological posts)))
163 |
164 | (h2 "License")
165 | (p "Haunt is "
166 | (a (@ (href "https://www.gnu.org/philosophy/free-sw.html"))
167 | "Free Software")
168 | " available under the "
169 | (a (@ (href "https://www.gnu.org/licenses/gpl.html"))
170 | "GNU General Public License")
171 | " version 3 or later.")
172 |
173 | (h2 "Contributing")
174 | (p "Patches to fix bugs or add new functionality are
175 | highly encouraged. In lieu of a mailing list, please send patches
176 | to "
177 | (code "davet") " at " (code "gnu") " dot " (code "org")
178 | " for now.")
179 | (p "To get the latest version of the source code, clone
180 | the official git repository:")
181 | (pre "git clone git://dthompson.us/haunt.git")))))
182 |
183 | (define (downloads-page site posts)
184 | (define body
185 | `(,(jumbotron
186 | `(,%download-button
187 | (p (small "SHA1 checksum: "
188 | ,(match %releases (((_ sha1) . _) sha1))))))
189 | (h2 "Downloads")
190 | (table (@ (class "table"))
191 | (thead
192 | (tr (th "Source") (th "SHA1")))
193 | (tbody
194 | ,(map (match-lambda
195 | ((version sha1)
196 | `(tr
197 | (td (a (@ (href ,(tarball-url version)))
198 | ,(string-append "haunt-" version ".tar.gz")))
199 | (td ,sha1))))
200 | %releases)))))
201 |
202 | (make-page "downloads.html"
203 | (with-layout haunt-theme site "Downloads" body)
204 | sxml->html))
205 |
206 | (define %collections
207 | `(("Home" "index.html" ,posts/reverse-chronological)))
208 |
209 | (site #:title "Haunt"
210 | #:domain "dthompson.us"
211 | #:default-metadata
212 | '((author . "David Thompson")
213 | (email . "davet@gnu.org"))
214 | #:readers (list sxml-reader html-reader)
215 | #:builders (list (blog #:theme haunt-theme #:collections %collections)
216 | (atom-feed)
217 | (atom-feeds-by-tag)
218 | downloads-page
219 | (static-directory "images")
220 | (static-directory "css")
221 | (static-directory "js")))
222 |
--------------------------------------------------------------------------------
/website/images/haunt.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/guildhall/guile-haunt/c67e8e924c664ae4035862cc7b439cd7ec4bcef6/website/images/haunt.png
--------------------------------------------------------------------------------
/website/js/piwik.js:
--------------------------------------------------------------------------------
1 | /*
2 | * |@licstart The following is the entire license notice for the JavaScript code in this page.|
3 | *
4 | * Copyright 2012 Matthieu Aubry.
5 | *
6 | * This program is free software: you can redistribute it and/or
7 | * modify it under the terms of the GNU General Public License as
8 | * published by the Free Software Foundation, either version 3 of the
9 | * License, or (at your option) any later version.
10 | *
11 | * This program is distributed in the hope that it will be useful, but
12 | * WITHOUT ANY WARRANTY; without even the implied warranty of
13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
14 | * General Public License for more details.
15 | *
16 | * You should have received a copy of the GNU General Public License
17 | * along with this program. If not, see http://www.gnu.org/licenses/.
18 | *
19 | * |@licend The above is the entire license notice for the JavaScript code in this page.|
20 | */
21 | var _paq = _paq || [];
22 | _paq.push(['trackPageView']);
23 | _paq.push(['enableLinkTracking']);
24 | (function() {
25 | var u="//stats.dthompson.us/";
26 | _paq.push(['setTrackerUrl', u+'piwik.php']);
27 | _paq.push(['setSiteId', 3]);
28 | var d=document, g=d.createElement('script'), s=d.getElementsByTagName('script')[0];
29 | g.type='text/javascript'; g.async=true; g.defer=true; g.src=u+'piwik.js'; s.parentNode.insertBefore(g,s);
30 | })();
31 |
--------------------------------------------------------------------------------
/website/posts/0.1-release.sxml:
--------------------------------------------------------------------------------
1 | ;;; -*- scheme -*-
2 |
3 | (use-modules (haunt utils))
4 |
5 | `((title . "Introducing Haunt")
6 | (date . ,(string->date* "2015-08-08 10:00"))
7 | (tags "news" "releases")
8 | (summary . "Haunt 0.1 released")
9 | (content
10 | ((p "I am pleased to announce the first alpha release of Haunt, yet
11 | another static site generator. Does the world really need another one
12 | of those? No, but Haunt is special because it is written in Guile
13 | Scheme, a clean and elegant Lisp dialect, which allows users to
14 | compose their websites using functional programming techniques. Using
15 | a general-purpose, extensible programming language to build websites
16 | allows Haunt users to view their website as not just mere data, but a
17 | program. Haunt empowers the user to build the abstractions they need
18 | to make a great static website without getting in the way.")
19 | (p "At its core, Haunt is a very simple program. To build your
20 | site, Haunt takes your posts and static assets as input, passes them
21 | to a series of user-defined building procedures that return one or
22 | more pages, and outputs all of the generated pages to the file system.
23 | That's all there is to it. All of the \"good stuff\" is implemented
24 | in the builder procedures. Haunt 0.1 comes with simple blog and Atom
25 | feed generators.")
26 | (p "Naturally, this website is built with Haunt. You can see its
27 | complete source code in the "
28 | (code "website") " directory in Haunt's "
29 | (a (@ (href "https://git.dthompson.us/haunt.git/tree/HEAD:/website"))
30 | "official git repository")
31 | ".")
32 | (p "The Haunt 0.1 release tarball URL can be found on the "
33 | (a (@ (href "/downloads.html")) "downloads page")
34 | ".")
35 | (p "Haunt is built to be as hackable as possible, and patches to
36 | improve it are very much welcome. In particular, new post readers for
37 | common formats such as org-mode and Markdown are desired, along with a
38 | more robust blog builder and theme engine. In lieu of a mailing list,
39 | patches may be sent to "
40 | (code "davet") " at " (code "gnu.org") ".")
41 | (p "Happy haunting!"))))
42 |
--------------------------------------------------------------------------------