From 40859b97c593404675325f71d9dd9812bc412d5f Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Tue, 5 Jul 2022 20:08:07 -0400
Subject: builder: rss: Add slug->file-name keyword argument.

---
 haunt/builder/rss.scm | 29 +++++++++++++++++------------
 1 file changed, 17 insertions(+), 12 deletions(-)

diff --git a/haunt/builder/rss.scm b/haunt/builder/rss.scm
index c1bafef..93c65c5 100644
--- a/haunt/builder/rss.scm
+++ b/haunt/builder/rss.scm
@@ -1,4 +1,5 @@
 ;;; Haunt --- Static site generator for GNU Guile
+;;; Copyright © 2022 David Thompson <davet@gnu.org>
 ;;; Copyright © 2018 Christopher Lemmer Webber <cwebber@dustycloud.org>
 ;;;
 ;;; This file is part of Haunt.
@@ -34,6 +35,7 @@
   #:use-module (haunt html)
   #:use-module (haunt serve mime-types)
   #:use-module (haunt builder atom)
+  #:use-module (haunt builder blog)
   #:use-module (web uri)
   #:export (rss-feed))
 
@@ -50,19 +52,14 @@
   (display "<?xml version=\"1.0\" encoding=\"utf-8\"?>" port)
   (sxml->xml sxml port))
 
-(define* (post->rss-item site post #:key (blog-prefix ""))
+(define* (post->rss-item site slug->file-name post)
   "Convert POST into an RSS <item> node."
   (let ((uri (uri->string
               (build-uri (site-scheme site)
                          #:host (site-domain site)
-                         #:path (string-append (if (string-prefix? "/" blog-prefix)
-                                                   "" "/")
-                                               blog-prefix
-                                               (if (or (string-null? blog-prefix)
-                                                       (string-suffix? "/" blog-prefix))
-                                                   "" "/")
-                                               (site-post-slug site post)
-                                               ".html")))))
+                         #:path (string-append "/"
+                                               (slug->file-name
+                                                (site-post-slug site post)))))))
     `(item
       (title ,(post-ref post 'title))
       ;; Looks like: <author>lawyer@boyer.net (Lawyer Boyer)</author>
@@ -92,7 +89,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 RSS
 feed.  All arguments are optional:
 
@@ -100,6 +98,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 'rss-feed' procedure is deprecated, switch to #:slug->file-name\n")
+          (make-compat-slug->file-name blog-prefix))))
+
   (lambda (site posts)
     (serialized-artifact file-name
                          `(rss (@ (version "2.0")
@@ -121,8 +127,7 @@ MAX-ENTRIES: The maximum number of posts to render in the feed"
                                                           "/" file-name))
                                     (rel "self")
                                     (type "application/rss+xml")))
-                                ,@(map (cut post->rss-item site <>
-                                            #:blog-prefix blog-prefix)
+                                ,@(map (cut post->rss-item site slug->file-name* <>)
                                        (take-up-to max-entries
                                                    (filter posts)))))
                          sxml->xml*)))
-- 
cgit v1.2.3