Refactor 'jakob-theme into its own module

2 files changed, 129 insertions, 113 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)))))
diff --git a/haunt.scm b/haunt.scm
index b9da3b4..353abee 100644
--- a/haunt.scm
+++ b/haunt.scm
@@ -15,62 +15,19 @@
 ;;; <http://www.gnu.org/licenses/>.
 
 (use-modules (custom alias)
-             (haunt asset)
-             (haunt builder blog)
+             (custom theme)
              (haunt builder atom)
              (haunt builder assets)
+             (haunt builder blog)
              (haunt html)
              (haunt page)
              (haunt post)
              (haunt reader)
              (haunt site)
-             (haunt utils)
              (sxml simple)
-             (sxml match)
-             (sxml transform)
-             (srfi srfi-1)
              (srfi srfi-19)
              (srfi srfi-26)
-             (ice-9 rdelim)
-             (ice-9 regex)
-             (ice-9 match)
-             (web uri))
-
-(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))))))
+             (ice-9 match))
 
 (define (static-page title file-name body)
   (lambda (site posts)
@@ -78,73 +35,6 @@
                (with-layout jakob-theme site title body)
                sxml->html)))
 
-(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)))))
-
 (define about-page
   (static-page
    "About Me"