Initial commit based on David's blog

1 files changed, 174 insertions, 0 deletions

diff --git a/haunt.scm b/haunt.scm
new file mode 100644
index 0000000..25aadcd
--- /dev/null
+++ b/haunt.scm
@@ -0,0 +1,174 @@
+;;; Copyright © 2018 David Thompson <davet@gnu.org>
+;;;
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU General Public License as
+;;; published by the Free Software Foundation; either version 3 of the
+;;; License, or (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+(use-modules (haunt asset)
+             (haunt builder blog)
+             (haunt builder atom)
+             (haunt builder assets)
+             (haunt html)
+             (haunt page)
+             (haunt post)
+             (haunt reader)
+             (haunt site)
+             (haunt utils)
+             (sxml match)
+             (sxml transform)
+             (srfi srfi-1)
+             (srfi srfi-19)
+             (ice-9 rdelim)
+             (ice-9 regex)
+             (ice-9 match)
+             (web uri))
+
+(define (date year month day)
+  "Create a SRFI-19 date for the given YEAR, MONTH, DAY"
+  (let ((tzoffset (tm:gmtoff (localtime (time-second (current-time))))))
+    (make-date 0 0 0 0 day month year tzoffset)))
+
+(define (stylesheet name)
+  `(link (@ (rel "stylesheet")
+            (href ,(string-append "/css/" name ".css")))))
+
+(define* (anchor content #:optional (uri content))
+  `(a (@ (href ,uri)) ,content))
+
+(define %cc-by-sa-link
+  '(a (@ (href "https://creativecommons.org/licenses/by-sa/4.0/"))
+      "Creative Commons Attribution Share-Alike 4.0 International"))
+
+(define %cc-by-sa-button
+  '(a (@ (class "cc-button")
+         (href "https://creativecommons.org/licenses/by-sa/4.0/"))
+      (img (@ (src "https://licensebuttons.net/l/by-sa/4.0/80x15.png")))))
+
+(define (link name uri)
+  `(a (@ (href ,uri)) ,name))
+
+(define* (centered-image url #:optional alt)
+  `(img (@ (class "centered-image")
+           (src ,url)
+           ,@(if alt
+                 `((alt ,alt))
+                 '()))))
+
+(define (first-paragraph post)
+  (let loop ((sxml (post-sxml post))
+             (result '()))
+    (match sxml
+      (() (reverse result))
+      ((or (('p ...) _ ...) (paragraph _ ...))
+       (reverse (cons paragraph result)))
+      ((head . tail)
+       (loop tail (cons head result))))))
+
+(define jakob-theme
+  (theme #:name "jakob"
+         #:layout
+         (lambda (site title body)
+           `((doctype "html")
+             (head
+              (meta (@ (charset "utf-8")))
+              (title ,(string-append title " — " (site-title site)))
+              ,(stylesheet "fonts")
+              ,(stylesheet "jakob")
+              ,(stylesheet "reset"))
+             (body
+              (div (@ (class "container"))
+                   (div (@ (class "nav"))
+                        (ul (li ,(link "Jakob L. Kreuze" "/"))
+                            (li (@ (class "fade-text")) " ")
+                            (li ,(link "About" "/about.html"))
+                            (li ,(link "Blog" "/index.html"))
+                            (li ,(link "Projects" "/projects.html"))))
+                   ,body
+                   (footer (@ (class "text-center"))
+                           (p (@ (class "copyright"))
+                              "© 2019 Jakob L. Kreuze"
+                              ,%cc-by-sa-button)
+                           (p "The text and images on this site are
+free culture works available under the " ,%cc-by-sa-link " license.")
+                           (p "This website is built with "
+                              (a (@ (href "http://haunt.dthompson.us"))
+                                 "Haunt")
+                              ", a static site generator written in "
+                              (a (@ (href "https://gnu.org/software/guile"))
+                                 "Guile Scheme")
+                              "."))))))
+         #:post-template
+         (lambda (post)
+           `((h1 (@ (class "title")),(post-ref post 'title))
+             (div (@ (class "date"))
+                  ,(date->string (post-date post)
+                                 "~B ~d, ~Y"))
+             (div (@ (class "post"))
+                  ,(post-sxml post))))
+         #:collection-template
+         (lambda (site title posts prefix)
+           (define (post-uri post)
+             (string-append "/" (or prefix "")
+                            (site-post-slug site post) ".html"))
+
+           `((h1 ,title)
+             ,(map (lambda (post)
+                     (let ((uri (string-append "/"
+                                               (site-post-slug site post)
+                                               ".html")))
+                       `(div (@ (class "summary"))
+                             (h2 (a (@ (href ,uri))
+                                    ,(post-ref post 'title)))
+                             (div (@ (class "date"))
+                                  ,(date->string (post-date post)
+                                                 "~B ~d, ~Y"))
+                             (div (@ (class "post"))
+                                  ,(first-paragraph post))
+                             (a (@ (href ,uri)) "read more ➔"))))
+                   posts)))))
+
+(define %collections
+  `(("Recent Blog Posts" "index.html" ,posts/reverse-chronological)))
+
+(define (static-page title file-name body)
+  (lambda (site posts)
+    (make-page file-name
+               (with-layout jakob-theme site title body)
+               sxml->html)))
+
+(define about-page
+  (static-page
+   "About Me"
+   "about.html"
+   `((h2 "Hi."))))
+
+(define projects-page
+  (static-page
+   "Projects"
+   "projects.html"
+   `((h1 "Projects"))))
+
+(site #:title "Jakob's Personal Webpage"
+      #:domain "jakob.space"
+      #:default-metadata
+      '((author . "Jakob L. Kreuze")
+        (email  . "zerodaysfordays@sdf.lonestar.org"))
+      #:readers (list html-reader)
+      #:builders (list (blog #:theme jakob-theme #:collections %collections)
+                       (atom-feed)
+                       (atom-feeds-by-tag)
+                       about-page
+                       projects-page
+                       (static-directory "css")
+                       (static-directory "fonts")
+                       (static-directory "images")))