implement shop

1 files changed, 95 insertions, 0 deletions

diff --git a/macros.fnl b/macros.fnl
new file mode 100644
index 0000000..fdfe17c
--- /dev/null
+++ b/macros.fnl
@@ -0,0 +1,95 @@
+(local entity-replacements {"&" "&" ; must be first!
+                            "<" "&lt;"
+                            ">" "&gt;"
+                            "\"" "&quot;"})
+
+(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"))
+            (add (. item 2))
+          (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 tag) (add ">"))
+      (add "\n"))
+    result)
+
+  `(.. ,(table.unpack (compress-compiled-html (inner-compile html)))))
+
+{: compile-html}