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

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:
David Thompson 2015-08-06 08:55:20 -04:00
parent 97e31d42d2
commit 9b3f82e5fa
1 changed files with 19 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
haunt/builder/blog.scm
View File

@ -23,6 +23,7 @@
;;; Code:
(define-module (haunt builder blog)
#:use-module (ice-9 match)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-19)
#:use-module (haunt site)
@ -42,19 +43,19 @@
blog))
(define-record-type <theme>
(make-theme name layout post-template list-template)
(make-theme name layout post-template collection-template)
theme?
(name theme-name)
(layout theme-layout)
(post-template theme-post-template)
(list-template theme-list-template))
(collection-template theme-collection-template))
(define* (theme #:key
(name "Untitled")
layout
post-template
list-template)
(make-theme name layout post-template list-template))
collection-template)
(make-theme name layout post-template collection-template))
(define (with-layout theme site title body)
((theme-layout theme) site title body))
@ -64,8 +65,8 @@
(body ((theme-post-template theme) post)))
(with-layout theme site title body)))
(define (render-list theme site title posts prefix)
(let ((body ((theme-list-template theme) site title posts prefix)))
(define (render-collection theme site title posts prefix)
(let ((body ((theme-collection-template theme) site title posts prefix)))
(with-layout theme site title body)))
(define (date->string* date)
@ -89,7 +90,7 @@
(h3 "by " ,(post-ref post 'author)
" — " ,(date->string* (post-date post)))
(div ,(post-sxml post))))
#:list-template
#:collection-template
(lambda (site title posts prefix)
(define (post-uri post)
(string-append "/" (or prefix "")
@ -105,7 +106,9 @@
,(date->string* (post-date post)))))
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
decorated by THEME, whose URLs start with PREFIX."
(define (make-file-name base-name)
@ -121,11 +124,12 @@ decorated by THEME, whose URLs start with PREFIX."
(render-post theme site post)
sxml->html)))
(define index-page
(make-page (make-file-name "index.html")
(render-list theme site "Recent Posts"
(posts/reverse-chronological posts)
prefix)
sxml->html))
(define collection->page
(match-lambda
((title file-name filter)
(make-page (make-file-name file-name)
(render-collection theme site title (filter posts) prefix)
sxml->html))))
(cons index-page (map post->page posts))))
(append (map post->page posts)
(map collection->page collections))))