~technomancy/fennel-lang.org

12334ff69cff3ead460e76b1299cafc1135d419f — Phil Hagelberg 11 days ago 275dbe0
Update html.fnl to use modern Fennel constructs.
1 files changed, 15 insertions(+), 30 deletions(-)

M html.fnl
M html.fnl => html.fnl +15 -30
@@ 1,47 1,32 @@
;; A *very* basic HTML generation library.
;; Basic escaping features only; never use this on user input!

(local map (fn [f tbl]
             (let [out {}]
               (each [i v (ipairs tbl)]
                 (tset out i (f v)))
               out)))

(local map-kv (fn [f tbl]
                (let [out {}]
                  (each [k v (pairs tbl)]
                    (table.insert out (f k v)))
                  out)))

(local to-attr (fn [k v]
                 (if (= v true) k
                     (.. k "=\"" v"\""))))

(local tag (fn [tag-name attrs]
             (assert (= (type attrs) "table") (.. "Missing attrs table: " tag-name))
             (let [attr-str (table.concat (map-kv to-attr attrs) " ")]
               (.. "<" tag-name " " attr-str">"))))

(local entity-replacements {"&" "&amp;" ; must be first!
                            "<" "&lt;"
                            ">" "&gt;"
                            "\"" "&quot;"})

(local entity-search (let [result []]
                       (each [k _ (pairs entity-replacements)]
                             (table.insert result k))
                       (.. "[" (table.concat result "") "]")))
(local entity-search
       (.. "[" (table.concat (icollect [k (pairs entity-replacements)] k)) "]"))

(fn escape [s]
  (assert (= (type s) :string))
  (s:gsub entity-search entity-replacements))

(local escape (fn [s]
                  (assert (= (type s) "string"))
                  (: s :gsub entity-search entity-replacements)))
(fn tag [tag-name attrs]
  (assert (= (type attrs) "table") (.. "Missing attrs table: " tag-name))
  (let [attr-str (table.concat (icollect [k v (pairs attrs)]
                                 (if (= v true) k
                                     (.. k "=\"" v"\""))) " ")]
    (.. "<" tag-name " " attr-str">")))

(fn html [document allow-no-escape?]
  (if (= (type document) "string")
  (if (= (type document) :string)
      (escape document)
      (and allow-no-escape? (= (. document 1) :NO-ESCAPE))
      (. document 2)
      (let [[tag-name attrs & body] document]
        (.. (tag tag-name attrs)
            (table.concat (map #(html $ allow-no-escape?) body) " ")
            (table.concat (icollect [_ element (ipairs body)]
                            (html element allow-no-escape?)) " ")
            "</" tag-name ">"))))