diff options
| -rw-r--r-- | haunt/builder/rss.scm | 29 |
1 files 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*))) |