builder: blog: Add concept of "collections".
Rather than having a hardcoded index page, a blog now accepts a variable number of "collection" tuples that describe the page title, file name, and the filter procedure for the posts that will appear on that page. * haunt/builder/blog.scm (<theme>) [list-template]: Delete. [collection-template]: New field. (theme-list-template): Delete. (theme-collection-template): New accessor. (make-theme): Replace #:list-template with #:collection-template. (render-list): Delete. (render-collection): New procedure. (ugly-theme): Use #:collection-template argument. (blog): Add #:collections argument.
This commit is contained in:
parent
97e31d42d2
commit
9b3f82e5fa
|
@ -23,6 +23,7 @@
|
||||||
;;; Code:
|
;;; Code:
|
||||||
|
|
||||||
(define-module (haunt builder blog)
|
(define-module (haunt builder blog)
|
||||||
|
#:use-module (ice-9 match)
|
||||||
#:use-module (srfi srfi-9)
|
#:use-module (srfi srfi-9)
|
||||||
#:use-module (srfi srfi-19)
|
#:use-module (srfi srfi-19)
|
||||||
#:use-module (haunt site)
|
#:use-module (haunt site)
|
||||||
|
@ -42,19 +43,19 @@
|
||||||
blog))
|
blog))
|
||||||
|
|
||||||
(define-record-type <theme>
|
(define-record-type <theme>
|
||||||
(make-theme name layout post-template list-template)
|
(make-theme name layout post-template collection-template)
|
||||||
theme?
|
theme?
|
||||||
(name theme-name)
|
(name theme-name)
|
||||||
(layout theme-layout)
|
(layout theme-layout)
|
||||||
(post-template theme-post-template)
|
(post-template theme-post-template)
|
||||||
(list-template theme-list-template))
|
(collection-template theme-collection-template))
|
||||||
|
|
||||||
(define* (theme #:key
|
(define* (theme #:key
|
||||||
(name "Untitled")
|
(name "Untitled")
|
||||||
layout
|
layout
|
||||||
post-template
|
post-template
|
||||||
list-template)
|
collection-template)
|
||||||
(make-theme name layout post-template list-template))
|
(make-theme name layout post-template collection-template))
|
||||||
|
|
||||||
(define (with-layout theme site title body)
|
(define (with-layout theme site title body)
|
||||||
((theme-layout theme) site title body))
|
((theme-layout theme) site title body))
|
||||||
|
@ -64,8 +65,8 @@
|
||||||
(body ((theme-post-template theme) post)))
|
(body ((theme-post-template theme) post)))
|
||||||
(with-layout theme site title body)))
|
(with-layout theme site title body)))
|
||||||
|
|
||||||
(define (render-list theme site title posts prefix)
|
(define (render-collection theme site title posts prefix)
|
||||||
(let ((body ((theme-list-template theme) site title posts prefix)))
|
(let ((body ((theme-collection-template theme) site title posts prefix)))
|
||||||
(with-layout theme site title body)))
|
(with-layout theme site title body)))
|
||||||
|
|
||||||
(define (date->string* date)
|
(define (date->string* date)
|
||||||
|
@ -89,7 +90,7 @@
|
||||||
(h3 "by " ,(post-ref post 'author)
|
(h3 "by " ,(post-ref post 'author)
|
||||||
" — " ,(date->string* (post-date post)))
|
" — " ,(date->string* (post-date post)))
|
||||||
(div ,(post-sxml post))))
|
(div ,(post-sxml post))))
|
||||||
#:list-template
|
#:collection-template
|
||||||
(lambda (site title posts prefix)
|
(lambda (site title posts prefix)
|
||||||
(define (post-uri post)
|
(define (post-uri post)
|
||||||
(string-append "/" (or prefix "")
|
(string-append "/" (or prefix "")
|
||||||
|
@ -105,7 +106,9 @@
|
||||||
,(date->string* (post-date post)))))
|
,(date->string* (post-date post)))))
|
||||||
posts))))))
|
posts))))))
|
||||||
|
|
||||||
(define* (blog #:key (theme ugly-theme) prefix)
|
(define* (blog #:key (theme ugly-theme) prefix
|
||||||
|
(collections
|
||||||
|
`(("Recent Posts" "index.html" ,posts/reverse-chronological))))
|
||||||
"Return a procedure that transforms a list of posts into pages
|
"Return a procedure that transforms a list of posts into pages
|
||||||
decorated by THEME, whose URLs start with PREFIX."
|
decorated by THEME, whose URLs start with PREFIX."
|
||||||
(define (make-file-name base-name)
|
(define (make-file-name base-name)
|
||||||
|
@ -121,11 +124,12 @@ decorated by THEME, whose URLs start with PREFIX."
|
||||||
(render-post theme site post)
|
(render-post theme site post)
|
||||||
sxml->html)))
|
sxml->html)))
|
||||||
|
|
||||||
(define index-page
|
(define collection->page
|
||||||
(make-page (make-file-name "index.html")
|
(match-lambda
|
||||||
(render-list theme site "Recent Posts"
|
((title file-name filter)
|
||||||
(posts/reverse-chronological posts)
|
(make-page (make-file-name file-name)
|
||||||
prefix)
|
(render-collection theme site title (filter posts) prefix)
|
||||||
sxml->html))
|
sxml->html))))
|
||||||
|
|
||||||
(cons index-page (map post->page posts))))
|
(append (map post->page posts)
|
||||||
|
(map collection->page collections))))
|
||||||
|
|
Loading…
Reference in New Issue