1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
|
(define-module (theme)
#:use-module (haunt html)
#:use-module (haunt site)
#:use-module (haunt post)
#:use-module (haunt builder blog)
#:use-module (sxml xpath)
#:export (hwebs-theme-blog
hwebs-theme-now
flat-page-template))
(define (post-uri post site prefix)
(string-append "/" (or prefix "") "/"
(site-post-slug site post) ".html"))
;;
;; BLOG
;;
(define layout
(lambda (site title body)
`((doctype "html")
(html
(@ (lang "en"))
(head
(meta (@ (http-equiv "Content-Type")
(content "text/html")
(charset "utf-8")))
(meta (@ (name "viewport")
(content "width=device-width, initial-scale=1.0")))
(meta (@ (name "color-scheme")
(content "light dark")))
(link (@ (rel "stylesheet")
(href "/style.css")))
(link (@ (rel "icon")
(href "data:,")))
(title ,(string-append title " — " (site-title site))))
(body
(header (div ,(assq-ref (site-default-metadata site) 'author))
(nav (ul (li (a (@ (href "/")) "Home"))
(li (a (@ (href "/now")) "Now"))
(li (a (@ (href "/blog")) "Blog")))))
(main
(article (h1 ,title)
,body)))))))
(define hwebs-theme-blog
(theme #:name "hwebs"
#:layout layout
#:post-template
(lambda (post)
;; TODO fill in datetime correctly
;; TODO add <author>? (as hidden?)
`((time ,(date->string*(post-date post)))
,(post-sxml post)))
#:collection-template
(lambda (site title posts prefix)
`((p (a (@ (href "/blog/feed.xml")) "Atom feed."))
(ul
,@(map (lambda (post)
`(li (a (@ (href ,(post-uri post site prefix)))
,(post-ref post 'title)
" — "
,(date->string* (post-date post)))))
posts))))))
(define (flat-page-template site metadata body)
((theme-layout hwebs-theme-blog) site (assq-ref metadata 'title) body))
;;
;; NOW
;;
(define (rss-items-template items)
`(ul
,@(map (lambda (item)
`(li ,item))
items)))
(define (rss-items post)
((sxpath '(rss channel item title *text*)) (post-sxml post)))
(define hwebs-theme-now
(theme #:name "hwebs-now"
#:layout layout
#:post-template
(compose rss-items-template rss-items)
#:collection-template
(lambda (site title posts prefix)
`((p "My implementation of the "
(a (@ (href "https://nownownow.com/about")) "\"now page\" concept by Derek Sivers")
".")
,@(map (lambda (post)
(define items
(rss-items post))
(if (member "feed" (post-tags post))
;; TODO use dates from the feed for these as well? - most recent pubDate?
;; TODO combine structure between the two types
`(section (h2 ,(post-ref post 'title))
,(rss-items-template
;; not optimal, btw
(list-head items (min 5 (length items))))
;; TODO only show if there are more entries than max?
(p (a (@ (href ,(post-uri post site prefix))) "See more.")))
`(section (h2 ,(post-ref post 'title))
;; TODO fill in datetime correctly
((header "updated " (time ,(date->string*(post-date post))))
,(post-sxml post)))))
posts)))))
|
