44c00f60daabeca9650a23729aa8e30feb48509c
[~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 ,(date->string (post-date post)
68 my-date-format)))))
69 posts)))))
70
71 (define (my-post-template post)
72 `((header
73 (h1 ,(post-ref post 'title))
74 (address "By " ,(aa (post-ref post 'author) "/")
75 " <" ,(post-ref post 'email) ">")
76 (p (@ (class "date"))
77 "Published "
78 ,(date->string (post-date post) my-date-format))
79 ,(if (post-ref post 'updated)
80 `(p (@ (class "updated"))
81 "Updated "
82 ,(date->string (post-ref post 'updated)
83 my-date-format)) '())
84 ,(if (post-ref post 'tags)
85 `(p (@ (class "tags"))
86 "Tagged "
87 ,@(intersperse
88 (map (lambda (tag)
89 (aa tag (tag-uri my-tag-prefix tag)))
90 (post-ref post 'tags))
91 ", "))
92 '()))
93 ,(post-sxml post)
94 (p (@ (class "muted inbox"))
95 "Have a question or comment? Start a discussion in my "
96 ,(aa "public inbox" "https://lists.sr.ht/~bandali/public-inbox")
97 " by sending an email to "
98 ,(aa "~bandali/public-inbox@lists.sr.ht"
99 "mailto:~bandali/public-inbox@lists.sr.ht")
100 (small
101 " [" ,(aa "mailing list etiquette"
102 "https://man.sr.ht/lists.sr.ht/etiquette.md") "]")
103 ".")))
104
105 (define* (my-collection-template site title posts prefix
106 #:optional all-posts tag)
107 `((h2 ,title
108 ,(if tag
109 (aa `(img (@ (class "feed-icon-h2")
110 (src "/icon-16px.png")
111 (alt "subscribe to atom feed")))
112 (tag-uri my-tag-prefix tag ".xml"))
113 '()))
114 ,(post-list-table site posts prefix)
115 (h2 (@ (id "tags")) "Tags")
116 ,(tag-links (or all-posts posts))
117 ,(if tag
118 '(a (@ (href "/notes.html"))
119 "← all notes")
120 '())))
121
122 (define bandali-theme
123 (theme #:name "bandali"
124 #:layout
125 (lambda (site title body)
126 (base-layout site body
127 #:title title))
128 #:post-template my-post-template
129 #:collection-template my-collection-template))
130
131 (module-define!
132 (resolve-module '(haunt builder blog))
133 'render-post
134 (lambda (theme site post)
135 (let ((title (post-ref post 'title))
136 (body ((theme-post-template theme) post))
137 (copy (post-ref post 'copyright)))
138 (base-layout site body #:title title #:copy copy))))
139
140 (register-metadata-parser! 'updated string->date*)