d6e4ef2f901d2f315a9baeb255eab0eb5b3f20d9
[~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 (meta (@ (name "viewport")
37 (content "width=device-width, initial-scale=1")))
38 (title ,(if title (string-append title " — " (site-title site))
39 "Amin Bandali’s Personal Site"))
40 (link (@ (rel "icon")
41 (href "/gnu.ico")))
42 ,(stylesheet "reset")
43 ,(stylesheet "style"))
44 (body
45 (main ,body)
46 (footer
47 (p "Copyright © "
48 ,(if copy copy "2016–2019")
49 " Amin Bandali. See "
50 ,(if license-page? "the above"
51 (aa "license.html" "/license.html"))
52 " for license conditions. Please copy and share."))))))
53
54 (define* (post-uri site post #:optional prefix)
55 (string-append (or prefix "") "/"
56 (site-post-slug site post) ".html"))
57
58 (define* (post-list-table site posts #:optional prefix)
59 `((table
60 (@ (class "post-list"))
61 (tbody
62 ,@(map
63 (lambda (post)
64 `(tr
65 (td ,(aa (post-ref post 'title)
66 (post-uri site post prefix)))
67 (td (small (@ (title
68 ,(date->string (post-date post)
69 my-secondary-date-format)))
70 ,(date->string (post-date post)
71 my-primary-date-format)))))
72 posts)))))
73
74 (define (my-post-template post)
75 `((header
76 (h1 ,(post-ref post 'title))
77 (address "By " ,(aa (post-ref post 'author) "/")
78 " <" ,(post-ref post 'email) ">")
79 (p (@ (class "date"))
80 (span (@ (title ,(date->string (post-date post)
81 my-secondary-date-format)))
82 ,(date->string (post-date post)
83 my-primary-date-format))
84 ,(if (post-ref post 'updated)
85 `(" (updated on "
86 (span (@ (title
87 ,(date->string (post-ref post 'updated)
88 my-secondary-date-format)))
89 ,(date->string (post-ref post 'updated)
90 my-primary-date-format))
91 ")") '()))
92 ,(if (post-ref post 'tags)
93 `(p (@ (class "tags"))
94 "Tagged "
95 ,@(intersperse
96 (map (lambda (tag)
97 (aa tag (tag-uri my-tag-prefix tag)))
98 (post-ref post 'tags))
99 ", "))
100 '()))
101 ,(post-sxml post)
102 (p (@ (class "muted inbox"))
103 "Have a question or comment? Start a discussion in my "
104 ,(aa "public inbox" "https://lists.sr.ht/~bandali/public-inbox")
105 " by sending an email to "
106 ,(aa "~bandali/public-inbox@lists.sr.ht"
107 "mailto:~bandali/public-inbox@lists.sr.ht")
108 (small
109 " [" ,(aa "mailing list etiquette"
110 "https://man.sr.ht/lists.sr.ht/etiquette.md") "]")
111 ".")))
112
113 (define* (my-collection-template site title posts prefix
114 #:optional all-posts tag)
115 `((h2 ,title
116 ,(if tag
117 (aa `(img (@ (class "feed-icon-h2")
118 (src "/icon-16px.png")
119 (alt "subscribe to atom feed")))
120 (tag-uri my-tag-prefix tag ".xml"))
121 '()))
122 ,(post-list-table site posts prefix)
123 (h2 (@ (id "tags")) "Tags")
124 ,(tag-links (or all-posts posts))
125 ,(if tag
126 '(a (@ (href "/notes.html"))
127 "← all notes")
128 '())))
129
130 (define bandali-theme
131 (theme #:name "bandali"
132 #:layout
133 (lambda (site title body)
134 (base-layout site body
135 #:title title))
136 #:post-template my-post-template
137 #:collection-template my-collection-template))
138
139 (module-define!
140 (resolve-module '(haunt builder blog))
141 'render-post
142 (lambda (theme site post)
143 (let ((title (post-ref post 'title))
144 (body ((theme-post-template theme) post))
145 (copy (post-ref post 'copyright)))
146 (base-layout site body #:title title #:copy copy))))
147
148 (register-metadata-parser! 'updated string->date*)