Refactor 'jakob-theme into its own module

1 files changed, 126 insertions, 0 deletions

diff --git a/custom/theme.scm b/custom/theme.scm
new file mode 100644
index 0000000..b41c0c4
--- /dev/null
+++ b/custom/theme.scm
@@ -0,0 +1,126 @@
+;;; Copyright © 2019 Jakob L. Kreuze <zerodaysfordays@sdf.lonestar.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/>.
+
+(define-module (custom theme)
+  #:use-module (haunt builder blog)
+  #:use-module (haunt post)
+  #:use-module (haunt site)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-19)
+  #:export (jakob-theme))
+
+(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")
+             (html
+              (head
+               (meta (@ (charset "utf-8")))
+               (meta (@ (name "viewport")
+                        (content "width=device-width, initial-scale=1.0")))
+               (title ,(string-append title " — " (site-title site)))
+               ,(stylesheet "fonts")
+               ,(stylesheet "highlight")
+               ,(stylesheet "jakob"))
+              (body
+               (div (@ (class "container"))
+                    (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 "Unless otherwise specified, 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)))))