about summary refs log tree commit diff stats
path: root/wikme-module.scm
diff options
context:
space:
mode:
Diffstat (limited to 'wikme-module.scm')
-rw-r--r--wikme-module.scm275
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)))