builder: atom: Add slug->file-name keyword argument.

1 files changed, 28 insertions, 10 deletions

diff --git a/haunt/builder/atom.scm b/haunt/builder/atom.scm
index acd74d4..1f90d24 100644
--- a/haunt/builder/atom.scm
+++ b/haunt/builder/atom.scm
@@ -1,5 +1,5 @@
 ;;; Haunt --- Static site generator for GNU Guile
-;;; Copyright © 2015 David Thompson <davet@gnu.org>
+;;; Copyright © 2015, 2022 David Thompson <davet@gnu.org>
 ;;; Copyright © 2016 Christopher Allan Webber <cwebber@dustycloud.org>
 ;;;
 ;;; This file is part of Haunt.
@@ -30,6 +30,7 @@
   #:use-module (ice-9 match)
   #:use-module (sxml simple)
   #:use-module (haunt artifact)
+  #:use-module (haunt builder blog)
   #:use-module (haunt site)
   #:use-module (haunt post)
   #:use-module (haunt page)
@@ -137,14 +138,14 @@
   "Convert date to RFC-3339 formatted string."
   (date->string date "~Y-~m-~dT~H:~M:~SZ"))
 
-(define* (post->atom-entry site post #:key (blog-prefix ""))
+(define* (post->atom-entry site slug->file-name post)
   "Convert POST into an Atom <entry> XML node."
   (let ((uri (uri->string
               (build-uri (site-scheme site)
                          #:host (site-domain site)
-                         #:path (string-append blog-prefix "/"
-                                               (site-post-slug site post)
-                                               ".html")))))
+                         #:path (string-append "/"
+                                               (slug->file-name
+                                                (site-post-slug site post)))))))
     `(entry
       (title ,(post-ref post 'title))
       (id ,uri)
@@ -172,7 +173,8 @@
                     (subtitle "Recent Posts")
                     (filter posts/reverse-chronological)
                     (max-entries 20)
-                    (blog-prefix ""))
+                    (blog-prefix "")
+                    (slug->file-name slug->file-name/default))
   "Return a builder procedure that renders a list of posts as an Atom
 feed.  All arguments are optional:
 
@@ -180,6 +182,14 @@ FILE-NAME: The page file name
 SUBTITLE: The feed subtitle
 FILTER: The procedure called to manipulate the posts list before rendering
 MAX-ENTRIES: The maximum number of posts to render in the feed"
+  ;; Preserve compatibility with older versions, for now.
+  (define slug->file-name*
+    (if (string=? blog-prefix "")
+        slug->file-name
+        (begin
+          (display "warning: #:blog-prefix keyword of 'atom-feed' procedure is deprecated, switch to #:slug->file-name\n")
+          (make-compat-slug->file-name blog-prefix))))
+
   (lambda (site posts)
     (let ((uri (uri->string
                 (build-uri (site-scheme site)
@@ -195,8 +205,7 @@ MAX-ENTRIES: The maximum number of posts to render in the feed"
                                                                  "/" file-name))
                                            (rel "self")))
                                   (link (@ (href ,(site-domain site))))
-                                  ,@(map (cut post->atom-entry site <>
-                                              #:blog-prefix blog-prefix)
+                                  ,@(map (cut post->atom-entry site slug->file-name* <>)
                                          (take-up-to max-entries (filter posts))))
                            sxml->xml*))))
 
@@ -204,13 +213,22 @@ MAX-ENTRIES: The maximum number of posts to render in the feed"
                             (prefix "feeds/tags")
                             (filter posts/reverse-chronological)
                             (max-entries 20)
-                            (blog-prefix ""))
+                            (blog-prefix "")
+                            (slug->file-name slug->file-name/default))
   "Return a builder procedure that renders an atom feed for every tag
 used in a post.  All arguments are optional:
 
 PREFIX: The directory in which to write the feeds
 FILTER: The procedure called to manipulate the posts list before rendering
 MAX-ENTRIES: The maximum number of posts to render in each feed"
+  ;; Preserve compatibility with older versions, for now.
+  (define slug->file-name*
+    (if (string=? blog-prefix "")
+        slug->file-name
+        (begin
+          (display "warning: #:blog-prefix keyword of 'atom-feeds-by-tag' procedure is deprecated, switch to #:slug->file-name\n")
+          (make-compat-slug->file-name blog-prefix))))
+
   (lambda (site posts)
     (let ((tag-groups (posts/group-by-tag posts)))
       (map (match-lambda
@@ -219,6 +237,6 @@ MAX-ENTRIES: The maximum number of posts to render in each feed"
                          #:subtitle (string-append "Tag: " tag)
                          #:filter filter
                          #:max-entries max-entries
-                         #:blog-prefix blog-prefix)
+                         #:slug->file-name slug->file-name*)
               site posts)))
            tag-groups))))