blob: 7b22dbff33ea4868f5621113c5c34d4d3d3dd3d2 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
|
(import (chicken base)
utf8
spiffy
nrepl
srfi-18
(chicken file)
(chicken io)
(chicken port)
(chicken format)
(chicken pretty-print)
lowdown
sxml-transforms
matchable
(chicken irregex)
shell
srfi-13
intarweb
html-parser)
(define (pipe x . fns)
(match fns
[() x]
[(fn . rest) (apply pipe (fn x) rest)]))
;; Convenience macro (@ expr ...) that expands to (lambda (x) (expr ... x))
(define-syntax @
(syntax-rules ()
((_ fn-body expr ...)
(lambda (x) (fn-body expr ... x)))))
(define (replace from to str)
(irregex-replace/all from str to))
(define (html-unescape html)
(pipe html
(@ replace """ "\"")
(@ replace "'" "'")
(@ replace "&" "&")
(@ replace "<" "<")
(@ replace ">" ">")))
(define (highlight ext code)
(define tmp-file-path (create-temporary-file ext))
(with-output-to-file tmp-file-path
(lambda () (display code)))
(define result (capture ,(format "highlight ~A -O html -f" tmp-file-path)))
(delete-file tmp-file-path)
result)
(define (replace-code-block content return)
(define irx (irregex "^%lang (\\S+)%\\n?" 's))
(define lang-match
(irregex-search irx content))
(if (not lang-match)
(return content))
(define lang
(irregex-match-substring lang-match 1))
(pipe content
(@ replace irx "")
(@ html-unescape)
(@ highlight lang)
(@ string-trim-both)))
(define (convert-md-to-html filepath)
(with-output-to-string
(lambda () (markdown->html (open-input-file filepath)))))
(define (highlight-code-blocks html)
(define (highlight-match m)
(format "<code>~A</code>"
(call/cc (@ replace-code-block (irregex-match-substring m 1)))))
(irregex-replace/all (irregex "<code>(.*?)</code>" 's) html
highlight-match))
(define (insert-to-page-tmpl tmpl-path html)
(format (read-string #f (open-input-file tmpl-path))
html))
(define (app c)
(define html-text
(pipe "article.md"
(@ convert-md-to-html)
(@ highlight-code-blocks)
(@ insert-to-page-tmpl "index.html")))
(send-response body: html-text
headers: '((content-type #(text/html ((charset . utf-8)))))))
(thread-start!
(lambda ()
(print "starting nrepl on port 1234")
(nrepl-prompt (lambda () (display "#;0> ")))
(nrepl 1234)))
(vhost-map `((".*" . ,(lambda (c) (app c)))))
(start-server)
|
