about summary refs log tree commit diff stats
path: root/wikme-impl.scm
diff options
context:
space:
mode:
authorCase Duckworth2023-04-03 22:07:04 -0500
committerCase Duckworth2023-04-03 22:07:04 -0500
commita1cde11d5ebe95a365120eb5aeb7f65469e44b30 (patch)
treeecc91700447039733daebc04a6581dd01b92e7ed /wikme-impl.scm
parentIt builds now (diff)
downloadwikme-a1cde11d5ebe95a365120eb5aeb7f65469e44b30.tar.gz
wikme-a1cde11d5ebe95a365120eb5aeb7f65469e44b30.zip
Changes and stuff
I have done a bad job of documenting what I'm doing

- it builds now - run `make`
- it builds the pages in test/ and links them
- ... that's it
Diffstat (limited to 'wikme-impl.scm')
-rw-r--r--wikme-impl.scm290
1 files changed, 0 insertions, 290 deletions
diff --git a/wikme-impl.scm b/wikme-impl.scm deleted file mode 100644 index 2097af7..0000000 --- a/wikme-impl.scm +++ /dev/null
@@ -1,290 +0,0 @@
1;;; Wikme --- convert a directory of markdown files into a static wiki
2
3(import (chicken file)
4 (chicken file posix)
5 (chicken format)
6 (chicken io)
7 (chicken irregex)
8 (chicken pathname)
9 (chicken port)
10 (chicken process)
11 (chicken process-context)
12 (chicken string)
13 (chicken time posix)
14 (cmark)
15 (regex) ; XXX: deprecated upstream
16 (srfi-13))
17
18;;; Records
19
20(define-record-type <wiki>
21 ;;; A wiki is a collection of pages and assorted metadata.
22 (make-wiki base-url ; base URL for links
23 origin-dir ; origin directory
24 destination-dir ; destination directory
25 pages ; list of <page>s
26 defaults ; alist of default properties for pages
27 )
28 wiki?
29 (base-url wiki-base-url (setter wiki-base-url))
30 (origin-dir wiki-origin-dir (setter wiki-origin-dir))
31 (destination-dir wiki-destination-dir (setter wiki-destination-dir))
32 (pages wiki-pages (setter wiki-pages))
33 (defaults wiki-defaults (setter wiki-defaults)))
34
35(define (wiki-default-ref wiki key)
36 (alist-ref key (wiki-defaults wiki)))
37
38(define (wiki-default-set! wiki key value)
39 (set! (wiki-defaults wiki) (cons (cons key value)
40 (wiki-defaults wiki))))
41
42(define-record-type <page>
43 ;;; A wiki page is a mapping between source and body content, and between the
44 ;;; page's origin and its destination files, wrapped together with some
45 ;;; metadata.
46 (make-page source ; source markup
47 body ; rendered page body
48 origin ; source filename (relative to wiki)
49 destination ; destination file (relative to wiki)
50 template ; this page's template
51 source-transformers ; list of source transformer functions
52 path-transformers ; list of path transformers
53 wiki ; the <wiki> this page is a part of
54 meta ; alist of metadata tags
55 )
56 page?
57 (source page-source (setter page-source))
58 (body page-body (setter page-body))
59 (origin page-origin (setter page-origin))
60 (destination page-destination (setter page-destination))
61 (template page-template (setter page-template))
62 (source-transformers page-source-transformers (setter page-source-transformers))
63 (path-transformers page-path-transformers (setter page-path-transformers))
64 (wiki page-wiki (setter page-wiki))
65 (meta page-meta (setter page-meta)))
66
67(define (page-meta-ref page key)
68 ;;; Get metadata KEY from PAGE.
69 (alist-ref key (page-meta page)))
70
71(define (page-meta-set! page key value)
72 ;;; Set KEY in PAGE's metadata to VALUE.
73 (set! (page-meta page) (cons (cons key value)
74 (page-meta page))))
75
76;;; Transformers
77
78(define (transform page input transformers)
79 (let loop ((ts transformers)
80 (it input))
81 (if (null? ts)
82 it
83 (loop (cdr ts)
84 ;; This is ugly but I need it for some things (namely, `indexify').
85 ;; Transformers can add an #!optional _ parameter to ignore it.
86 ((car ts) it page)))))
87
88(define (transform-source! page)
89 ;;; Transform PAGE's source to html.
90 ;; Passes page-source through each of page-transformers in order and sets
91 ;; page-body to the result.
92 (set! (page-body page)
93 (transform page (page-source page) (page-source-transformers page))))
94
95(define (transform-path! page)
96 ;;; Transform PAGE's path from input directory to output directory.
97 ;; This will take the page-origin and transform it using
98 ;; page-path-transformers. It will then set page-destination to the result.
99 (set! (page-destination page)
100 (transform page (page-origin page) (page-path-transformers page))))
101
102;; Cmark wrapper
103(define (page-cmark->html input #!optional page)
104 (cmark->html input (page-meta-ref page 'safe)))
105
106;;; Templates
107
108(define (render-template template env)
109 ;;; Render TEMPLATE using ENV.
110 ;; TEMPLATE is a string with {{placeholders}}; ENV is an alist of key-value
111 ;; pairs to insert into the TEMPLATE's placeholders.
112 ;; XXX: Depends on the deprecated library (regex) which is just glue around
113 ;; irregex (apparently).
114 (string-substitute* template (env->replacements env)))
115
116(define (env->replacements env)
117 ;;; Convert an ENV alist of the form `((X . Y) ...) to '(("{{X}}" . "Y") ...).
118 ;; X's are template variables and Y's are the values of those variables. In
119 ;; the template, both "{{X}}" and "{{ X }}" will be replaced.
120 ;; If Y is a thunk, call it.
121 (let loop ((env env)
122 (res '()))
123 (if (null? env)
124 res
125 (let* ((this (car env))
126 (rest (cdr env))
127 (key (->string (car this)))
128 (val (if (procedure? (cdr this))
129 ((cdr this))
130 (->string (cdr this)))))
131 (loop (cdr env)
132 (append (list (cons (sprintf "{{~a}}" key) val)
133 (cons (sprintf "{{ ~a }}" key) val))
134 res))))))
135
136(define (render page)
137 (render-template (page-template page)
138 (append `((source . ,(page-source page))
139 (body . ,(page-body page))
140 (origin . ,(page-origin page))
141 (destination . ,(page-destination page)))
142 (page-meta page))))
143
144;;; Links
145
146(define wiki-link-sre
147 ;;; An SRE for [[wiki-style links|with optional titles]].
148 '(: "[["
149 (submatch-named pname (+ (~ "|")))
150 (? (submatch "|" (submatch-named ptitle (*? nonl))))
151 "]]"))
152
153(define (wikify-links text #!optional page)
154 ;;; Convert [[Wiki-style links]] to <a> tags in TEXT.
155 ;; The base url of PAGE's wiki is prepended to the generated links.
156 (irregex-replace/all wiki-link-sre
157 text
158 (lambda (m)
159 (let* ((pname (irregex-match-substring m 'pname))
160 (ptitle (or (irregex-match-substring m 'ptitle)
161 pname)))
162 (sprintf "<a href=\"~a\">~a</a>"
163 (linkify pname
164 (if page
165 (wiki-base-url
166 (page-wiki page))
167 ""))
168 ptitle)))))
169
170(define (linkify pagename base-url)
171 ;;; Turn a page name into a link suitable for an <a> tag.
172 (make-pathname (list base-url (slugify pagename))
173 "index"
174 "html"))
175
176(define (slugify str)
177 ;;; Convert STR to a 'slug', that is, another string suitable for linking.
178 ;; This function will return the input string, in sentence case, and with all
179 ;; punctuation and spaces converted to a hypen.
180 (string-capitalize
181 (string-trim-both (irregex-replace/all '(+ (~ alnum)) str "-")
182 (lambda (c)
183 (char=? c #\-)))))
184
185(define (string-capitalize str)
186 ;;; Capitalize the first word in STR, and ensure the rest of it is lowercase.
187 ;; Returns the new string.
188 (let loop ((cs (string->list str))
189 (it #f))
190 (if (null? cs)
191 (reverse-list->string it)
192 (loop (cdr cs)
193 (if it
194 (cons (char-downcase (car cs)) it)
195 (list (char-upcase (car cs))))))))
196
197(define (unslugify str)
198 ;;; Convert a SLUG back into a normal string as best as possible.
199 ;; Because information is lost in slugification, it's impossible to be sure
200 ;; that the result of this procedure is totally accurate. That is,
201 ;; slugification is not round-trippable.
202 (irregex-replace/all "-" str " "))
203
204(define (path-relativize path dir)
205 ;;; Return PATH relative to DIR.
206 ;; Currently, this doesn't do anything special if PATH begins with / or ~ ...
207 ;; it probably should.
208 (let ((path (normalize-pathname path))
209 (dir (normalize-pathname dir)))
210 (make-pathname
211 dir
212 (string-trim (string-drop path (string-prefix-length path dir))
213 (lambda (c) (char=? c #\/))))))
214
215;;; Build a page
216
217(define (file->page file wiki
218 #!key
219 (source
220 (with-input-from-file file read-string))
221 (template
222 (wiki-default-ref wiki 'template))
223 (source-transformers
224 (wiki-default-ref wiki 'source-transformers))
225 (path-transformers
226 (wiki-default-ref wiki 'path-transformers)))
227 (let ((page (make-page source
228 #f
229 (path-relativize file (wiki-origin-dir wiki))
230 #f
231 (with-input-from-file template read-string)
232 source-transformers
233 path-transformers
234 wiki
235 '())))
236 (transform-source! page)
237 (page-meta-set! page 'title (guess-title page))
238 (page-meta-set! page 'last-updated (guess-last-updated page))
239 (transform-path! page)
240 (set! (wiki-pages wiki) (cons page (wiki-pages wiki)))
241 page))
242
243(define (guess-title page)
244 ;;; Guess the title from PAGE.
245 ;; If the first line is a Markdown H1 ("# ..."), use that as the title.
246 ;; Otherwise, unslugify the basename of the PAGE file to use as the title.
247 (let* ((str (page-body page))
248 (m (irregex-match '(: "#" (* whitespace) ($ (* nonl)) (* any))
249 str)))
250 (if (irregex-match-data? m)
251 (irregex-match-substring m 1)
252 (unslugify (basename (page-origin page))))))
253
254(define (basename file)
255 (receive (_ base _) (decompose-pathname file)
256 base))
257
258(define (indexify _origin page)
259 ;;; Transform a PAGE's filename from a markdown source to an html destination.
260 (make-pathname (slugify (page-meta-ref page 'title))
261 "index"
262 "html"))
263
264(define (guess-last-updated page)
265 ;;; Guess when PAGE was last edited.
266 ;; Tries to use git, but falls back to mtime.
267 (let ((f (path-relativize (page-origin page)
268 (wiki-origin-dir (page-wiki page)))))
269 (time->string
270 (seconds->local-time
271 (or #;
272 (string->number
273 (string-trim-both
274 (with-input-from-pipe
275 (sprintf "git log -1 --format=%ct --date=unix -C ~s ~s"
276 (wiki-origin-dir (page-wiki page))
277 f)
278 read-string)))
279 (file-modification-time f))))))
280
281(define (page->file page)
282 ;;; Write PAGE to its destination file.
283 (let ((dest (make-pathname (wiki-destination-dir (page-wiki page))
284 (page-destination page))))
285 (receive (dir _ _) (decompose-pathname dest)
286 (create-directory dir 'parents))
287 (with-output-to-file dest
288 (lambda ()
289 (write-string (render page))))))
290