Use new flat page and redirect features in Haunt!

7 files changed, 141 insertions, 56 deletions

diff --git a/haunt.scm b/haunt.scm
index 961ad0a..efdda02 100644
--- a/haunt.scm
+++ b/haunt.scm
@@ -18,50 +18,21 @@
              (haunt builder blog)
              (haunt builder atom)
              (haunt builder assets)
+             (haunt builder flat-pages)
+             (haunt builder redirects)
              (haunt post)
              (haunt publisher rsync)
              (haunt site)
              (markdown)
              (projects)
+             ((redirects) #:prefix dthompson:)
              (theme)
              (utils))
 
-(define %collections
-  `(("Recent Blog Posts" "index.html" ,posts/reverse-chronological)))
-
-(define about-page
-  (static-page
-   "About Me"
-   "about.html"
-   `((h2 "Hi.")
-     (p "I am a professional software developer.  I like to write
-programs in Scheme in my free time, such as the software that built
-this website.")
-     (p "I also like to garden and make things out of wood.")
-     (p "If you're into social media, you can follow me on "
-        ,(anchor "Mastodon" "https://toot.cat/@dthompson") "."))))
+(define post-prefix "/posts")
 
-(define projects-page
-  (static-page
-   "Projects"
-   "projects.html"
-   `((h1 "Projects")
-     (p ,(anchor "Haunt" "projects/haunt.html")
-        " — Functional, hackable static site generator")
-     (p ,(anchor "Chickadee" "projects/chickadee.html")
-        " — Game development toolkit for Guile Scheme")
-     (p ,(anchor "guile-SDL2" "projects/guile-sdl2.html")
-        " — SDL2 bindings for Guile Scheme")
-     (p ,(anchor "guile-syntax-highlight" "projects/guile-syntax-highlight.html")
-        " — Syntax highlighting library for Guile Scheme")
-     (p ,(anchor "guile-websocket" "projects/guile-websocket.html")
-        " — WebSocket library for Guile Scheme")
-     (p ,(anchor "Shroud" "projects/shroud.html")
-        " — GPG-based password manager (inactive)")
-     (p ,(anchor "Sly" "projects/sly.html")
-        " — Functional reactive game engine (abandoned)")
-     (p ,(anchor "srt2vtt" "projects/srt2vtt.html")
-        " — SRT to WebVTT subtitle converter"))))
+(define collections
+  `(("Recent Blog Posts" "index.html" ,posts/reverse-chronological)))
 
 (site #:title "dthompson"
       #:domain "dthompson.us"
@@ -69,12 +40,15 @@ this website.")
       '((author . "David Thompson")
         (email  . "davet@gnu.org"))
       #:readers (list commonmark-reader*)
-      #:builders (list (blog #:theme dthompson-theme #:collections %collections
+      #:builders (list (blog #:theme dthompson-theme
+                             #:collections collections
+                             #:post-prefix post-prefix
                              #:posts-per-page 10)
-                       (atom-feed)
-                       (atom-feeds-by-tag)
-                       about-page
-                       projects-page
+                       (redirects dthompson:redirects)
+                       (atom-feed #:blog-prefix post-prefix)
+                       (atom-feeds-by-tag #:blog-prefix post-prefix)
+                       (flat-pages "pages"
+                                   #:template (theme-layout dthompson-theme))
                        chickadee-page
                        sly-page
                        guile-sdl2-page
@@ -92,4 +66,5 @@ this website.")
                        (static-directory "manuals"))
       #:publishers (list (rsync-publisher #:destination "/var/www/blog"
                                           #:user "publish"
-                                          #:host "dthompson.us")))
+                                          #:host "dthompson.us"))
+      #:make-slug post-slug-v2)
diff --git a/manifest.scm b/manifest.scm
index ab5bc9a..4ac9c24 100644
--- a/manifest.scm
+++ b/manifest.scm
@@ -31,7 +31,7 @@
       (native-inputs (list autoconf automake pkg-config)))))
 
 (define haunt*
-  (let ((commit "63afd408c890aec7d62c754ae1399c901ff2a794"))
+  (let ((commit "bdf0ebe0e4e90b14812bccd5bf25d0aeac9ab7b2"))
     (package
      (inherit haunt)
      (source (origin
@@ -41,7 +41,7 @@
                     (commit commit)))
               (sha256
                (base32
-                "0mf8b9w7ky8grsy4cq9573ggg4gm465fgvk8dnk7kxma810fvxmx"))))
+                "0zwyjwzkpn3a31chgy9nlx274hm6jmdbffycynmhjaa5j8x19ji6"))))
      (native-inputs
       (list automake autoconf pkg-config texinfo))
      (inputs
diff --git a/pages/about.md b/pages/about.md
new file mode 100644
index 0000000..542c248
--- /dev/null
+++ b/pages/about.md
@@ -0,0 +1,13 @@
+title: About me
+---
+
+## Hi.
+
+I am a professional software developer.  I like to write
+programs in Scheme in my free time, such as the software that built
+this website.
+
+I also like to garden and make things out of wood.
+
+If you're into social media, you can follow me on
+[Mastodon](https://toot.cat/@dthompson).
diff --git a/pages/projects.md b/pages/projects.md
new file mode 100644
index 0000000..9cf79ee
--- /dev/null
+++ b/pages/projects.md
@@ -0,0 +1,20 @@
+title: Projects
+---
+
+## Projects
+
+[Haunt](projects/haunt.html) — Functional, hackable static site generator
+
+[Chickadee](projects/chickadee.html) — Game development toolkit for Guile Scheme
+
+[guile-SDL2](projects/guile-sdl2.html) — SDL2 bindings for Guile Scheme
+
+[guile-syntax-highlight](projects/guile-syntax-highlight.html) — Syntax highlighting library for Guile Scheme
+
+[guile-websocket](projects/guile-websocket.html) — WebSocket library for Guile Scheme
+
+[Shroud](projects/shroud.html) — GPG-based password manager (inactive)
+
+[Sly](projects/sly.html) — Functional reactive game engine (abandoned)
+
+[srt2vtt](projects/srt2vtt.html) — SRT to WebVTT subtitle converter
diff --git a/posts/2023-11-08-boko-no-natsuyasumi-2-patch-linux.md b/posts/2023-11-08-boko-no-natsuyasumi-2-patch-linux.md
index 2786412..746d5f2 100644
--- a/posts/2023-11-08-boko-no-natsuyasumi-2-patch-linux.md
+++ b/posts/2023-11-08-boko-no-natsuyasumi-2-patch-linux.md
@@ -2,6 +2,7 @@ title: How to apply Hilltop's Boku no Natsuyasumi 2 English patch on Linux
 date: 2023-11-08 10:00
 tags: games, modding
 summary: How to apply the English patch for Boku no Natsuyasumi 2 on Linux
+slug: boku-no-natsuyasumi-2-english-patch-linux
 ---
 
 Haven't blogged in awhile, so here’s a quickie.  Last week, Hilltop
diff --git a/redirects.scm b/redirects.scm
new file mode 100644
index 0000000..cdde39d
--- /dev/null
+++ b/redirects.scm
@@ -0,0 +1,75 @@
+;;; Copyright © 2023 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/>.
+
+(define-module (redirects)
+  #:export (redirects))
+
+;; All of my posts used to live in the site root, but I later moved
+;; them to /posts and changed the slug generator.  These redirects
+;; keep the original URLs alive.
+(define redirects
+  '(("/a-cooperative-repl-server-for-guile-2010.html" "/posts/a-cooperative-repl-server-for-guile-2-0-10.html")
+    ("/angularjs-post-mortem.html" "/posts/angularjs-post-mortem.html")
+    ("/catbird-an-experimental-game-engine-for-scheme-programmers.html" "/posts/catbird-an-experimental-game-engine-for-scheme-programmers.html")
+    ("/chickadee-0100-released.html" "/posts/chickadee-0-10-0-released.html")
+    ("/chickadee-030-released.html" "/posts/chickadee-0-3-0-released.html")
+    ("/chickadee-040-released.html" "/posts/chickadee-0-4-0-released.html")
+    ("/chickadee-050-released.html" "/posts/chickadee-0-5-0-released.html")
+    ("/chickadee-060-released.html" "/posts/chickadee-0-6-0-released.html")
+    ("/chickadee-080-released.html" "/posts/chickadee-0-8-0-released.html")
+    ("/chickadee-090-released.html" "/posts/chickadee-0-9-0-released.html")
+    ("/find-me-on-diaspora.html" "/posts/find-me-on-diaspora.html")
+    ("/first-gnu-guile-patch-and-more-guix-packages.html" "/posts/first-gnu-guile-patch-and-more-guix-packages.html")
+    ("/font-rendering-in-opengl-with-pango-and-cairo.html" "/posts/font-rendering-in-opengl-with-pango-and-cairo.html")
+    ("/functional-reactive-programming-in-scheme-with-guile-2d.html" "/posts/functional-reactive-programming-in-scheme-with-guile-2d.html")
+    ("/gnu-30th-anniversary-hackathon.html" "/posts/gnu-30th-anniversary-hackathon.html")
+    ("/guile-2d---a-2d-game-development-framework-for-gnu-guile.html" "/posts/guile-2d-a-2d-game-development-framework-for-gnu-guile.html")
+    ("/guile-2d-01-release.html" "/posts/guile-2d-0-1-release.html")
+    ("/guile-2d-is-now-named-sly.html" "/posts/guile-2d-is-now-named-sly.html")
+    ("/guile-sdl2-031-released.html" "/posts/guile-sdl2-0-3-1-released.html")
+    ("/guile-sdl2-040-released.html" "/posts/guile-sdl2-0-4-0-released.html")
+    ("/guile-sdl2-050-released.html" "/posts/guile-sdl2-0-5-0-released.html")
+    ("/guile-sdl2-070-released.html" "/posts/guile-sdl2-0-7-0-released.html")
+    ("/guile-sdl2-080-released.html" "/posts/guile-sdl2-0-8-0-released.html")
+    ("/guile-syntax-highlight-020-released.html" "/posts/guile-syntax-highlight-0-2-0-released.html")
+    ("/guile-websocket-01-released.html" "/posts/guile-websocket-0-1-released.html")
+    ("/guix-for-development.html" "/posts/guix-for-development.html")
+    ("/haunt-02-released.html" "/posts/haunt-0-2-released.html")
+    ("/haunt-021-released.html" "/posts/haunt-0-2-1-released.html")
+    ("/haunt-022-released.html" "/posts/haunt-0-2-2-released.html")
+    ("/haunt-023-released.html" "/posts/haunt-0-2-3-released.html")
+    ("/haunt-024-released.html" "/posts/haunt-0-2-4-released.html")
+    ("/haunt-026-released.html" "/posts/haunt-0-2-6-released.html")
+    ("/hello-world.html" "/posts/hello-world.html")
+    ("/how-to-apply-hilltops-boku-no-natsuyasumi-2-english-patch-on-linux.html" "/posts/boku-no-natsuyasumi-2-english-patch-linux")
+    ("/i-will-be-presenting-about-gnu-guix-at-libreplanet-2018.html" "/posts/i-will-be-presenting-about-gnu-guix-at-libreplanet-2018.html")
+    ("/installing-guix-on-a-10th-gen-thinkpad-x1.html" "/posts/installing-guix-on-a-10th-gen-thinkpad-x1.html")
+    ("/introducing-credsummoner-a-lightweight-tool-for-generating-temporary-aws-credentials.html" "/posts/introducing-credsummoner-a-lightweight-tool-for-generating-temporary-aws-credentials.html")
+    ("/introducing-haunt.html" "/posts/introducing-haunt.html")
+    ("/issues-with-object-oriented-programming-in-guile.html" "/posts/issues-with-object-oriented-programming-in-guile.html")
+    ("/jump-to-jasmine-specs-with-rinari.html" "/posts/jump-to-jasmine-specs-with-rinari.html")
+    ("/liberating-a-thinkpad-x220.html" "/posts/liberating-a-thinkpad-x220.html")
+    ("/live-asset-reloading-with-guile-2d.html" "/posts/live-asset-reloading-with-guile-2d.html")
+    ("/maine.html" "/posts/maine.html")
+    ("/my-first-gnu-guix-patch.html" "/posts/my-first-gnu-guix-patch.html")
+    ("/my-first-real-foss-contribution.html" "/posts/my-first-real-foss-contribution.html")
+    ("/rendering-html-with-sxml-and-gnu-guile.html" "/posts/rendering-html-with-sxml-and-gnu-guile.html")
+    ("/reproducible-development-environments-with-gnu-guix.html" "/posts/reproducible-development-environments-with-gnu-guix.html")
+    ("/ruby-on-guix.html" "/posts/ruby-on-guix.html")
+    ("/spring-lisp-game-jam-2023-summary.html" "/posts/spring-lisp-game-jam-2023-summary.html")
+    ("/stumpwm-on-debian-wheezy.html" "/posts/stumpwm-on-debian-wheezy.html")
+    ("/syncing-required-packages-in-emacs.html" "/posts/syncing-required-packages-in-emacs.html")
+    ("/the-little-schemer.html" "/posts/the-little-schemer.html")))
diff --git a/theme.scm b/theme.scm
index 260f63e..8837025 100644
--- a/theme.scm
+++ b/theme.scm
@@ -24,6 +24,7 @@
   #:use-module (srfi srfi-19)
   #:use-module (utils)
   #:export (dthompson-theme
+            flat-page-template
             static-page
             project-page))
 
@@ -107,16 +108,13 @@ free culture works available under the " ,%cc-by-sa-link " license.")
          #:collection-template
          (lambda (site title posts prefix)
            (define (post-uri post)
-             (string-append "/" (or prefix "")
-                            (site-post-slug site post) ".html"))
+             (string-append prefix "/" (site-post-slug site post) ".html"))
 
            `((h1 ,title
                  (a (@ (href "/feed.xml"))
                     (img (@ (class "feed-icon") (src "images/feed.png")))))
              ,(map (lambda (post)
-                     (let ((uri (string-append "/"
-                                               (site-post-slug site post)
-                                               ".html")))
+                     (let ((uri (post-uri post)))
                        `(div (@ (class "summary"))
                              (h2 (a (@ (href ,uri))
                                     ,(post-ref post 'title)))
@@ -131,14 +129,17 @@ free culture works available under the " ,%cc-by-sa-link " license.")
          (lambda (site body previous-page next-page)
            `(,@body
              (div (@ (class "paginator"))
-              ,(if previous-page
-                   `(a (@ (class "paginator-prev") (href ,previous-page))
-                        "🡐 Newer")
-                   '())
-              ,(if next-page
-                   `(a (@ (class "paginator-next") (href ,next-page))
-                       "Older 🡒")
-                   '()))))))
+                  ,(if previous-page
+                       `(a (@ (class "paginator-prev") (href ,previous-page))
+                           "🡐 Newer")
+                       '())
+                  ,(if next-page
+                       `(a (@ (class "paginator-next") (href ,next-page))
+                           "Older 🡒")
+                       '()))))))
+
+(define (flat-page-template site metadata body)
+  ((theme-layout dthompson-theme) site (assq-ref metadata 'title) body))
 
 (define (static-page title file-name body)
   (lambda (site posts)