diff options
| -rw-r--r-- | haunt/builder/rss.scm | 69 |
1 files changed, 41 insertions, 28 deletions
diff --git a/haunt/builder/rss.scm b/haunt/builder/rss.scm index 1d988a7..ae31b53 100644 --- a/haunt/builder/rss.scm +++ b/haunt/builder/rss.scm @@ -34,6 +34,7 @@ #:use-module (haunt html) #:use-module (haunt serve mime-types) #:use-module (haunt builder atom) + #:use-module (web uri) #:export (rss-feed)) ;; Reader beware: this isn't as nice as atom.scm, because rss isn't @@ -51,32 +52,37 @@ (define* (post->rss-item site post #:key (blog-prefix "")) "Convert POST into an RSS <item> node." - `(item - (title ,(post-ref post 'title)) - ;; Looks like: <author>lawyer@boyer.net (Lawyer Boyer)</author> - (author - ,(let ((email (post-ref post 'email)) - (author (post-ref post 'author))) - (string-append (if email - (string-append email " ") - "") - (if author - (string-append "(" author ")") - "")))) - (pubDate ,(date->rfc822-str (post-date post))) - (link (@ (href ,(string-append blog-prefix "/" - (site-post-slug site post) ".html")) - (rel "alternate"))) - (description ,(sxml->html-string (post-sxml post))) - ,@(map (lambda (enclosure) - `(enclosure (@ (title ,(enclosure-title enclosure)) - (url ,(enclosure-url enclosure)) - (type ,(enclosure-mime-type enclosure)) - ,@(map (match-lambda - ((key . value) - (list key value))) - (enclosure-extra enclosure))))) - (post-ref-all post 'enclosure)))) + (let ((uri (uri->string + (build-uri (site-scheme site) + #:host (site-domain site) + #:path (string-append (if (string-prefix? "//" blog-prefix) + "" "/") + blog-prefix "/" + (site-post-slug site post) + ".html"))))) + `(item + (title ,(post-ref post 'title)) + ;; Looks like: <author>lawyer@boyer.net (Lawyer Boyer)</author> + ,@(let ((email (post-ref post 'email)) + (author (post-ref post 'author))) + (cond ((and email author) + `((author ,(string-append email " (" author ")")))) + (email + `((author ,email))) + (else '()))) + (pubDate ,(date->rfc822-str (post-date post))) + (guid ,uri) + (link ,uri) + (description ,(sxml->html-string (post-sxml post))) + ,@(map (lambda (enclosure) + `(enclosure (@ (title ,(enclosure-title enclosure)) + (url ,(enclosure-url enclosure)) + (type ,(enclosure-mime-type enclosure)) + ,@(map (match-lambda + ((key . value) + (list key value))) + (enclosure-extra enclosure))))) + (post-ref-all post 'enclosure))))) (define* (rss-feed #:key (file-name "rss-feed.xml") @@ -93,14 +99,21 @@ FILTER: The procedure called to manipulate the posts list before rendering MAX-ENTRIES: The maximum number of posts to render in the feed" (lambda (site posts) (make-page file-name - `(rss (@ (version "2.0")) + `(rss (@ (version "2.0") + (xmlns:atom "http://www.w3.org/2005/Atom")) (channel (title ,(site-title site)) ;; It looks like RSS's description and atom's subtitle ;; are equivalent? (description ,subtitle) (pubDate ,(date->rfc822-str (current-date))) - (link (@ (href ,(site-domain site)))) + (link ,(string-append (symbol->string (site-scheme site)) + "://" (site-domain site) "/")) + (atom:link (@ (href ,(string-append (symbol->string (site-scheme site)) + "://" (site-domain site) + "/" file-name)) + (rel "self") + (type "application/rss+xml"))) ,@(map (cut post->rss-item site <> #:blog-prefix blog-prefix) (take-up-to max-entries (filter posts))))) |