Let's try this again...

3 files changed, 64 insertions, 25 deletions

diff --git a/haunt/jakob/builder/blog.scm b/haunt/jakob/builder/blog.scm
index 93eb519..0eda775 100644
--- a/haunt/jakob/builder/blog.scm
+++ b/haunt/jakob/builder/blog.scm
@@ -90,7 +90,7 @@
       (p ,@(maybe-cons*
             (date->string (post-date post) "~B ~d, ~Y")
             (when crosspost-uri
-              (list " ⮀ " (hyperlink local-uri "Crosspost")))
+              (list " ↻ " (hyperlink local-uri "Crosspost")))
             " ❖ Tags: "
             (intersperse
              (map (lambda (tag)
@@ -98,7 +98,7 @@
                   (post-ref post 'tags))
              ", ")))
       (p ,(first-paragraph post))
-      ,(hyperlink (or crosspost-uri local-uri) "read more 🢩"))))
+      ,(hyperlink (or crosspost-uri local-uri) "read more →"))))
 
 
 ;;;
@@ -139,7 +139,7 @@ only the posts tagged with that tag."
   (flat-map (match-lambda
               ((tag . posts)
                (items->pages render-preview posts
-                             (format #f "Posts tagged as \"~a\"" tag)
+                             (format #f "Posts tagged with \"~a\"" tag)
                              (tag-uri %tag-prefix tag ""))))
             (group-by-tag posts (cut post-ref <> 'tags))))
 
diff --git a/haunt/jakob/builder/blogroll.scm b/haunt/jakob/builder/blogroll.scm
index 70ab1f9..9d75c1e 100644
--- a/haunt/jakob/builder/blogroll.scm
+++ b/haunt/jakob/builder/blogroll.scm
@@ -24,6 +24,7 @@
   #:use-module (jakob utils sxml)
   #:use-module (jakob utils tags)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-26)
   #:export (blogroll))
 
@@ -36,19 +37,39 @@
 
 
 ;;;
-;;; Page creation.
+;;; Type for entries.
 ;;;
 
-(define (render-preview name uri tags tag-prefix)
+(define-record-type <entry>
+  (make-entry name uri tags comments)
+  entry?
+  (name     entry-name)
+  (uri      entry-uri)
+  (tags     entry-tags)
+  (comments entry-comments))
+
+(define entry
+  (match-lambda
+    ((name uri tags) (make-entry name uri tags #f))
+    ((name uri tags comments) (make-entry name uri tags comments))))
+
+
+;;;
+;;; Rendering.
+;;;
+
+(define* (render-preview name uri tags tag-prefix #:optional comments)
   "Return an SHTML preview of an entry with the given parameters."
   `(section
-    (h2 ,(hyperlink uri name))
-    (p
-     ,(intersperse
-       (map (lambda (tag)
-              (hyperlink (tag-uri tag-prefix tag) tag))
-            tags)
-       ", "))))
+    ,@(cons*
+       `(h2 ,(hyperlink uri name))
+       `(p
+         ,(intersperse
+           (map (lambda (tag)
+                  (hyperlink (tag-uri tag-prefix tag) tag))
+                tags)
+           ", "))
+       (or comments '()))))
 
 (define (render-tag-cloud prefix entries)
   "Return SHTML listing the tags of ENTRIES in PREFIX with the number of times
@@ -58,22 +79,25 @@ each tag is used."
                 ((tag count)
                  (hyperlink (tag-uri prefix tag)
                             `(li ,(format #f "~a (~a)" tag count)))))
-              (count-tags entries third))))
+              (count-tags entries entry-tags))))
 
 (define* (render-entries title prefix entries #:optional tag)
   "Return an SHTML document listing ENTRIES in PREFIX, with a header of TITLE."
   `(main
     ,@(maybe-cons*
        `(h1 ,(if tag
-                 (format #f "~a - Tagged as ~a" title tag)
+                 (format #f "~a - Tagged with \"~a\"" title tag)
                  title))
        (unless tag
          (render-tag-cloud prefix entries))
        (unless tag
          `(hr))
-       (map (match-lambda
-              ((name uri tags)
-               (render-preview name uri tags prefix)))
+       (map (lambda (entry)
+              (render-preview (entry-name entry)
+                              (entry-uri entry)
+                              (entry-tags entry)
+                              prefix
+                              (entry-comments entry)))
             entries))))
 
 (define (entries->pages title prefix entries)
@@ -90,7 +114,7 @@ pages for each of the tags used in ENTRIES."
                       (theme #:title title
                              #:content (render-entries title prefix entries tag))
                       sxml->html)))
-        (group-by-tag entries third))))
+        (group-by-tag entries entry-tags))))
 
 
 
@@ -101,12 +125,12 @@ pages for each of the tags used in ENTRIES."
 (define %blogroll
   (list "Blogroll"
         "/blogroll"
-        (primitive-load "data/blogroll.scm")))
+        (map entry (primitive-load "data/blogroll.scm"))))
 
 (define %bookmarks
   (list "Bookmarks"
         "/bookmark"
-        (primitive-load "data/bookmarks.scm")))
+        (map entry (primitive-load "data/bookmarks.scm"))))
 
 (define (blogroll)
   (lambda (site posts)
diff --git a/haunt/jakob/builder/htaccess.scm b/haunt/jakob/builder/htaccess.scm
index fd20eca..e0068d1 100644
--- a/haunt/jakob/builder/htaccess.scm
+++ b/haunt/jakob/builder/htaccess.scm
@@ -16,20 +16,35 @@
 
 (define-module (jakob builder htaccess)
   #:use-module (haunt page)
+  #:use-module (ice-9 match)
   #:export (htaccess))
 
+;; Good resource:
+;; <https://perishablepress.com/stupid-htaccess-tricks/#ess4>
+
 (define* (htaccess-writer contents #:optional (port (current-output-port)))
   (display (string-join contents "\n") port)
   (newline port))
 
-;; TODO: https://help.dreamhost.com/hc/en-us/articles/215747748-How-can-I-redirect-and-rewrite-my-URLs-with-an-htaccess-file-
-(define* (htaccess #:key handler-404)
+(define* (htaccess #:key
+                   (error-documents '())
+                   (redirects '()))
   "Create an .htaccess file at the site's root.
 
-HANDLER-404 specifies the file name of the page to display for a 404 not found."
+ERROR-DOCUMENTS specifies the file name of the page to display for a specific
+HTTP error code: a list of (error-code . file-name) pairs.
+
+REDIRECTS specifies file names to show for certain requests: a list of (pattern
+. file-name) pairs."
   (define contents
-    `(,(if handler-404
-           (format #f "ErrorDocument 404 ~a" handler-404))))
+    `(,@(map (match-lambda
+               ((code . file-name)
+                (format #f "ErrorDocument ~a ~a" code file-name)))
+             error-documents)
+      ,@(map (match-lambda
+               ((pattern . file-name)
+                (format #f "RewriteRule ~a ~a" pattern file-name)))
+             redirects)))
 
   (lambda (site posts)
     (make-page ".htaccess" contents htaccess-writer)))