e2b2375bd1b15313ac29b29c83a6d2181cc5ee73
[~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 ,@(intersperse
95 (map (lambda (tag)
96 (aa tag (tag-uri my-tag-prefix tag)
97 "Notes tagged ‘" tag "’"))
98 (post-ref post 'tags))
99 ", "))
100 '()))
101 ,(post-sxml post)
102 (p (@ (class "muted inbox"))
103 "Got a question or comment? Write to me at my email address "
104 "at the top of this page!")))
105
106 (define* (my-collection-template site title posts prefix
107 #:optional all-posts tag)
108 `((h2 ,title
109 ,(if tag
110 (aa `(img (@ (class "feed-icon-h2")
111 (src "/icon-16px.png")
112 (alt "subscribe to atom feed")))
113 (tag-uri my-tag-prefix tag ".xml"))
114 '()))
115 ,(post-list-table site posts prefix)
116 (h2 (@ (id "tags")) "Tags")
117 ,(tag-links (or all-posts posts))
118 ,(if tag
119 '(a (@ (href "/notes.html"))
120 "← all notes")
121 '())))
122
123 (define bandali-theme
124 (theme #:name "bandali"
125 #:layout
126 (lambda (site title body)
127 (base-layout site body
128 #:title title))
129 #:post-template my-post-template
130 #:collection-template my-collection-template))
131
132 (module-define!
133 (resolve-module '(haunt builder blog))
134 'render-post
135 (lambda (theme site post)
136 (let ((title (post-ref post 'title))
137 (body ((theme-post-template theme) post))
138 (copy (post-ref post 'copyright)))
139 (base-layout site body #:title title #:copy copy))))
140
141 (register-metadata-parser! 'updated string->date*)