haunt.scm (11404B)
1 (import (srfi srfi-1) 2 (srfi srfi-19) 3 4 (ice-9 pretty-print) 5 (ice-9 regex) 6 7 (sxml simple) 8 9 (haunt artifact) 10 (haunt asset) 11 (haunt builder assets) 12 (haunt builder atom) 13 (haunt builder blog) 14 (haunt html) 15 (haunt page) 16 (haunt post) 17 (haunt reader commonmark) 18 (haunt reader) 19 (haunt site) 20 21 (json) 22 23 (prefix (kakafarm index) kakafarm:index:) 24 (prefix (kakafarm software clipboard-speaker) 25 kakafarm:software:clipboard-speaker:) 26 (prefix (kakafarm software diceware) kakafarm:software:diceware:) 27 (prefix (kakafarm software) kakafarm:software:)) 28 29 (define (dp a) 30 (pretty-print a) a) 31 32 (define (pp attribute record) 33 (pretty-print (list attribute 34 (attribute record)))) 35 36 (define site-title-prefix 37 "💩 Kaka Farm! 💩") 38 39 (define site-header 40 `(h1 (img (@ (src "/images/logo.png") 41 (alt "A superflat vector drawing of a ceramic throne."))) 42 "Kaka Farm!")) 43 44 (define haunt-footer 45 '(footer (div "Webrings!" 46 (div (@ (class "craftering")) 47 (a (@ (href 48 "https://craftering.systemcrafters.net/@cow_2001/previous")) 49 ←) 50 (a (@ (href "https://craftering.systemcrafters.net/")) 51 craftering) 52 (a (@ (href 53 "https://craftering.systemcrafters.net/@cow_2001/next")) 54 →))) 55 (p "Built with " 56 (a (@ (href "https://dthompson.us/projects/haunt.html")) 57 "David Thompson's Haunt") 58 ", a " 59 (a (@ (href "https://www.gnu.org/software/guile/")) "GNU Guile") 60 " Static Site Generator. Source code for the site can be found in my " 61 (a (@ (href "https://kaka.farm/~stagit/kaka.farm/log.html")) 62 "Stagit") 63 ", " 64 (a (@ (href "https://codeberg.org/kakafarm/kaka.farm")) "Codeberg") 65 ", or " 66 (a (@ (href "https://git.sr.ht/~kakafarm/kaka.farm/")) 67 "Source Hut") 68 ". Find more sites written with Haunt at " 69 (a (@ (href "https://awesome.haunt.page/")) "Awesome Haunt") 70 "!"))) 71 72 (define (make-favicon-asset) 73 (make-asset "assets/logo.png" "/favicon.ico")) 74 75 (define (post->sxml-link post) 76 `(a (@ (href ,(string-append (post-slug-v2 post) ".html"))) 77 ,(date->string (time-utc->date (date->time-utc (post-date post)) 0) "~4") 78 " - " 79 ,(cdr (assq 'title 80 (post-metadata post))))) 81 82 (define extension-regexp 83 (make-regexp "(\\.\\w+)$")) 84 85 (define* (make-haunt-blog-index-sxml #:key site posts) 86 (let ((five-last-posts (take (posts/reverse-chronological posts) 87 (min (length posts) 5)))) 88 `(div (h2 "Kakafarm's Haunt") 89 (ul (li (a (@ (href "/haunt/posts/")) "posts")) 90 (li (a (@ (href "/haunt/feed.xml")) "atom feed")))))) 91 92 (define* (haunt-blog-index-page-builder #:key destination make-sxml theme) 93 (lambda (site posts) 94 (serialized-artifact destination 95 ((theme-layout theme) 96 "" site-title-prefix 97 (make-sxml #:posts posts)) sxml->html))) 98 99 (define* (page-builder #:key destination make-sxml theme) 100 (lambda (site posts) 101 (serialized-artifact destination 102 ((theme-layout theme) 103 "" site-title-prefix 104 (make-sxml #:posts posts)) sxml->html))) 105 106 (define* (json-page-builder #:key destination make-scm) 107 (lambda (site posts) 108 (serialized-artifact destination 109 (make-scm) scm->json))) 110 111 (define creative-commons-copyright-notice 112 '(p (@ (xmlns:cc "http://creativecommons.org/ns#") 113 (xmlns:dct "http://purl.org/dc/terms/")) 114 (a (@ (property "dct:title") 115 (rel "cc:attributionURL") 116 (href "https://kaka.farm/")) "Kaka Farm") 117 " by " 118 (a (@ (rel "cc:attributionURL dct:creator") 119 (property "cc:attributionName") 120 (href "https://kaka.farm/")) "Yuval Langer") 121 " is licensed under " 122 (a (@ (href 123 "http://creativecommons.org/licenses/by-sa/4.0/?ref=chooser-v1") 124 (target "_blank") 125 (rel "license noopener noreferrer") 126 (style "display:inline-block;")) 127 " Attribution-ShareAlike 4.0 International " 128 (img (@ (style 129 "height:22px!important;margin-left:3px;vertical-align:text-bottom;") 130 (src 131 "https://mirrors.creativecommons.org/presskit/icons/cc.svg?ref=chooser-v1") 132 (alt ""))) 133 (img (@ (style 134 "height:22px!important;margin-left:3px;vertical-align:text-bottom;") 135 (src 136 "https://mirrors.creativecommons.org/presskit/icons/by.svg?ref=chooser-v1") 137 (alt ""))) 138 (img (@ (style 139 "height:22px!important;margin-left:3px;vertical-align:text-bottom;") 140 (src 141 "https://mirrors.creativecommons.org/presskit/icons/sa.svg?ref=chooser-v1") 142 (alt "")))))) 143 144 (define (make-page an-sxml-tree title) 145 `((doctype "html") 146 (html (@ (lang "en")) 147 (head (meta (@ (charset "UTF-8"))) 148 (link (@ (rel "stylesheet") 149 (type "text/css") 150 (href "/assets/index.css"))) 151 (title ,title)) 152 (body (div (@ (id "topmostdiv")) 153 ,site-header 154 ,an-sxml-tree 155 ,haunt-footer 156 ,creative-commons-copyright-notice))))) 157 158 (define (format-date-as-iso-8601-utc date) 159 (let* ((time-utc (date->time-utc date)) 160 (date-at-utc (time-utc->date time-utc 0))) 161 (date->string date-at-utc "~4"))) 162 163 (define (make-post-url url-prefix site post) 164 "Return a POST's full URL built from a URL-PREFIX string, a SITE object, and a POST object." 165 (string-append url-prefix 166 "/" 167 (site-post-slug site post) 168 ".html")) 169 170 (define blog-theme 171 (theme #:name "blog-theme" 172 #:layout (lambda (a-site a-page-title-string an-sxml-tree) 173 (make-page an-sxml-tree 174 (string-append site-title-prefix " -- " 175 a-page-title-string))) 176 #:post-template (lambda (a-post) 177 (post-sxml a-post)) 178 #:collection-template (lambda (a-site a-title-string a-list-of-posts 179 a-url-prefix-string) 180 `(ul ,(map (lambda (a-post) 181 (let* ((post-url (make-post-url a-url-prefix-string a-site a-post)) 182 (metadata (post-metadata 183 a-post)) 184 (title (cdr (assq 'title 185 metadata))) 186 (date (cdr (assq 'date 187 metadata))) 188 (date-string (format-date-as-iso-8601-utc 189 date))) 190 `(li (a (@ (href ,post-url)) 191 ,date-string " - " 192 ,title)))) 193 a-list-of-posts))) 194 #:pagination-template (lambda (a-site an-sxml-tree 195 the-file-name-of-the-previous-page 196 the-file-name-of-the-next-page) 197 `((div (a (@ (href ,the-file-name-of-the-previous-page)) 198 "previous page") 199 (a (@ (href ,the-file-name-of-the-next-page)) 200 "next page")) 201 (div ,an-sxml-tree))))) 202 203 (define topsite-theme 204 (theme #:name "topsite-theme" 205 #:layout (lambda (a-site a-page-title-string an-sxml-tree) 206 (make-page an-sxml-tree site-title-prefix)))) 207 208 (define (make-contribute.json-scm) 209 '((name . "Kaka Farm") (description . "Personal site.") 210 (repository (url . "https://codeberg.org/kakafarm/kaka.farm/") 211 (license . "AGPLv3+")) 212 (keywords . #(guile haunt)) 213 (irc . "irc://irc.libera.chat/#kakafarm") 214 (irc-contacts . #("cow_2001")))) 215 216 (site #:title site-title-prefix 217 #:domain "kaka.farm" 218 #:default-metadata '((author . "Yuval Langer") 219 (email . "yuval.langer@gmail.com")) 220 #:readers (list commonmark-reader sxml-reader) 221 #:builders (list (blog #:theme blog-theme 222 #:prefix "/haunt/posts" 223 #:collections `(("Recent Posts" 224 "/haunt/posts/index.html" 225 ,posts/reverse-chronological))) 226 (page-builder #:destination "/haunt/index.html" 227 #:make-sxml make-haunt-blog-index-sxml 228 #:theme blog-theme) 229 (page-builder #:destination "/index.html" 230 #:make-sxml 231 kakafarm:index:make-index-sxml 232 #:theme topsite-theme) 233 (page-builder #:destination "/software/index.html" 234 #:make-sxml kakafarm:software:make-sxml 235 #:theme topsite-theme) 236 (page-builder #:destination "/software/diceware.html" 237 #:make-sxml 238 kakafarm:software:diceware:make-sxml 239 #:theme topsite-theme) 240 (page-builder #:destination 241 "/software/clipboard-speaker.html" 242 #:make-sxml 243 kakafarm:software:clipboard-speaker:make-sxml 244 #:theme topsite-theme) 245 (json-page-builder #:destination "/contribute.json" 246 #:make-scm make-contribute.json-scm) 247 (atom-feed #:file-name "haunt/feed.xml" 248 #:blog-prefix "/haunt/posts") 249 (atom-feeds-by-tag #:prefix "/haunt/feeds" 250 #:blog-prefix "/haunt/feeds/") 251 (static-directory "assets" "assets") 252 (static-directory "images" "images") 253 (static-directory "dabbling/html" "dabbling")))