dan
/
haunt
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

atom: Add 'id' attribute to feed and entries.

This commit is contained in:
David Thompson 2019-06-28 08:28:40 -04:00
parent 794125e408
commit d92411f7c1
1 changed files with 46 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
haunt/builder/atom.scm
View File

@ -35,6 +35,7 @@
#:use-module (haunt utils) #:use-module (haunt utils)
#:use-module (haunt html) #:use-module (haunt html)
#:use-module (haunt serve mime-types) #:use-module (haunt serve mime-types)
#:use-module (web uri)
#:export (make-enclosure #:export (make-enclosure
enclosure? enclosure?
enclosure-title enclosure-title
@ -137,16 +138,21 @@
(define* (post->atom-entry site post #:key (blog-prefix "")) (define* (post->atom-entry site post #:key (blog-prefix ""))
"Convert POST into an Atom <entry> XML node." "Convert POST into an Atom <entry> XML node."
(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 `(entry
(title ,(post-ref post 'title)) (title ,(post-ref post 'title))
(id ,uri)
(author (author
(name ,(post-ref post 'author)) (name ,(post-ref post 'author))
,(let ((email (post-ref post 'email))) ,(let ((email (post-ref post 'email)))
(if email `(email ,email) '()))) (if email `(email ,email) '())))
(updated ,(date->string* (post-date post))) (updated ,(date->string* (post-date post)))
(link (@ (href ,(string-append blog-prefix "/" (link (@ (href ,uri) (rel "alternate")))
(site-post-slug site post) ".html"))
(rel "alternate")))
(summary (@ (type "html")) (summary (@ (type "html"))
,(sxml->html-string (post-sxml post))) ,(sxml->html-string (post-sxml post)))
,@(map (lambda (enclosure) ,@(map (lambda (enclosure)
@ -158,7 +164,7 @@
((key . value) ((key . value)
(list key value))) (list key value)))
(enclosure-extra enclosure))))) (enclosure-extra enclosure)))))
(post-ref-all post 'enclosure)))) (post-ref-all post 'enclosure)))))
(define* (atom-feed #:key (define* (atom-feed #:key
(file-name "feed.xml") (file-name "feed.xml")
@ -174,9 +180,14 @@ SUBTITLE: The feed subtitle
FILTER: The procedure called to manipulate the posts list before rendering FILTER: The procedure called to manipulate the posts list before rendering
MAX-ENTRIES: The maximum number of posts to render in the feed" MAX-ENTRIES: The maximum number of posts to render in the feed"
(lambda (site posts) (lambda (site posts)
(let ((uri (uri->string
(build-uri (site-scheme site)
#:host (site-domain site)
#:path (string-append "/" file-name)))))
(make-page file-name (make-page file-name
`(feed (@ (xmlns "http://www.w3.org/2005/Atom")) `(feed (@ (xmlns "http://www.w3.org/2005/Atom"))
(title ,(site-title site)) (title ,(site-title site))
(id ,uri)
(subtitle ,subtitle) (subtitle ,subtitle)
(updated ,(date->string* (current-date))) (updated ,(date->string* (current-date)))
(link (@ (href ,(string-append (site-domain site) (link (@ (href ,(string-append (site-domain site)
@ -186,7 +197,7 @@ MAX-ENTRIES: The maximum number of posts to render in the feed"
,@(map (cut post->atom-entry site <> ,@(map (cut post->atom-entry site <>
#:blog-prefix blog-prefix) #:blog-prefix blog-prefix)
(take-up-to max-entries (filter posts)))) (take-up-to max-entries (filter posts))))
sxml->xml*))) sxml->xml*))))
(define* (atom-feeds-by-tag #:key (define* (atom-feeds-by-tag #:key
(prefix "feeds/tags") (prefix "feeds/tags")