diff options
author | Case Duckworth | 2023-04-03 08:57:02 -0500 |
---|---|---|
committer | Case Duckworth | 2023-04-03 08:57:02 -0500 |
commit | 42474bb6c851314d804c89b1501b49eed0e6005f (patch) | |
tree | 81d7c77b1817ade3ca8c40d17c0b5c3672c319a8 /wikme-module.scm | |
parent | Reorganize (diff) | |
download | wikme-42474bb6c851314d804c89b1501b49eed0e6005f.tar.gz wikme-42474bb6c851314d804c89b1501b49eed0e6005f.zip |
It builds now
Diffstat (limited to 'wikme-module.scm')
-rw-r--r-- | wikme-module.scm | 275 |
1 files changed, 0 insertions, 275 deletions
diff --git a/wikme-module.scm b/wikme-module.scm deleted file mode 100644 index 14167d6..0000000 --- a/wikme-module.scm +++ /dev/null | |||
@@ -1,275 +0,0 @@ | |||
1 | ;;;; wikme --- build a static wiki out of a folder of markdown files | ||
2 | |||
3 | (import (cmark) | ||
4 | (srfi-152) | ||
5 | (utf8) | ||
6 | (chicken file) | ||
7 | (chicken file posix) | ||
8 | (chicken irregex) | ||
9 | (chicken pathname) | ||
10 | (chicken port) | ||
11 | (chicken process) | ||
12 | (chicken process-context) | ||
13 | (chicken string) | ||
14 | (chicken time posix)) | ||
15 | |||
16 | |||
17 | ;;; Wiki | ||
18 | |||
19 | (define-record-type <wiki> | ||
20 | ;;; A wiki is a collection of pages and assorted metadata. | ||
21 | (make-wiki base-url ; base URL for links | ||
22 | origin-dir ; origin directory | ||
23 | destination-dir ; destination directory | ||
24 | page-template ; template for pages | ||
25 | file-transformers ; list of filename transformers | ||
26 | transformers ; list of source transformer functions | ||
27 | pages ; list of <page>s | ||
28 | ) | ||
29 | wiki? | ||
30 | (base-url wiki-base-url (setter wiki-base-url)) | ||
31 | (origin-dir wiki-origin-dir (setter wiki-origin-dir)) | ||
32 | (destination-dir wiki-destination-dir (setter wiki-destination-dir)) | ||
33 | (page-template wiki-page-template (setter wiki-page-template)) | ||
34 | (file-transformers wiki-file-transformers (setter wiki-file-transformers)) | ||
35 | (transformers wiki-transformers (setter wiki-transformers)) | ||
36 | (pages wiki-pages (setter wiki-pages))) | ||
37 | |||
38 | (define (directory->wiki directory | ||
39 | #!key | ||
40 | base-url | ||
41 | destination-directory | ||
42 | page-template | ||
43 | (extension "md") | ||
44 | (file-transformers (list indexify)) | ||
45 | (transformers (list cmark->html wikify-links))) | ||
46 | ;;; Build a <wiki> out of the markdown files in DIRECTORY. | ||
47 | ;; The given keyword arguments will fill out the other fields in the result. | ||
48 | |||
49 | (define wiki | ||
50 | (make-wiki base-url | ||
51 | directory | ||
52 | destination-directory | ||
53 | page-template | ||
54 | file-transformers | ||
55 | transformers | ||
56 | '())) | ||
57 | |||
58 | (set! (wiki-pages wiki) | ||
59 | (map (lambda (f) (file->page f wiki)) | ||
60 | (glob (make-pathname directory "*.md")))) | ||
61 | |||
62 | wiki) | ||
63 | |||
64 | |||
65 | ;;; Pages | ||
66 | |||
67 | (define-record-type <page> | ||
68 | ;;; A wiki page is a mapping between source and body content, and between the | ||
69 | ;;; page's origin and its destination files, wrapped together with some | ||
70 | ;;; metadata. | ||
71 | (make-page source ; source markup | ||
72 | body ; rendered page body | ||
73 | origin ; file containing the markup | ||
74 | destination ; destination file | ||
75 | wiki ; the <wiki> this page is a part of | ||
76 | meta ; alist of metadata tags | ||
77 | ) | ||
78 | page? | ||
79 | (source page-source (setter page-source)) | ||
80 | (body page-body (setter page-source)) | ||
81 | (origin page-origin (setter page-origin)) | ||
82 | (destination page-destination (setter page-destination)) | ||
83 | (wiki page-wiki (setter page-wiki)) | ||
84 | (meta page-meta (setter page-meta))) | ||
85 | |||
86 | (define (page-meta-ref page key) | ||
87 | ;;; Get metadata KEY from PAGE. | ||
88 | (cdr (assq key (page-meta page)))) | ||
89 | |||
90 | (define (page-meta-set! page key value) | ||
91 | ;;; Set KEY in PAGE's metadata to VALUE. | ||
92 | (set! (page-meta page) (cons (cons key value) | ||
93 | (page-meta page)))) | ||
94 | |||
95 | (define (basename file) | ||
96 | (let-values (((_ base _) (decompose-pathname file))) | ||
97 | base)) | ||
98 | |||
99 | (define (indexify fname outdir) | ||
100 | ;;; Transform a FILENAME of the form ..dir/name.md to outdir/name/index.html. | ||
101 | (make-pathname (list outdir (basename fname)) "index" "html")) | ||
102 | |||
103 | (define (guess-title page) | ||
104 | ;;; Guess the title from PAGE. | ||
105 | ;; If the first line is a Markdown H1 ("# ..."), use that as the title. | ||
106 | ;; Otherwise, unslugify the basename of the PAGE file to use as the title. | ||
107 | (let* ((str (page-body page)) | ||
108 | (m (irregex-match '(: "#" (* whitespace) (submatch (nonl)) (* any)) | ||
109 | str))) | ||
110 | (if (irregex-match-data? m) | ||
111 | (irregex-match-substring m 1) | ||
112 | (unslugify (basename (page-origin page)))))) | ||
113 | |||
114 | (define (guess-last-updated page) | ||
115 | ;;; Guess when PAGE was last edited. | ||
116 | ;; Tries to use git, but falls back to mtime. | ||
117 | (let ((f (page-origin page))) | ||
118 | (time->string | ||
119 | (seconds->local-time | ||
120 | (or (string->number | ||
121 | (string-trim-both | ||
122 | (with-input-from-pipe | ||
123 | (string-join '("git" "log" "-1" "--format=%ct" "--date=unix" | ||
124 | "-C" (wiki-origin-dir (page-wiki page)) | ||
125 | f) | ||
126 | " ") | ||
127 | read-string))) | ||
128 | (file-modification-time f)))))) | ||
129 | |||
130 | (define (file->page file wiki) | ||
131 | ;;; Create a <page> from FILE in WIKI. | ||
132 | ;; Wraps make-page for easier use. | ||
133 | (define source | ||
134 | (with-input-from-file file read-string)) | ||
135 | (define page | ||
136 | (make-page source | ||
137 | (apply transform source (wiki-transformers wiki)) | ||
138 | file | ||
139 | (apply file-transform | ||
140 | file | ||
141 | (wiki-destination-dir wiki) | ||
142 | (wiki-file-transformers wiki)) | ||
143 | wiki | ||
144 | '())) | ||
145 | |||
146 | (page-meta-set! page 'title (guess-title page)) | ||
147 | (page-meta-set! page 'last-updated (guess-last-updated page)) | ||
148 | |||
149 | page) | ||
150 | |||
151 | |||
152 | ;;; Wiki links | ||
153 | |||
154 | (define wiki-link-sre | ||
155 | ;;; An SRE for [[wiki-style links|with optional titles]]. | ||
156 | '(: "[[" | ||
157 | (submatch-named page (+ (~ "|"))) | ||
158 | (? (submatch "|" (submatch-named title (*? nonl)))) | ||
159 | "]]")) | ||
160 | |||
161 | (define (wikify-links text) | ||
162 | ;;; Convert [[Wiki-style links]] to HTML style in TEXT. | ||
163 | (irregex-replace/all wiki-link-sre text | ||
164 | (lambda (m) | ||
165 | (let* ((page (irregex-match-substring m 'page)) | ||
166 | (title (or (irregex-match-substring m 'title) | ||
167 | page))) | ||
168 | (string-append | ||
169 | "<a href=\"" (linkify page) "\">" title "</a>"))))) | ||
170 | |||
171 | (define (linkify pagename) | ||
172 | ;;; Turn a page name into a link suitable for an <a> tag. | ||
173 | (string-append (base-url) "/" (slugify pagename) "/index.html")) | ||
174 | |||
175 | (define (string-capitalize str) | ||
176 | ;;; Capitalize the first word in STR, and ensure the rest of it is lowercase. | ||
177 | ;; Stolen and adapted from MIT/GNU Scheme | ||
178 | (let* ((end (string-length str)) | ||
179 | (str* (make-string end))) | ||
180 | (do ((i 0 (+ i 1))) | ||
181 | ((= i end)) | ||
182 | (string-set! str* i ((if (= i 0) char-upcase char-downcase) | ||
183 | (string-ref str i)))) | ||
184 | str*)) | ||
185 | |||
186 | (define (slugify str) | ||
187 | ;;; Convert STR to a 'slug', that is, another string suitable for linking. | ||
188 | ;; This function will return the input string, in sentence case, and with all | ||
189 | ;; punctuation and spaces converted to a hypen. | ||
190 | (string-capitalize | ||
191 | (string-trim-both (irregex-replace/all '(+ (~ alnum)) str "-") | ||
192 | (lambda (c) | ||
193 | (char=? c #\-))))) | ||
194 | |||
195 | (define (unslugify slug) | ||
196 | ;;; Convert a SLUG back into a normal string as best as possible. | ||
197 | ;; Because information is lost in slugification, it's impossible to be sure | ||
198 | ;; that the result of this procedure is totally accurate. That is, | ||
199 | ;; slugification is not round-trippable. | ||
200 | (irregex-replace/all '("-") slug " ")) | ||
201 | |||
202 | |||
203 | ;;; Transform source | ||
204 | |||
205 | (define (transform source . transformers) | ||
206 | ;;; Transform SOURCE to html by passing it through a series of TRANSFORMERS. | ||
207 | ;; Each TRANSFORMER should be a one-argument procedure taking and returning a | ||
208 | ;; string. | ||
209 | (let loop ((transformers transformers) | ||
210 | (output source)) | ||
211 | (if (null? transformers) | ||
212 | output | ||
213 | (loop (cdr transformers) | ||
214 | ((car transformers) output))))) | ||
215 | |||
216 | (define (file-transform origin destination-directory . transformers) | ||
217 | ;;; Transform ORIGIN to a DESTINATION filename using TRANSFORMERS. | ||
218 | ;; Each TRANSFORMER will be called with two arguments: the ORIGIN filaname and | ||
219 | ;; the DESTINATION-DIRECTORY. It should return the transformed filename. | ||
220 | (let loop ((transformers transformers) | ||
221 | (destination origin)) | ||
222 | (if (null? transformers) | ||
223 | destination | ||
224 | (loop (cdr transformers) | ||
225 | ((car transformers) origin destination-directory))))) | ||
226 | |||
227 | |||
228 | ;;; Templates | ||
229 | |||
230 | (define (render template env) | ||
231 | ;;; Render TEMPLATE using ENV. | ||
232 | ;; TEMPLATE is a string with {{placeholders}}; ENV is an alist of key-value | ||
233 | ;; pairs to insert into the TEMPLATE's placeholders. | ||
234 | (string-substitute* template (env->replacements env))) | ||
235 | |||
236 | (define (env->replacements env) | ||
237 | ;;; Convert an ENV alist of the form `((X . Y) ...) to '(("{{X}}" . "Y") ...). | ||
238 | ;; X's are template variables and Y's are the values of those variables. In | ||
239 | ;; the template, both "{{X}}" and "{{ X }}" will be replaced. | ||
240 | ;; If Y is a thunk, call it. | ||
241 | (let loop ((env env) | ||
242 | (res '())) | ||
243 | (if (null? env) | ||
244 | res | ||
245 | (let* ((this (car env)) | ||
246 | (rest (cdr env)) | ||
247 | (key (->string (car this))) | ||
248 | (val (if (procedure? (cdr this)) | ||
249 | ((cdr this)) | ||
250 | (->string (cdr this))))) | ||
251 | (loop (cdr env) | ||
252 | (append (list (cons (string-append "{{" key "}}") val) | ||
253 | (cons (string-append "{{ " key " }}") val)) | ||
254 | env)))))) | ||
255 | |||
256 | (define (render-page template page) | ||
257 | ;;; Render PAGE with its metadata using TEMPLATE. | ||
258 | (render template `((title . ,(page-meta-ref 'title page)) | ||
259 | (body . ,(page-body page)) | ||
260 | (last_updated ,(page-meta-ref 'last-updated page)) | ||
261 | ;; TODO: backlinks and what-not | ||
262 | ))) | ||
263 | |||
264 | |||
265 | ;;; Wikify | ||
266 | |||
267 | (define (render-wiki wiki) | ||
268 | ;;; Render the files in WIKI to disk. | ||
269 | (create-directory (wiki-destination-dir wiki) #:parents) | ||
270 | (for-each (lambda (page) | ||
271 | (with-output-to-file (page-destination page) | ||
272 | (lambda () | ||
273 | (write-string | ||
274 | (render-page (wiki-page-template wiki) page))))) | ||
275 | (wiki-pages wiki))) | ||