break haunt.scm down into smaller (bandali *) modules
[~bandali/bndl.org] / bandali / theme.scm
1 ;;; Copyright © 2019 Amin Bandali <bandali@gnu.org>
2 ;;;
3 ;;; This program is free software; you can redistribute it and/or
4 ;;; modify it under the terms of the GNU General Public License as
5 ;;; published by the Free Software Foundation; either version 3 of the
6 ;;; License, or (at your option) any later version.
7 ;;;
8 ;;; This program is distributed in the hope that it will be useful,
9 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
10 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
11 ;;; General Public License for more details.
12 ;;;
13 ;;; You should have received a copy of the GNU General Public License
14 ;;; along with this program. If not, see
15 ;;; <http://www.gnu.org/licenses/>.
16
17 (define-module (bandali theme)
18 #:use-module (bandali prefs) ; my-*
19 #:use-module (bandali tags) ; tag-*
20 #:use-module (bandali utils)
21 #:use-module (haunt builder blog) ; theme
22 #:use-module (haunt post) ; post-*
23 #:use-module (haunt site) ; site-*
24 #:use-module (haunt utils) ; string->date*
25 #:use-module (srfi srfi-19)
26 #:export (base-layout
27 post-uri
28 post-list-table
29 bandali-theme))
30
31 (define* (base-layout site body #:key title copy license-page?)
32 `((doctype "html")
33 (html
34 (head
35 (meta (@ (charset "utf-8")))
36 (title ,(if title (string-append title " — " (site-title site))
37 "Amin Bandali’s Personal Site"))
38 ,(stylesheet "reset")
39 ,(stylesheet "style"))
40 (body
41 (main ,body)
42 (footer
43 (p "Copyright © "
44 ,(if copy copy "2016–2019")
45 " Amin Bandali. See "
46 ,(if license-page? "the above"
47 (aa "license.html" "/license.html"))
48 " for license conditions. Please copy and share."))))))
49
50 (define* (post-uri site post #:optional prefix)
51 (string-append (or prefix "") "/"
52 (site-post-slug site post) ".html"))
53
54 (define* (post-list-table site posts #:optional prefix)
55 `((table
56 (@ (class "post-list"))
57 (tbody
58 ,@(map
59 (lambda (post)
60 `(tr
61 (td ,(aa (post-ref post 'title)
62 (post-uri site post prefix)))
63 (td (small ,(date->string (post-date post)
64 my-date-format)))))
65 posts)))))
66
67 (define (my-post-template post)
68 `((header
69 (h1 ,(post-ref post 'title))
70 (address "By " ,(aa (post-ref post 'author) "/")
71 " <" ,(post-ref post 'email) ">")
72 (p (@ (class "date"))
73 "Published "
74 ,(date->string (post-date post) my-date-format))
75 ,(if (post-ref post 'updated)
76 `(p (@ (class "updated"))
77 "Updated "
78 ,(date->string (post-ref post 'updated)
79 my-date-format)) '())
80 ,(if (post-ref post 'tags)
81 `(p (@ (class "tags"))
82 "Tagged "
83 ,@(intersperse
84 (map (lambda (tag)
85 (aa tag (tag-uri my-tag-prefix tag)))
86 (post-ref post 'tags))
87 ", "))
88 '()))
89 ,(post-sxml post)
90 (p (@ (class "muted inbox"))
91 "Have a question or comment? Start a discussion in my "
92 ,(aa "public inbox" "https://lists.sr.ht/~bandali/public-inbox")
93 " by sending an email to "
94 ,(aa "~bandali/public-inbox@lists.sr.ht"
95 "mailto:~bandali/public-inbox@lists.sr.ht")
96 (small
97 " [" ,(aa "mailing list etiquette"
98 "https://man.sr.ht/lists.sr.ht/etiquette.md") "]")
99 ".")))
100
101 (define* (my-collection-template site title posts prefix
102 #:optional all-posts tag)
103 `((h2 ,title
104 ,(if tag
105 (aa `(img (@ (class "feed-icon-h2")
106 (src "/icon-16px.png")
107 (alt "subscribe to atom feed")))
108 (tag-uri my-tag-prefix tag ".xml"))
109 '()))
110 ,(post-list-table site posts prefix)
111 (h2 (@ (id "tags")) "Tags")
112 ,(tag-links (or all-posts posts))
113 ,(if tag
114 '(a (@ (href "/notes.html"))
115 "← all notes")
116 '())))
117
118 (define bandali-theme
119 (theme #:name "bandali"
120 #:layout
121 (lambda (site title body)
122 (base-layout site body
123 #:title title))
124 #:post-template my-post-template
125 #:collection-template my-collection-template))
126
127 (module-define!
128 (resolve-module '(haunt builder blog))
129 'render-post
130 (lambda (theme site post)
131 (let ((title (post-ref post 'title))
132 (body ((theme-post-template theme) post))
133 (copy (post-ref post 'copyright)))
134 (base-layout site body #:title title #:copy copy))))
135
136 (register-metadata-parser! 'updated string->date*)