git.m455.casa

m455.casa

clone url: git://git.m455.casa/m455.casa


src/parser.scm

1 (define (clean-characters str)
2 (let ((characters (if (string? str)
3 (string->list str)
4 str)))
5 (if (null? characters)
6 ""
7 (let ((character (string (car characters))))
8 (cond
9 ((equal? character "&") (string-append "&" (clean-characters (cdr characters))))
10 ((equal? character "<") (string-append "&lt;" (clean-characters (cdr characters))))
11 ((equal? character ">") (string-append "&gt;" (clean-characters (cdr characters))))
12 ((equal? character "\"") (string-append "&quot;" (clean-characters (cdr characters))))
13 ((equal? character "\'") (string-append "&#39;" (clean-characters (cdr characters))))
14 (else (string-append character (clean-characters (cdr characters)))))))))
15
16 ;; these formatters can't be nested or split into separate lines because of my
17 ;; shitty code LOL
18 (define (parse-characters line state)
19 (let ((characters (if (string? line)
20 (string->list line)
21 line)))
22 (if (null? characters)
23 ""
24 (let ((character (string (car characters))))
25 (cond
26 ;; check for line-based states, except for codeblocks, so characters
27 ;; are preserves
28 ((or (equal? 'normal state)
29 (equal? 'paragraph state)
30 (equal? 'unordered-list state)
31 (equal? 'ordered-list state)
32 (equal? 'blockquote state))
33 ;; try to catch inline formatters before the general character
34 ;; appending in the else statement below
35 (cond
36 ;; start of bold
37 ((equal? "*" character)
38 (string-append "<strong>" (parse-characters (cdr characters) 'bold)))
39 ;; start of inline code
40 ((equal? "`" character)
41 (string-append "<code>" (parse-characters (cdr characters) 'inline-code)))
42 ;; start of a link url
43 ((equal? "[" character)
44 (string-append "<a href=\"" (parse-characters (cdr characters) 'link)))
45 ;; if we're in any of the states above, and it's not one of the
46 ;; three characters above, then just append the character, and
47 ;; keep parsing
48 (else (string-append character (parse-characters (cdr characters) state)))))
49 ;; end of bold
50 ((and (equal? 'bold state)
51 (equal? "*" character))
52 (string-append "</strong>" (parse-characters (cdr characters) 'normal)))
53 ;; end of inline code
54 ((and (equal? 'inline-code state)
55 (equal? "`" character))
56 (string-append "</code>" (parse-characters (cdr characters) 'normal)))
57 ;; start of link url
58 ((equal? 'link state)
59 (cond
60 ;; middle of link url
61 ((not (equal? "|" character))
62 (string-append character (parse-characters (cdr characters) 'link)))
63 ;; end of link url
64 ((equal? "|" character)
65 (string-append "\">" (parse-characters (cdr characters) 'link-title)))))
66 ;; start of link title
67 ((equal? 'link-title state)
68 (cond
69 ;; middle of link title
70 ((not (equal? "]" character))
71 (string-append character (parse-characters (cdr characters) 'link-title)))
72 ;; end of link title
73 ((equal? "]" character)
74 (string-append "</a>" (parse-characters (cdr characters) 'normal)))))
75 ;; append a character if it doesn't meet any of the conditions above,
76 ;; so we actually have all of the characters on the line that we want.
77 (else (string-append character (parse-characters (cdr characters) state))))))))
78
79 (define (parse-lines lines state)
80 (if (null? lines)
81 ;; if we reach the end of the file while still in a non-normal state state, then
82 ;; return the state's associated closing html element
83 (cond
84 ((equal? 'paragraph state) "</p>")
85 ((equal? 'unordered-list state) "</li>\n</ul>")
86 ((equal? 'ordered-list state) "</li>\n</ol>")
87 ((equal? 'blockquote state) "</blockquote>")
88 ((equal? 'codeblock state) "</pre>")
89 (else ""))
90 (let ((line (car lines)))
91 (cond
92 ((equal? 'normal state)
93 (cond
94 ;; horizontal rule
95 ((irregex-match? "^---[[:space:]]*$" line)
96 (string-append "<hr>\n" (parse-lines (cdr lines) 'normal)))
97 ;; title
98 ((irregex-match? "^title: .*$" line)
99 (string-append "<h1>"
100 (clean-characters
101 (substring line (string-length TITLE-PREFIX)))
102 "</h1>\n\n"
103 (parse-lines (cdr lines) 'normal)))
104 ;; heading
105 ((irregex-match? "^# .*$" line)
106 (string-append "<h2>"
107 (clean-characters
108 (substring line (string-length HEADING-PREFIX)))
109 "</h2>\n\n"
110 (parse-lines (cdr lines) 'normal)))
111 ;; start of a codeblock
112 ((irregex-match? "^```[[:space:]]*$" line)
113 (string-append "<pre>\n" (parse-lines (cdr lines) 'codeblock)))
114 ;; start of an unordered list
115 ((irregex-match? "^- .*$" line)
116 (string-append "<ul>\n"
117 "<li>\n"
118 (parse-characters
119 (clean-characters
120 (substring line (string-length UNORDERED-LIST-PREFIX))) state)
121 "\n"
122 (parse-lines (cdr lines) 'unordered-list)))
123 ;; start of an ordered list
124 ((irregex-match? "^1. .*$" line)
125 (string-append "<ol>\n"
126 "<li>\n"
127 (parse-characters
128 (clean-characters (substring line (string-length ORDERED-LIST-PREFIX))) state)
129 "\n"
130 (parse-lines (cdr lines) 'ordered-list)))
131 ;; start of a blockquote
132 ((irregex-match? "^> .*$" line)
133 (string-append "<blockquote>\n"
134 (parse-characters
135 (clean-characters (substring line 2)) state)
136 "\n"
137 (parse-lines (cdr lines) 'blockquote)))
138 ;; start of a paragraph
139 ((not (irregex-match? "^[[:space:]]*$" line))
140 (string-append "<p>\n"
141 (parse-characters
142 (clean-characters line) 'paragraph)
143 "\n"
144 (parse-lines (cdr lines) 'paragraph)))
145 ;; anything else, which should only match a (irregex-match?
146 ;; "^[[:space:]]*$" line), just keep parsing and skip it, so we can
147 ;; keep the html output readable, without polluting it with spaces
148 (else (parse-lines (cdr lines) 'normal))))
149 ((equal? 'codeblock state)
150 ;; end of a codeblock
151 (if (irregex-match? "^```[[:space:]]*$" line)
152 (string-append "</pre>\n\n"
153 (parse-lines (cdr lines) 'normal))
154 ;; middle of a codeblock
155 (string-append (clean-characters line)
156 "\n"
157 (parse-lines (cdr lines) 'codeblock))))
158 ((equal? 'unordered-list state)
159 (cond
160 ;; end of an unordered list
161 ((irregex-match? "^[[:space:]]*$" line)
162 (string-append "</li>\n"
163 "</ul>\n\n"
164 (parse-lines (cdr lines) 'normal)))
165 ;; middle of an unordered list
166 ((irregex-match? "^- .*$" line)
167 (string-append "</li>\n"
168 "<li>\n"
169 (parse-characters
170 (clean-characters (substring line 2)) state)
171 "\n"
172 (parse-lines (cdr lines) state)))
173 ;; multiline unordered list item
174 (else (string-append (parse-characters
175 (clean-characters line) state)
176 "\n"
177 (parse-lines (cdr lines) state)))))
178 ((equal? 'ordered-list state)
179 (cond
180 ;; end of an ordered list
181 ((irregex-match? "^[[:space:]]*$" line)
182 (string-append "</ol>\n\n"
183 (parse-lines (cdr lines) 'normal)))
184 ;; middle of an ordered list
185 ((irregex-match? "^1. .*$" line)
186 (string-append "</li>\n"
187 "<li>\n"
188 (parse-characters
189 (clean-characters (substring line 3)) state)
190 "\n"
191 (parse-lines (cdr lines) state)))
192 ;; multiline ordered list item
193 (else (string-append (parse-characters
194 (clean-characters line) state)
195 "\n"
196 (parse-lines (cdr lines) state)))))
197 ((equal? 'blockquote state)
198 (cond
199 ;; end of a blockquote
200 ((irregex-match? "^[[:space:]]*$" line)
201 (string-append "</blockquote>\n"
202 (parse-lines (cdr lines) 'normal)))
203 ;; middle of a blockquote
204 ((irregex-match? "^> .*$" line)
205 (string-append (parse-characters
206 (clean-characters (substring line 2)) state)
207 "\n"
208 (parse-lines (cdr lines) 'blockquote)))))
209 ((equal? 'paragraph state)
210 (if (irregex-match? "^[[:space:]]*$" line)
211 ;; end of a paragraph
212 (string-append "</p>\n\n" (parse-lines (cdr lines) 'normal))
213 ;; middle of a paragraph
214 (string-append (parse-characters
215 (clean-characters line) 'paragraph)
216 "\n"
217 (parse-lines (cdr lines) 'paragraph))))
218 ;; anything else, just skip it. i don't *think* this condition is every
219 ;; met, because it would require the state to be something that isn't
220 ;; checked for above. better safe than sorry, i guess? ... what am i
221 ;; talking about? i don't know what the hell i'm doing. i just know it
222 ;; works and i'm having fun lol
223 (else (parse-lines (cdr lines) 'normal))))))
224