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 "<" (clean-characters (cdr characters)))) |
| 11 | ((equal? character ">") (string-append ">" (clean-characters (cdr characters)))) |
| 12 | ((equal? character "\"") (string-append """ (clean-characters (cdr characters)))) |
| 13 | ((equal? character "\'") (string-append "'" (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 | |