summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Thompson <dthompson@vistahigherlearning.com>2019-06-28 08:28:40 -0400
committerDavid Thompson <dthompson@vistahigherlearning.com>2019-06-28 08:29:09 -0400
commitd92411f7c1b6dafdd2de028aac24792c7c0ae178 (patch)
tree2441c0dddd3878b5b4dc3c735020e97d4047daba
parent794125e408e5da4a0eac1342ba3cf28786b6e904 (diff)
atom: Add 'id' attribute to feed and entries.
-rw-r--r--haunt/builder/atom.scm81
1 files changed, 46 insertions, 35 deletions
diff --git a/haunt/builder/atom.scm b/haunt/builder/atom.scm
index b38afd4..60f710d 100644
--- a/haunt/builder/atom.scm
+++ b/haunt/builder/atom.scm
@@ -35,6 +35,7 @@
#:use-module (haunt utils)
#:use-module (haunt html)
#:use-module (haunt serve mime-types)
+ #:use-module (web uri)
#:export (make-enclosure
enclosure?
enclosure-title
@@ -137,28 +138,33 @@
(define* (post->atom-entry site post #:key (blog-prefix ""))
"Convert POST into an Atom <entry> XML node."
- `(entry
- (title ,(post-ref post 'title))
- (author
- (name ,(post-ref post 'author))
- ,(let ((email (post-ref post 'email)))
- (if email `(email ,email) '())))
- (updated ,(date->string* (post-date post)))
- (link (@ (href ,(string-append blog-prefix "/"
- (site-post-slug site post) ".html"))
- (rel "alternate")))
- (summary (@ (type "html"))
- ,(sxml->html-string (post-sxml post)))
- ,@(map (lambda (enclosure)
- `(link (@ (rel "enclosure")
- (title ,(enclosure-title enclosure))
- (href ,(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 blog-prefix "/"
+ (site-post-slug site post)
+ ".html")))))
+ `(entry
+ (title ,(post-ref post 'title))
+ (id ,uri)
+ (author
+ (name ,(post-ref post 'author))
+ ,(let ((email (post-ref post 'email)))
+ (if email `(email ,email) '())))
+ (updated ,(date->string* (post-date post)))
+ (link (@ (href ,uri) (rel "alternate")))
+ (summary (@ (type "html"))
+ ,(sxml->html-string (post-sxml post)))
+ ,@(map (lambda (enclosure)
+ `(link (@ (rel "enclosure")
+ (title ,(enclosure-title enclosure))
+ (href ,(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* (atom-feed #:key
(file-name "feed.xml")
@@ -174,19 +180,24 @@ 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"
(lambda (site posts)
- (make-page file-name
- `(feed (@ (xmlns "http://www.w3.org/2005/Atom"))
- (title ,(site-title site))
- (subtitle ,subtitle)
- (updated ,(date->string* (current-date)))
- (link (@ (href ,(string-append (site-domain site)
- "/" file-name))
- (rel "self")))
- (link (@ (href ,(site-domain site))))
- ,@(map (cut post->atom-entry site <>
- #:blog-prefix blog-prefix)
- (take-up-to max-entries (filter posts))))
- sxml->xml*)))
+ (let ((uri (uri->string
+ (build-uri (site-scheme site)
+ #:host (site-domain site)
+ #:path (string-append "/" file-name)))))
+ (make-page file-name
+ `(feed (@ (xmlns "http://www.w3.org/2005/Atom"))
+ (title ,(site-title site))
+ (id ,uri)
+ (subtitle ,subtitle)
+ (updated ,(date->string* (current-date)))
+ (link (@ (href ,(string-append (site-domain site)
+ "/" file-name))
+ (rel "self")))
+ (link (@ (href ,(site-domain site))))
+ ,@(map (cut post->atom-entry site <>
+ #:blog-prefix blog-prefix)
+ (take-up-to max-entries (filter posts))))
+ sxml->xml*))))
(define* (atom-feeds-by-tag #:key
(prefix "feeds/tags")