rss: Made RSS builder more W3-validation compliant

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)))))