(local entity-replacements {"&" "&" ; must be first! "<" "<" ">" ">" "\"" """}) (local entity-search (.. "[" (table.concat (icollect [k (pairs entity-replacements)] k)) "]")) (fn escape-html [s] (assert (= (type s) :string)) (s:gsub entity-search entity-replacements)) (fn compile-attributes [attributes] (var result []) (if (table? attributes) (each [name value (pairs attributes)] (when value (do (table.insert result " ") (table.insert result name) (when (~= value true) (do (table.insert result "=\"") (table.insert result value) (table.insert result "\"")))))) (list? attributes) (table.insert result `(accumulate [res# "" k# v# (pairs (,attributes))] (.. " " (if (not v#) "" (= v# true) (.. k#) (.. k# "=\"" v# "\"")) res#)))) result) (fn concat [...] (local res []) (var cur 1) (each [_ t (pairs [...])] (each [_ v (pairs t)] (tset res cur v) (set cur (+ 1 cur)))) res) (fn compress-compiled-html [html] (var result []) (var accumulator "") (each [_ value (pairs html)] (if (= (type value) "string") (set accumulator (.. accumulator value)) (do (when (~= "" accumulator) (do (table.insert result accumulator) (set accumulator ""))) (table.insert result value)))) (when (~= "" accumulator) (table.insert result accumulator)) result) (fn compile-html [html] (fn inner-compile [html] (var result []) (fn add [item] (table.insert result item)) (let [[tag attributes & body] html] (add "<") (add tag) (set result (concat result (compile-attributes attributes))) (add ">") (each [_ item (pairs body)] (if (and (sequence? item) (= (. item 1) "NO-ESCAPE")) (each [i pair (ipairs item)] (when (~= i 1) (add (. item i)))) (sequence? item) (set result (concat result (inner-compile item))) (list? item) ;; FIXME: add escaping to results (add (if (or (= (. item 1) `table.unpack) (= (. item 1) `unpack)) `(.. ,item) item)) (= (type item) "string") (add (escape-html item)) (add item))) (when (< 0 (# body)) (add "")) (add "\n")) result) `(.. ,(table.unpack (compress-compiled-html (inner-compile html))))) {: compile-html}