textile.fnl (12498B)
1 (import-macros { : define-tests : expect : expect= } :assert) 2 3 (local lpeg (require :lpeg)) 4 (local loc (lpeg.locale)) 5 (local { : view } (require :fennel)) 6 7 (local { : to-html } (require :html)) 8 (local { : prepend } (require :lib)) 9 10 (fn list-append [a1 a2] 11 (icollect [_ v (ipairs a2) &into a1] v)) 12 13 (fn extract-blocks [doc] 14 (let [{ : P : C : Ct : V } lpeg 15 eof (- (P 1)) 16 end-para (^ (+ (P "\r\n") (P "\n")) 2) 17 p (P { 18 1 :doc 19 :doc (* (^ (P "\n") 0) (/ (^ (V :block) 1) #[$...])) 20 :block (+ (V :pre) (V :para)) 21 22 :pre (* (P "<pre>") (V :pre-body) (P "</pre>") 23 (^ (P "\n") 0)) 24 25 :pre-body (/ (^ (- (P 1) (P "</pre>")) 1) 26 #(.. "pre. " $1)) 27 28 :para (* (/ (^ (- (P 1) end-para) 1) #(.. $1 "\n")) 29 (+ end-para 30 eof)) 31 })] 32 (p:match doc))) 33 34 (define-tests :extract-blocks 35 (with-open [f (io.open "tests/paras.txt" :r)] 36 (let [paras (extract-blocks (f:read "*a"))] 37 (expect= (# paras) 4) 38 (expect= (. paras 2) "this is\nalso a paragraph\n"))) 39 (expect= (extract-blocks "\n\n\nfirst para after some blank lines\n") 40 ["first para after some blank lines\n\n"]) 41 (expect= (extract-blocks "first line\r\nsecond line\r\n\r\nsecond para\r\n") 42 ["first line\r\nsecond line\n" "second para\r\n\n"]) 43 (expect= (extract-blocks "a para 44 45 <pre> 46 some untouchable text 47 48 that may contain double newlines 49 50 lala 51 la 52 </pre> 53 54 h1. heading") 55 ["a para\n" 56 "pre.\32 57 some untouchable text 58 59 that may contain double newlines 60 61 lala 62 la 63 " 64 "h1. heading\n"] 65 )) 66 67 68 (local block-tags 69 (doto (collect [_ v (ipairs [ 70 :h1 71 :h2 72 :h3 73 :h4 74 :h5 75 :h6 76 :p 77 :pre 78 :fn 79 ])] 80 (values v v)) 81 (tset :bq "blockquote"))) 82 83 84 (fn tag-and-body [block] 85 (case (string.find block "^([%a%d]-)%. *") 86 (start end tag) (values (. block-tags tag) (string.sub block (+ end 1))) 87 _ (values :p block))) 88 89 (define-tests :tag-and-body 90 (let [(t b) (tag-and-body "p. my paragraph")] 91 (expect= [t b] [:p "my paragraph"])) 92 (let [(t b) (tag-and-body "h1. header")] 93 (expect= [t b] [:h1 "header"])) 94 (let [(t b) (tag-and-body "bq. blockquoted")] 95 (expect= [t b] [:blockquote "blockquoted"]))) 96 97 ;; from https://github.com/jgarber/redcloth?tab=readme-ov-file#label-Quick+Phrase+Modifiers : 98 ;; 99 ;; _emphasis_ 100 ;; __italicized__ 101 ;; *strong* 102 ;; **bold** 103 ;; ??citation?? 104 ;; -deleted text- 105 ;; +inserted text+ 106 ;; ^superscript^ 107 ;; ~subscript~ 108 ;; @code@ 109 ;; %(classname)span% 110 111 (fn merging-concat [tbl e] 112 (let [last (# tbl) 113 string? (fn [x] (= (type x) :string))] 114 (if (and (string? (. tbl last)) (string? e)) 115 (tset tbl last (.. (. tbl last) e)) 116 (table.insert tbl e)) 117 tbl)) 118 119 (fn merge-strings [tbl] 120 (accumulate [o [] 121 _ v (ipairs tbl)] 122 (merging-concat o v))) 123 124 (define-tests :merge-strings 125 (expect= (merge-strings []) []) 126 (expect= (merge-strings ["a"]) ["a"]) 127 (expect= (merge-strings ["a" "b" "j"]) ["abj"]) 128 (expect= (merge-strings ["a" 7 "j"]) ["a" 7 "j"]) 129 (expect= (merge-strings ["a" "b" 7 ",j"]) ["ab" 7 ",j"])) 130 131 (var inline-parser nil) 132 (set 133 inline-parser 134 (let [{ : P : V : C : B : Cp : Ct : S} lpeg 135 special (S "_*\"@-") 136 except (fn [x] (^ (- (P 1) x) 1)) 137 whitespace (+ loc.space (P "\r")) 138 start-or-space (+ (B whitespace) (- (B (P 1)))) 139 recurse #(merge-strings (inline-parser:match $1))] 140 (P { 141 1 :elements 142 :elements (Ct (^ (V :element) 0)) 143 :element (+ 144 (/ (^ (except special) 1) #$1) 145 (V :strong) 146 (V :code) 147 (V :emph) 148 (V :link) 149 (V :del) 150 (C special)) 151 152 :emph (* start-or-space 153 (P "_") 154 (/ (except (P "_")) #(prepend :em (recurse $1))) 155 (P "_")) 156 157 :strong (* (P "*") 158 (/ (except (P "*")) #(prepend :strong (recurse $1))) 159 (P "*")) 160 161 :del (* start-or-space 162 (P "-") 163 (/ (* (- (P 1) (+ whitespace " ")) (except (P "-"))) 164 #(prepend :del (recurse $1))) 165 (P "-")) 166 167 :code (* (B (+ whitespace "(")) 168 (P "@") 169 (/ (except (P "@")) #[:code $1]) 170 (P "@")) 171 172 :link (/ (* (P "\"") (C (except "\"")) (P "\":") 173 (C (except loc.space))) 174 #(prepend [:a {:href $2}] (recurse $1))) 175 }))) 176 177 (fn inline-markup [x] (merge-strings (inline-parser:match x))) 178 179 180 (define-tests :inline-markup 181 (expect= (inline-markup "") []) 182 183 (expect= (inline-markup "foo") ["foo"]) 184 (expect= (inline-markup "_emph_") [[:em "emph"] ]) 185 (expect= (inline-markup "foo _emph_") ["foo " [:em "emph"] ]) 186 (expect= (inline-markup "foo -struck-") ["foo " [:del "struck"] ]) 187 (expect= (inline-markup "foo @1+2+3@") ["foo " [:code "1+2+3"] ]) 188 ;; markup in code blocks is ignored 189 (expect= (inline-markup "foo @1+_2_+3@") ["foo " [:code "1+_2_+3"] ]) 190 191 (expect= (inline-markup "I have - and this is an aside - no strikethrough") 192 ["I have - and this is an aside - no strikethrough"]) 193 194 (expect= (inline-markup "foo@example.com") ["foo@example.com" ]) 195 (expect= (inline-markup "foo @ example.com") ["foo @ example.com" ]) 196 197 (expect= (inline-markup "say \"hello\" to my friend") 198 ["say \"hello\" to my friend"]) 199 200 (expect= (inline-markup "foo *strong*") ["foo " [:strong "strong"]]) 201 202 (expect= (inline-markup "before *during* after") 203 ["before " [:strong "during"] " after"]) 204 205 ;; nested markup 206 (expect= (inline-markup "foo *strong _em_*") 207 ["foo " [:strong "strong " [:em "em"]]]) 208 ;; nested the other way around 209 (expect= (inline-markup "john _paul *george*_") 210 ["john " [:em "paul " [:strong "george"]]]) 211 212 (expect= (inline-markup "see \"a link\":https://www.example.com for more") 213 ["see " [["a" {:href "https://www.example.com"}] "a link"] " for more"]) 214 (expect= (inline-markup "see \"a link\":https://www.example.com\nfor more") 215 ["see " [["a" {:href "https://www.example.com"}] "a link"] "\nfor more"]) 216 217 218 (expect= (inline-markup "when doing 219 a \"development\" build, now we make a single agglomerated firmware 220 image and rely on the \"kernel mtdsplit 221 code\":https://ww.telent.net/2018/4/16/flash_ah_ah to find the root 222 filesystem. ") 223 ["when doing 224 a \"development\" build, now we make a single agglomerated firmware 225 image and rely on the " 226 [["a" {:href "https://ww.telent.net/2018/4/16/flash_ah_ah"}] 227 "kernel mtdsplit 228 code"] 229 " to find the root 230 filesystem. "]) 231 232 233 (expect= (inline-markup "use the --help option to be lied to") 234 ["use the --help option to be lied to"]) 235 236 (expect= (inline-markup 237 "(@vmlinux@ is not actually required on the target, it's a leftover))") 238 ["(" 239 ["code" "vmlinux"] 240 " is not actually required on the target, it's a leftover))"] 241 ) 242 243 ) 244 245 246 247 ;; a list item starts with any list token *+ or #+ and continues until 248 ;; - end of block 249 ;; - next occurence of the same token 250 ;; - occurence of a parent token 251 252 ;; a list item may contain another list 253 254 ;; however, the third case will never occur: 255 ;; - a toplevel list has no parent list and therefore lasts until end 256 ;; of the block. 257 ;; - when splitting a child list we [pass it only a single list item 258 ;; of the parent list, so so won't encounter a parent list token 259 260 ;; there need not be a blank line before the list 261 262 263 (fn chop-block [tok block start] 264 (case (string.find block tok start) 265 (s e) (prepend (string.sub block start (- s 1)) 266 (chop-block tok block (+ 1 e))) 267 nil [(string.sub block start)])) 268 269 (fn split-list-items [block] 270 (let [tok (string.match block "%f[^\0\n]([%*%#]+)")] 271 (if tok 272 (values 273 (chop-block (.. "%f[^\0\n]" (string.gsub tok "(.)" "%%%1" ) "%f[^%*%#] *") block 1) 274 (if (= (string.sub tok 1 1) "#") :ol :ul)) 275 (values [block] nil)))) 276 277 (fn extract-lists [block] 278 (let [([preamble & lists] tag) (split-list-items block)] 279 (if tag 280 (list-append 281 (or (inline-markup preamble) []) 282 [(prepend tag (icollect [_ i (ipairs lists)] 283 (prepend :li (extract-lists i))))]) 284 (or (inline-markup preamble) [])))) 285 286 287 (define-tests :extract-lists 288 289 (case (split-list-items "there is no list in this para\n") 290 (text ?tag) 291 (and 292 (expect= text ["there is no list in this para\n"]) 293 (expect= ?tag nil))) 294 295 (expect= 296 (pick-values 1 (split-list-items "para\n* item 1\n*item 2\n")) 297 ["para\n" "item 1\n" "item 2\n"]) 298 299 (expect= 300 (pick-values 1 (split-list-items "* item 1\n*item 2\n")) 301 ["" "item 1\n" "item 2\n"]) 302 303 (expect= (extract-lists "* item 1\n* item 2\n* item 3\n") 304 [ [:ul [:li "item 1\n"] [:li "item 2\n"] [:li "item 3\n"]]]) 305 306 (expect= (extract-lists "* item 1\n* item 2\n* item 3\n") 307 [ [:ul [:li "item 1\n"] [:li "item 2\n"] [:li "item 3\n"]]]) 308 309 (expect= (extract-lists "* item 1\n* item 2\n* item 3\n") 310 [[:ul [:li "item 1\n"] [:li "item 2\n"] [:li "item 3\n"]]]) 311 312 (expect= (extract-lists "* item 1\n** subitem\n*item 2\n") 313 [[:ul 314 [:li "item 1\n" 315 [:ul [:li "subitem\n"]]] 316 [:li "item 2\n"]]]) 317 318 (expect= (extract-lists "# item 1\n# item 2\n## subitem\n") 319 [[:ol 320 [:li "item 1\n"] 321 [:li "item 2\n" 322 [:ol [:li "subitem\n"]]]]]) 323 324 (expect= (extract-lists "* item 1\n** subitem\n*item 2\n") 325 [[:ul 326 [:li "item 1\n" [:ul [:li "subitem\n"]]] 327 [:li "item 2\n"]]]) 328 329 (expect= (extract-lists "* item 1\n# numbered item\n* item 2\n") 330 [[:ul 331 [:li "item 1\n" 332 [:ol [:li "numbered item\n"]]] 333 [:li "item 2\n"]]]) 334 335 (expect= (extract-lists "* item 1\n* _emph_ item 2\n* item 3\n") 336 [ [:ul [:li "item 1\n"] 337 [:li [:em "emph"] " item 2\n"] 338 [:li "item 3\n"]]]) 339 340 (expect= (extract-lists "") []) 341 342 ) 343 344 (fn parse-string [str] 345 (icollect [_ p (ipairs (extract-blocks str))] 346 (let [(tag body) (tag-and-body p)] 347 (if (= tag :pre) 348 [tag body] 349 (prepend tag (extract-lists body)))))) 350 351 (fn parse-stream [stream] 352 (parse-string (stream:read "*a"))) 353 354 355 (define-tests :parse-stream 356 (expect= (parse-string "h1. Hi") [[:h1 "Hi\n"]]) 357 (expect= (parse-string 358 "kernel about the size of sigset_t; given that the kernel puts its idea 359 ofa sigset_t onto my stack, it seems a trifle unsporting to arrange 360 headers so that i only get access to the glibc version - especially" 361 ) 362 [["p" 363 "kernel about the size of sigset_t; given that the kernel puts its idea 364 ofa sigset_t onto my stack, it seems a trifle unsporting to arrange 365 headers so that i only get access to the glibc version - especially 366 "]]) 367 (expect= (parse-string 368 "was immensely cheered to find that none of the other interviewees -\r 369 interesting people, great hackers and luminaries among them - were\r 370 ") 371 [["p" 372 "was immensely cheered to find that none of the other interviewees -\r 373 interesting people, great hackers and luminaries among them - were\r 374 375 "]]) 376 377 (fn convert [name] 378 (with-open [f (assert (io.open name :r))] 379 (with-open [out (assert (io.tmpfile))] 380 (each [_ el (ipairs (parse-stream f))] 381 (to-html el out)) 382 (out:seek :set 0) 383 (out:read "*a")))) 384 385 (expect= (convert "tests/hello.txt") "<p>hello world\n\n</p>") 386 (expect= (convert "tests/link.textile") "<p><a href=\"https://www.example.com\">example</a>\n\n</p>") 387 (expect= (convert "tests/blog.textile") 388 "<h1>header 1 389 </h1><p>This is the first para 390 </p><p><ul><li>item 1 391 <ol><li>subitem 392 </li></ol></li></ul></p><p>This is the second para 393 </p><blockquote>this block is quoted 394 </blockquote><pre> 395 line one 396 -line 2- 397 398 hello 399 </pre>") 400 401 ) 402 403 404 { 405 :parse parse-stream 406 }