From e6d60cdcb62e9e3fefa6be56124cc81c9072324c Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Wed, 27 Dec 2023 17:43:28 -0500
Subject: builder: blog: Add #:post-prefix parameter.

This allows for posts to be nested deeper than the collections.
---
 doc/haunt.texi         | 12 ++++++++----
 haunt/builder/blog.scm | 32 ++++++++++++++++++++++----------
 2 files changed, 30 insertions(+), 14 deletions(-)

diff --git a/doc/haunt.texi b/doc/haunt.texi
index cfeff16..178565a 100644
--- a/doc/haunt.texi
+++ b/doc/haunt.texi
@@ -851,8 +851,8 @@ output directory.  By default, @var{dest} is @var{directory}.
 (use-modules (haunt builder blog))
 @end example
 
-@deffn {Procedure} theme [#:name #:layout #:post-template #:collection-template @
-       #:pagination-template]
+@deffn {Procedure} theme [#:name "Untitled"] [#:layout] [#:post-template] @
+                         [#:collection-template] [#:pagination-template]
 Create a new theme named @var{name}.
 
 The procedure @var{layout} accepts three arguments: a site, a page
@@ -880,10 +880,14 @@ links.
 Return @code{#t} if @var{object} is a theme object.
 @end deffn
 
-@deffn {Procedure} blog [#:theme #:prefix #:collections #:posts-per-page]
+@deffn {Procedure} blog [#:theme] [#:prefix] [#:post-prefix] @
+                        [#:collections `(("Recent Posts" "index.html" ,posts/reverse-chronological))] @
+                        [#:posts-per-page]
+
 Create a builder procedure that transforms a list of posts into pages
 decorated by @var{theme}, a theme object, whose URLs start with
-@var{prefix}.
+@var{prefix}.  Post pages may be nested deeper in the file hierarchy
+than collection pages by specifying the @var{post-prefix} argument.
 
 Additionally, this builder creates pages that aggregate previews of
 many posts corresponding to what is specified in the list
diff --git a/haunt/builder/blog.scm b/haunt/builder/blog.scm
index 7a1be52..6ebcd8f 100644
--- a/haunt/builder/blog.scm
+++ b/haunt/builder/blog.scm
@@ -130,22 +130,26 @@
          #:collection-template ugly-default-collection-template
          #:pagination-template ugly-default-pagination-template))
 
-(define* (blog #:key (theme ugly-theme) prefix
+(define* (blog #:key (theme ugly-theme) prefix post-prefix
                (collections
                 `(("Recent Posts" "index.html" ,posts/reverse-chronological)))
                posts-per-page)
   "Return a procedure that transforms a list of posts into pages
-decorated by THEME, whose URLs start with PREFIX.  If POSTS-PER-PAGE
-is specified, collections will be broken up into several pages with up
-to POSTS-PER-PAGE posts on each page."
+decorated by THEME, whose URLs start with PREFIX.  Post pages may be
+nested deeper in the file hierarchy than collection pages by
+specifying the POST-PREFIX argument.
+
+If POSTS-PER-PAGE is specified, collections will be broken up into
+several pages with up to POSTS-PER-PAGE posts on each page."
   (define (make-file-name base-name)
-    (if prefix
-        (string-append prefix "/" base-name)
-        base-name))
+    (string-append (or prefix "") (if prefix "/" "") base-name))
 
   (lambda (site posts)
     (define (post->page post)
-      (let ((base-name (string-append (site-post-slug site post)
+      (let ((base-name (string-append (if post-prefix
+                                          (string-append post-prefix "/")
+                                          "")
+                                      (site-post-slug site post)
                                       ".html"))
             (title (post-ref post 'title))
             (body ((theme-post-template theme) post)))
@@ -177,6 +181,13 @@ to POSTS-PER-PAGE posts on each page."
               ((item . rest)
                (loop rest (+ n 1) i (cons item page)))))))
 
+    (define collection-post-prefix
+      (if prefix
+          (if post-prefix
+              (string-append prefix "/" post-prefix)
+              prefix)
+          (or post-prefix "")))
+
     (define collection->page
       (match-lambda
         ((title file-name filtered-posts)
@@ -192,7 +203,7 @@ to POSTS-PER-PAGE posts on each page."
              (match current-page
                ((file-name posts)
                 (let* ((coll-sxml (render-collection theme site title
-                                                     posts prefix))
+                                                     posts collection-post-prefix))
                        (page-sxml (with-layout theme site title
                                                (render-pagination theme
                                                                   site
@@ -219,7 +230,8 @@ to POSTS-PER-PAGE posts on each page."
                 (serialized-artifact (string-append base-name ".html")
                                      (with-layout theme site title
                                                   (render-collection theme site title
-                                                                     filtered-posts prefix))
+                                                                     filtered-posts
+                                                                     collection-post-prefix))
                                      sxml->html)))))))
 
     ;; Produce a new collections lists, but with the filters applied
-- 
cgit v1.2.3