clone url: git://git.m455.casa/lol
src/parser.scm
1 | (define (join-rest mode l) |
2 | (if (list? l) |
3 | (if (equal? mode 'lines) |
4 | (string-intersperse (cdr l) "\n") |
5 | (list->string (cdr l))) |
6 | l)) |
7 |
|
8 | (define (clean-characters str) |
9 | (let* ((characters-list (string->list str)) |
10 | (clean-rest (lambda () |
11 | (clean-characters |
12 | (join-rest 'characters characters-list))))) |
13 | (if (null? characters-list) |
14 | "" |
15 | (let ((character (string (car characters-list)))) |
16 | (cond |
17 | ((equal? character "&") (string-append "&" (clean-rest))) |
18 | ((equal? character "<") (string-append "<" (clean-rest))) |
19 | ((equal? character ">") (string-append ">" (clean-rest))) |
20 | (else (string-append character (clean-rest)))))))) |
21 |
|
22 | (define (parse-characters str state) |
23 | (let* ((characters-list (string->list str)) |
24 | (parse-rest (lambda (current-state) |
25 | (parse-characters |
26 | (join-rest 'characters characters-list) |
27 | current-state)))) |
28 | (if (null? characters-list) |
29 | "" |
30 | (let ((character (string (car characters-list)))) |
31 | (cond |
32 | ;; bold ------------------------------------------ |
33 | ;; list-like syntax should be listed here |
34 | ((and (or (equal? state 'normal) |
35 | (equal? state 'paragraph) |
36 | (equal? state 'ordered-list) |
37 | (equal? state 'unordered-list) |
38 | (equal? state 'blockquote)) |
39 | (equal? character "*")) |
40 | (string-append "<strong>" (parse-rest 'bold))) |
41 |
|
42 | ((and (equal? state 'bold) |
43 | (equal? character "*")) |
44 | (string-append "</strong>" (parse-rest 'normal))) |
45 | ;; inline code ----------------------------------- |
46 | ;; list-like syntax should be listed here |
47 | ((and (or (equal? state 'normal) |
48 | (equal? state 'paragraph) |
49 | (equal? state 'ordered-list) |
50 | (equal? state 'unordered-list) |
51 | (equal? state 'blockquote)) |
52 | (equal? character "`")) |
53 | (string-append "<code>" (parse-rest 'inline-code))) |
54 |
|
55 | ((and (equal? state 'inline-code) |
56 | (equal? character "`")) |
57 | (string-append "</code>" (parse-rest 'normal))) |
58 | ;; links ----------------------------------------- |
59 | ;; list-like syntax should be listed here |
60 | ((and (or (equal? state 'normal) |
61 | (equal? state 'paragraph) |
62 | (equal? state 'ordered-list) |
63 | (equal? state 'unordered-list) |
64 | (equal? state 'blockquote)) |
65 | (equal? character "[")) |
66 | (string-append "<a href=\"" (parse-rest 'link))) |
67 |
|
68 | ((and (equal? state 'link) |
69 | (not (equal? character "|"))) |
70 | (string-append character (parse-rest 'link))) |
71 |
|
72 | ((and (equal? state 'link) |
73 | (equal? character "|")) |
74 | (string-append "\">" (parse-rest 'link-title))) |
75 |
|
76 | ((and (equal? state 'link-title) |
77 | (not (equal? character "]"))) |
78 | (string-append character (parse-rest 'link-title))) |
79 |
|
80 | ((and (equal? state 'link-title) |
81 | (equal? character "]")) |
82 | (string-append "</a>" (parse-rest 'normal))) |
83 | ;; escaped characters ---------------------------- |
84 | ((and (equal? character "\\") |
85 | (not (equal? state 'escape))) |
86 | (parse-rest (case state |
87 | ('normal 'escape-normal) |
88 | ('paragraph 'escape-paragraph) |
89 | ('bold 'escape-bold) |
90 | ('inline-code 'escape-inline-code) |
91 | ('codeblock 'escape-codeblock) |
92 | ('blockquote 'escape-blockquote) |
93 | ('ordered-list 'escape-ordered-list) |
94 | ('unordered-list 'escape-unordered-list) |
95 | (else 'escape)))) |
96 |
|
97 | ((equal? state 'escape-normal) |
98 | (string-append character (parse-rest 'normal))) |
99 |
|
100 | ((equal? state 'escape-paragraph) |
101 | (string-append character (parse-rest 'paragraph))) |
102 |
|
103 | ((equal? state 'escape-bold) |
104 | (string-append character (parse-rest 'bold))) |
105 |
|
106 | ((equal? state 'escape-inline-code) |
107 | (string-append character (parse-rest 'inline-code))) |
108 |
|
109 | ((equal? state 'escape-codeblock) |
110 | (string-append character (parse-rest 'codeblock))) |
111 |
|
112 | ((equal? state 'escape-blockquote) |
113 | (string-append character (parse-rest 'blockquote))) |
114 |
|
115 | ((equal? state 'escape-ordered-list) |
116 | (string-append character (parse-rest 'ordered-list))) |
117 |
|
118 | ((equal? state 'escape-unordered-list) |
119 | (string-append character (parse-rest 'unordered-list))) |
120 |
|
121 | ((equal? state 'escape) |
122 | (string-append character (parse-rest 'normal))) |
123 |
|
124 | (else (string-append character (parse-rest state)))))))) |
125 |
|
126 | (define (parse-lines str state) |
127 | ;; no clue why a (string-split str "\n" #t) doesn't work here. it just hangs |
128 | ;; if i replace the (with-input-from-string ...) |
129 | (let* ((lines (with-input-from-string str read-lines)) |
130 | (parse-rest (lambda (current-state) |
131 | (parse-lines |
132 | (join-rest 'lines lines) |
133 | current-state)))) |
134 | (if (null? lines) |
135 | (cond |
136 | ;; items that close from lack of markup should be added here. |
137 | ;; these are applied when nothing follows these elements |
138 | ((equal? state 'paragraph) "</p>\n") |
139 | ((equal? state 'unordered-list) "</ul>\n") |
140 | ((equal? state 'ordered-list) "</ol>\n") |
141 | ((equal? state 'blockquote) "</blockquote>\n") |
142 | (else "")) |
143 | (let ((line (car lines))) |
144 | (cond |
145 | ;; raw ------------------------------------------- |
146 | ;; check for paragraphs too, so raw elements occuring on the line right |
147 | ;; after a paragraph aren't rendered as paragraphs |
148 | ((and (or (equal? state 'normal) |
149 | (equal? state 'paragraph)) |
150 | (irregex-match? "^~~~$" line)) |
151 | (parse-rest 'raw)) |
152 | ;; escape raw symbol |
153 | ;; i don't *think* i need this right now, as I can use ``` |
154 | ; ((and (equal? state 'raw) |
155 | ; (irregex-match? "^@~~~$" line)) |
156 | ; (string-append "~~~\n" (parse-lines (join-rest 'lines lines) 'raw))) |
157 | ((and (equal? state 'raw) |
158 | (irregex-match? "^~~~$" line)) |
159 | (parse-rest 'normal)) |
160 |
|
161 | ((equal? state 'raw) |
162 | (string-append line "\n" (parse-rest 'raw))) |
163 | ;; codeblocks ------------------------------------ |
164 | ;; check for paragraphs too, so codeblocks occuring on the line right |
165 | ;; after a paragraph aren't rendered as paragraphs |
166 | ((and (or (equal? state 'normal) |
167 | (equal? state 'paragraph)) |
168 | (irregex-match? "^```$" line)) |
169 | (string-append "<pre>\n" (parse-rest 'codeblock))) |
170 |
|
171 | ((and (equal? state 'codeblock) |
172 | (irregex-match? "^```$" line)) |
173 | (string-append "</pre>\n" (parse-rest 'normal))) |
174 |
|
175 | ((equal? state 'codeblock) |
176 | (string-append (clean-characters line) |
177 | "\n" |
178 | (parse-rest 'codeblock))) |
179 | ;; blockquotes ----------------------------------- |
180 | ((and (or (equal? state 'normal) |
181 | (equal? state 'paragraph)) |
182 | (irregex-match? "^> (.*)$" line)) |
183 | (string-append "<blockquote>\n" |
184 | (parse-characters |
185 | (clean-characters (substring line 2)) state) |
186 | "\n" |
187 | (parse-rest 'blockquote))) |
188 |
|
189 | ((and (equal? state 'blockquote) |
190 | (irregex-match? "^> (.*)$" line)) |
191 | (string-append (parse-characters |
192 | (clean-characters (substring line 2)) state) |
193 | "\n" |
194 | (parse-rest 'blockquote))) |
195 |
|
196 | ;; this is applied when elements occur after this element |
197 | ;; when nothing occurs after this element, refer to the start |
198 | ;; of this function in the cond statement |
199 | ((and (equal? state 'blockquote) |
200 | (not (irregex-match? "^> (.*)$" line))) |
201 | (string-append "</blockquote>\n" (parse-rest 'normal))) |
202 | ;; unordered lists ------------------------------- |
203 | ((and (or (equal? state 'normal) |
204 | (equal? state 'paragraph)) |
205 | (irregex-match? "^- (.*)$" line)) |
206 | (string-append "<ul>\n" |
207 | " <li>" |
208 | (parse-characters |
209 | (clean-characters (substring line 2)) state) |
210 | "</li>\n" |
211 | (parse-rest 'unordered-list))) |
212 |
|
213 | ((and (equal? state 'unordered-list) |
214 | (irregex-match? "^- (.*)$" line)) |
215 | (string-append " <li>" |
216 | (parse-characters |
217 | (clean-characters (substring line 2)) state) |
218 | "</li>\n" |
219 | (parse-rest 'unordered-list))) |
220 |
|
221 | ;; this is applied when elements occur after this element |
222 | ;; when nothing occurs after this element, refer to the start |
223 | ;; of this function in the cond statement |
224 | ((and (equal? state 'unordered-list) |
225 | (not (irregex-match? "^- (.*)$" line))) |
226 | (string-append "</ul>\n" (parse-rest 'normal))) |
227 | ;; ordered lists --------------------------------- |
228 | ((and (or (equal? state 'normal) |
229 | (equal? state 'paragraph)) |
230 | (irregex-match? "^1. (.*)$" line)) |
231 | (string-append "<ol>\n" |
232 | " <li>" |
233 | (parse-characters |
234 | (clean-characters (substring line 3)) state) |
235 | "</li>\n" |
236 | (parse-rest 'ordered-list))) |
237 |
|
238 | ((and (equal? state 'ordered-list) |
239 | (irregex-match? "^1. (.*)$" line)) |
240 | (string-append " <li>" |
241 | (parse-characters |
242 | (clean-characters (substring line 3)) state) |
243 | "</li>\n" |
244 | (parse-rest 'ordered-list))) |
245 |
|
246 | ;; this is applied when elements occur after this element |
247 | ;; when nothing occurs after this element, refer to the start |
248 | ;; of this function in the cond statement |
249 | ((and (equal? state 'ordered-list) |
250 | (not (irregex-match? "^1. (.*)$" line))) |
251 | (string-append "</ol>\n" (parse-rest 'normal))) |
252 | ;; title ----------------------------------------- |
253 | ((and (equal? state 'normal) |
254 | (irregex-match? "^title: (.*)$" line)) |
255 | (string-append "<h1>" |
256 | (parse-characters |
257 | (clean-characters (substring line 7)) state) |
258 | "</h1>\n" |
259 | (parse-rest state))) |
260 | ;; headings -------------------------------------- |
261 | ((and (equal? state 'normal) |
262 | (irregex-match? "^# (.*)$" line)) |
263 | (string-append "<h2>" |
264 | (parse-characters |
265 | (clean-characters (substring line 2)) state) |
266 | "</h2>\n" |
267 | (parse-rest state))) |
268 | ;; paragraphs ------------------------------------ |
269 | ((and (equal? state 'normal) |
270 | (not (irregex-match? "^[\\s\n\t]*$" line))) |
271 | (string-append "<p>\n" |
272 | (parse-characters (clean-characters line) state) |
273 | "\n" |
274 | (parse-rest 'paragraph))) |
275 |
|
276 | ((and (equal? state 'paragraph) |
277 | (not (irregex-match? "^[\\s\n\t]*$" line))) |
278 | (string-append (parse-characters (clean-characters line) state) |
279 | "\n" |
280 | (parse-rest 'paragraph))) |
281 |
|
282 | ((and (equal? state 'paragraph) |
283 | (or (irregex-match? "^[\\s\n\t]*$" line) |
284 | (null? line))) |
285 | (string-append "</p>\n" (parse-rest 'normal))) |
286 |
|
287 | (else (parse-rest 'normal))))))) |
288 |
|