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

builder: atom: Allow atom feeds to correctly set the blog prefix. 

* haunt/builder/atom.scm (post->atom-key, atom-feed, atom-feeds-by-tag):
  Add #:blog-prefix keyword.
This commit is contained in:
Christopher Allan Webber 2016-04-04 15:06:34 -05:00 committed by David Thompson
parent 37b4cde1a3
commit ed1602dc36
1 changed files with 12 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
haunt/builder/atom.scm
View File

@ -1,5 +1,6 @@
;;; Haunt --- Static site generator for GNU Guile ;;; Haunt --- Static site generator for GNU Guile
;;; Copyright © 2015 David Thompson <davet@gnu.org> ;;; Copyright © 2015 David Thompson <davet@gnu.org>
;;; Copyright © 2016 Christopher Allan Webber <cwebber@dustycloud.org>
;;; ;;;
;;; This file is part of Haunt. ;;; This file is part of Haunt.
;;; ;;;
@ -44,7 +45,7 @@
"Convert date to ISO-8601 formatted string." "Convert date to ISO-8601 formatted string."
(date->string date "~4")) (date->string date "~4"))
(define (post->atom-entry site post) (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."
`(entry `(entry
(title ,(post-ref post 'title)) (title ,(post-ref post 'title))
@ -53,7 +54,8 @@
,(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 "/" (site-post-slug site post) ".html")) (link (@ (href ,(string-append "/" blog-prefix
(site-post-slug site post) ".html"))
(rel "alternate"))) (rel "alternate")))
(summary (@ (type "html")) (summary (@ (type "html"))
,(sxml->html-string (post-sxml post))))) ,(sxml->html-string (post-sxml post)))))
@ -62,7 +64,8 @@
(file-name "feed.xml") (file-name "feed.xml")
(subtitle "Recent Posts") (subtitle "Recent Posts")
(filter posts/reverse-chronological) (filter posts/reverse-chronological)
(max-entries 20)) (max-entries 20)
(blog-prefix ""))
"Return a builder procedure that renders a list of posts as an Atom "Return a builder procedure that renders a list of posts as an Atom
feed. All arguments are optional: feed. All arguments are optional:
@ -79,14 +82,16 @@ MAX-ENTRIES: The maximum number of posts to render in the feed"
(link (@ (href ,(string-append "/" file-name)) (link (@ (href ,(string-append "/" file-name))
(rel "self"))) (rel "self")))
(link (@ (href ,(site-domain site)))) (link (@ (href ,(site-domain site))))
,@(map (cut post->atom-entry site <>) ,@(map (cut post->atom-entry site <>
#: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")
(filter posts/reverse-chronological) (filter posts/reverse-chronological)
(max-entries 20)) (max-entries 20)
(blog-prefix ""))
"Return a builder procedure that renders an atom feed for every tag "Return a builder procedure that renders an atom feed for every tag
used in a post. All arguments are optional: used in a post. All arguments are optional:
@ -100,6 +105,7 @@ MAX-ENTRIES: The maximum number of posts to render in each feed"
((atom-feed #:file-name (string-append prefix "/" tag ".xml") ((atom-feed #:file-name (string-append prefix "/" tag ".xml")
#:subtitle (string-append "Tag: " tag) #:subtitle (string-append "Tag: " tag)
#:filter filter #:filter filter
#:max-entries max-entries) #:max-entries max-entries
#:blog-prefix blog-prefix)
site posts))) site posts)))
tag-groups)))) tag-groups))))