Implements a hiccup-like compiler into js templates

jst.clj

(ns jst
  (:require [camel-snake-kebab.core :as csk]
            [clojure.string :as string]
            [hyperfiddle.rcf :refer [tests]]))

(hyperfiddle.rcf/enable!)
;; Implements a hiccup compiler into js-template. 
;;
;; Usage: (jst cljs-symbol? template-fn? hiccup), where:
;;  cljs-symbol - what symbol implements js-template in cljs (default: shadow.cljs.modern/js-template)
;;  template-fn? - if extra javascript template fn required, can be passed in. E.g. lit/html. Default nil.
;;  hiccup - a usual hiccup with a few nuances in how props are rendered. 
;;
;; Returns: unevaluated function call to js-template with as much strings merged as possible to improve browser performance. Browser caches
;; template strings and then skips part of tree render when they're unchanged. (see: https://codelabs.developers.google.com/codelabs/lit-2-for-react-devs#11)

;; Attribute nuances: 
;; Main difference is that keys for regular attributes must be string instead of keywords. keywords args reserved for special lib implementations (now for lit)
;;
;; Supported map keys:
;; "attributes" - will be treated as a simple attribute value and translated with a name. Expression must evaluate to string.
;; "?boolean" - will be transformed into lit's ?boolean expressions. Expression should evaluate to true/false.
;; :on-* - will be translated into @* event handler by lit.
;; :keyword-case - will be translated into .keywordCase and pass js property as-is. This is supported by libraries like lit.
;; :jst/no-args - takes a vector of items that will be just dropped into a tag without argument tag. E.g. lit directives.

(def default-jst-config {:this-sym         'this
                         :cljs-template-fn 'shadow.cljs.modern/js-template
                         :js-template-fn   nil})

(def ^:dynamic *jst-config* default-jst-config)
(def ^:dynamic *jst-handlers* {})
(def ^:dynamic *jst-env* {})


(defn emit-jst
  "Emits final js-template code from a mixed vector of strings and clojure code (forms or symbols). Flattens any nested vectors and merges consecutive strings."
  [template-parts]
  (let [strings-and-forms (loop [to-merge template-parts
                                 merged   []]
                            (if (zero? (count to-merge))
                              merged
                              (let [[next & rem] to-merge]
                                (cond
                                  ;; when two strings in a row
                                  (and (string? (peek merged)) (string? next))
                                  (recur rem (assoc merged (dec (count merged)) (str (peek merged) next)))

                                  (and (vector? next) (seq rem)) ;; case for children
                                  (recur (into next rem) merged)

                                  (and (vector? next) (empty? rem)) ;; avoid endless loop with (into [x] nil)
                                  (recur next merged)

                                  :else
                                  (recur rem (conj merged (if (string? next) (string/trim next) next)))))))
        js-template-fn    (get *jst-config* :cljs-template-fn)
        template-literal  (get *jst-config* :js-template-fn)]
    (if (some? template-literal)
      `(~js-template-fn ~template-literal ~@strings-and-forms)
      `(~js-template-fn ~@strings-and-forms))))


(tests
 "Basic emitter with empty args"
 (emit-jst ["<div" [] ">" ["Hello-world"] "</div>"]) := '(shadow.cljs.modern/js-template "<div>Hello-world</div>")

 "Emitter with templater"
 (binding [*jst-config* (merge *jst-config* {:js-template-fn 'lit/html})]
   (emit-jst ["<div" [] ">" ["Hello-world"] "</div>"]) := '(shadow.cljs.modern/js-template lit/html "<div>Hello-world</div>"))

 "With non-trivial attributes and children"
 (emit-jst ["<div" [" " ["style=" "\"margin:10px;padding:10px;\"" " " "@click=" '(fn [e] e) " " ".someProp=" {:a 1} " " "?checked=" true]]  ">"
            [["<div" [] ">" ["Hello-world"] "</div>"]
             ["<div" [] ">" ['(get-state comp)] "</div>"]] "</div>"])
 := '(shadow.cljs.modern/js-template
      "<div style=\"margin:10px;padding:10px;\" @click="
      (fn [e] e)
      ".someProp="
      {:a 1}
      "?checked="
      true
      "><div>Hello-world</div><div>"
      (get-state comp)
      "</div></div>")

 "Vector of vectors is properly emitted"
 (emit-jst [["<div>" "1" "</div>"] ["<div>" "2" "</div>"] ["<div>" "3" "</div>"]]))


(declare compile-jst)
(declare emit-jst-fn)


(defn form-name
  "Return name of the first function inside clojure expression."
  [form]
  (when (and (seq? form) (symbol? (first form)))
    (name (first form))))


(defmulti compile-form
  "Compile standard forms into js-template"
  (fn [form]
    (if (vector? form) "vector" (form-name form))))


(defn drop-last-vec
  [vec]
  (if (> (count vec) 0)
    (subvec vec 0 (dec (count vec)))
    vec))


(defn render-tag-attributes
  "Returns a vector of strings/forms for tag attributes.
   Supported properties keys:
   \"attributes\" - will be treated as a simple attribute value and translated with a name. Expression must evaluate to string.
   \"?boolean\" - will be transformed into lit's ?boolean expressions. Expression should evaluate to true/false.
   :on-* - will be translated into @* event handler by lit.
   :property - will be translated into .property of lit. Todo figure out camelCasing and turning it back into keyword within component. 
   :jst/no-args - takes a vector of items that will be just dropped into a tag without argument tag. E.g. lit directives."
  [props-map]
  (let [make-styles (fn [styles]
                      (if (map? styles)
                        (reduce (fn [acc [attr value]]
                                  (str acc attr ":" value ";"))
                                ""
                                styles)
                        styles))
        attr-type?  (fn [attr]
                      (let [string-arg?  (string? attr)
                            keyword-arg? (keyword? attr)]
                        (cond
                          (= attr :jst/no-args)
                          :no-arg

                          (= (name attr) "style")
                          :style-tag

                          string-arg?
                          :html-attribute

                          (and keyword-arg? (string/starts-with? (name attr) "on-"))
                          :handler

                          keyword-arg?
                          :js-property

                          :else
                          (throw (IllegalArgumentException. (str "Unknown attribute: " attr))))))
        render-attr (fn [attr attr-type]
                      (case attr-type
                        :html-attribute
                        (str attr "=")

                        :no-arg
                        ""

                        :js-property
                        (str "." (csk/->camelCase (name attr)) "=")

                        :handler ;; this is lit specific. Do we need it here? regular web-component requires setting handler through js.
                        (str "@" (subs (name attr) 3) "=")

                        :style-tag
                        "style="))
        render-val  (fn [val attr-type]
                      ;; vals can be a few different things
                      (let [val-result (cond
                                         ;; properties are the only items that can accept non-string objects. 
                                         ;; js-objs - passed as is. 
                                         (= attr-type :js-property)
                                         val

                                         ;; style attribute - serialize map into string.
                                         (= attr-type :style-tag)
                                         (make-styles val)


                                         (= attr-type :no-arg)
                                         (->> (interleave val (repeat " "))
                                              (drop-last)
                                              (into []))

                                         ;; symbols - go unchanged, unless they're in handlers and known from config, then bound to the this-sym.
                                         (and (symbol? val) (= attr-type :handler))
                                         (if (contains? (:methods *jst-config*) val)
                                           `(~(symbol (str ".-" val)) ~(:this-sym *jst-config*))
                                           val)

                                         ;; symbols go unchanged.
                                         (symbol? val)
                                         val

                                         ;; clojure-forms or fn go unchanged.
                                         (list? val)
                                         val

                                         (boolean? val)
                                         val

                                         ;; rest - attempt to serialize to string. 
                                         :else
                                         (str val))]
                        (if (string? val-result)
                          (str "\"" val-result "\"")
                          val-result)))]
    (-> (reduce (fn [acc [attr val]]
                  (let [attr-type (attr-type? attr)]
                    (conj acc (render-attr attr attr-type) (render-val val attr-type) " ")))
                []
                props-map)
        (drop-last-vec))))


(tests
 "regular symbol in handler attribute"
 (render-tag-attributes {:on-click 'test}) := ["@click=" 'test]

 "known symbol in handler attribute bound to class"
 (binding [*jst-config* (merge default-jst-config {:methods #{'test}})]
   (render-tag-attributes {:on-click 'test})) := ["@click=" '(.-test this)]

 "known symbol in handler and non-default this-sym"
 (binding [*jst-config* (merge default-jst-config {:methods #{'test} :this-sym 'comp})]
   (render-tag-attributes {:on-click 'test})) := ["@click=" '(.-test comp)]

 "symbol somewhere"
 (render-tag-attributes {"data-attr" 'test}) := ["data-attr=" 'test]

 "strings should be wrapped with \""
 (render-tag-attributes {"str-attr" "string"}) := ["str-attr=" "\"string\""]

 "Js-properties"
 (render-tag-attributes {:some-property {:a 1}}) := [".someProperty=" {:a 1}]

 "Js-properties-2"
 (render-tag-attributes {:some-property 'abs}) := [".someProperty=" 'abs]

 "Clojure-fn"
 (render-tag-attributes {:on-hover '(fn [e] e)}) := ["@hover=" '(fn [e] e)]

 "boolean"
 (render-tag-attributes {"?checked" true}) := ["?checked=" true]

 "style keyword tag"
 (render-tag-attributes {:style {"margin" "10px"}}) := ["style=" "\"margin:10px;\""]

 "style string tag"
 (render-tag-attributes {"style" {"margin" "10px" "padding" "10px"}}) := ["style=" "\"margin:10px;padding:10px;\""]

 "multiple args"
 (render-tag-attributes {"style" {"margin" "10px" "padding" "10px"}
                         :on-click '(fn [e] e)
                         :some-prop {:a 1}
                         "?checked" true}) := ["style=" "\"margin:10px;padding:10px;\"" " " "@click=" '(fn [e] e) " " ".someProp=" {:a 1} " " "?checked=" true]


 "no-arg"
 (render-tag-attributes {:jst/no-args ['(fn [e] e) '(fn [d] d)]}) := ["" ['(fn [e] e) " " '(fn [d] d)]])


(defn compile-component-fn
  "Compiles component function"
  [comp-fn props-map children-vec]
  ;; todo: support 
  ;; 1. We should probably emit a function that calls component constructor. 
  ;; 2. The main question what to do with children. They probably need to be compiled into js-template and wrapped with template. 
  ;; decide later when component composition and slot model is more clear. 
  )


(defn compile-html-tag
  "Compiles html tag. [:keyword props-map children]"
  [tag props-map children-vec]
  (vector (str "<" (name tag)) (if (seq props-map) [" " (render-tag-attributes props-map)] "") ">"
          (mapv compile-jst children-vec)
          (str "</" (name tag) ">")))


(defn compile-element
  "Compiles vector of [tag props? & children].
   
   The result of compilation of an element is a mixed vector of strings & clojure forms. Sub-vectors are allowed
   and will be just flattened in the final optimization step. Lists treated as clojure forms and won't be evaluated. Same
   goes for symbols. "
  [content]
  (let [tag      (first content)
        props?   (map? (second content))
        props    (if props? (second content) {})
        children (subvec content (if props? 2 1))]
    (cond
      (keyword? tag)
      (compile-html-tag tag props children)

      (symbol? tag)
      (compile-component-fn tag props children)

      :else
      (throw (IllegalArgumentException. (str "Unknown element: " [tag props "& children"]))))))


(def supported-forms #{"do" "let" "let*" "letfn*" "for" "if" "when" "when-some"
                       "when-let" "when-first" "when-not" "if-not" "if-some" "if-let"
                       "case" "condp" "cond"})
;; forms skipped from hiccup/hicada due to unclear use case: 
;; array, hicada's special for optimization for 1 binding, 

(defn control-form?
  "Some forms like for or if control template output. This function tests if this is a form that compiler knows about? "
  [form]
  (contains? supported-forms (form-name form)))


(defn compile-jst
  "Compiles jst into a vector of strings, symbols, and clojure expressions. Clojure expressions & symbols will be passed to js-template as params
   and strings will be merged and used as strings part of js-template."
  [content]
  ;; 3 cases here:
  ;; 1. We're working with element vector [tag/cmp props? & children]
  ;; 2. We're working with some clojure form that we know about anything that starts with (symbol & body)
  ;; 3. We have some kind of literal like string, symbol, or whatever else we don't know of. 
  (cond
    (and (vector? content) (vector? (first content)))
    (mapv compile-jst content)

    (vector? content)
    (compile-element content)

    (control-form? content)
    (compile-form content)

    :else content))


(tests
 "empty props and string"
 (compile-html-tag :div {} ["Hello-world"]) := ["<div" "" ">" ["Hello-world"] "</div>"]

 "no children, no props"
 (compile-html-tag :div nil []) := ["<div" "" ">" [] "</div>"])


(defn emit-jst-fn
  "Compiles jst and wraps it into js-template fn with params from config."
  [content]
  (-> content
      (compile-jst)
      (emit-jst)))


(defmethod compile-form "vector"
  [content]
  ;; special case when forms end in hiccup vector, compiles as jst.
  (emit-jst-fn content))

(tests
 (compile-form [:div "Hello, world!"]) := '(shadow.cljs.modern/js-template "<div>Hello, world!</div>"))


(defmethod compile-form "do"
  [[_ & forms]]
  `(do ~@(butlast forms) ~(emit-jst-fn (last forms))))

(tests
 (compile-form '(do (js/console.log "Test") [:div "Hello, world!"])) := '(do (js/console.log "Test") (shadow.cljs.modern/js-template "<div>Hello, world!</div>")))


(defmethod compile-form "let"
  [[_ bindings & forms]]
  `(let ~bindings ~@(butlast forms) ~(compile-form (last forms))))

(tests
 (compile-form '(let [a "World!"] [:div (str "Hello, " a)]))
 := '(clojure.core/let [a "World!"] (shadow.cljs.modern/js-template "<div>" (str "Hello, " a) "</div>"))

 (compile-form '(let [a "World!"] (let [b "Hello"] [:div (str b ", " a)])))
 := '(clojure.core/let
      [a "World!"]
       (clojure.core/let [b "Hello"] (shadow.cljs.modern/js-template "<div>" (str b ", " a) "</div>"))))

(defmethod compile-form "let*"
  [[_ bindings & forms]]
  `(let* ~bindings ~@(butlast forms) ~(compile-form (last forms))))

(defmethod compile-form "letfn*"
  [[_ bindings & forms]]
  `(letfn* ~bindings ~@(butlast forms) ~(compile-form (last forms))))


;; seqs should be consumed ok by js templates, but we can probably optimize things a lot by using js.map method on clojure's seq. 
(defmethod compile-form "for"
  [[_ bindings body]]
  `(for ~bindings ~(compile-form body)))

(tests
 (compile-form '(for [a (range 10)] [:ul [:li a]]))
 := '(clojure.core/for [a (range 10)] (shadow.cljs.modern/js-template "<ul><li>" a "</li></ul>")))


(defmethod compile-form "if"
  [[_ condition & body]]
  `(if ~condition ~@(doall (for [x body] (compile-form x)))))


(tests
 (compile-form '(if (true? a)
                  [:div "A-true"]
                  [:div "A-lie"]))
 := '(if (true? a) (shadow.cljs.modern/js-template "<div>A-true</div>") (shadow.cljs.modern/js-template "<div>A-lie</div>"))

 (compile-form '(if (true? a)
                  (let [b (str "Hello, " a "!")]
                    [:div b])
                  (for [x (range 3)]
                    [:div {:style {"padding" "5px"}} (str x "-lie!")])))
 := '(if
      (true? a)
       (clojure.core/let [b (str "Hello, " a "!")] (shadow.cljs.modern/js-template "<div>" b "</div>"))
       (clojure.core/for
        [x (range 3)]
         (shadow.cljs.modern/js-template "<div style=\"padding:5px;\">" (str x "-lie!") "</div>"))))


(defmethod compile-form "when"
  [[_ bindings & body]]
  `(when ~bindings ~@(butlast body) ~(compile-form (last body))))

(tests
 (compile-form '(when (true? a)
                  (js/console.log "test")
                  [:div "Hello, world!"]))
 := '(clojure.core/when (true? a) (js/console.log "test") (shadow.cljs.modern/js-template "<div>Hello, world!</div>")))


(defmethod compile-form "when-some"
  [[_ bindings & body]]
  `(when-some ~bindings ~@(butlast body) ~(compile-form (last body))))

(defmethod compile-form "when-let"
  [[_ bindings & body]]
  `(when-let ~bindings ~@(butlast body) ~(compile-form (last body))))

(defmethod compile-form "when-first"
  [[_ bindings & body]]
  `(when-first ~bindings ~@(butlast body) ~(compile-form (last body))))

(defmethod compile-form "when-not"
  [[_ bindings & body]]
  `(when-not ~bindings ~@(doall (for [x body] (compile-form x)))))

(defmethod compile-form "if-not"
  [[_ bindings & body]]
  `(if-not ~bindings ~@(doall (for [x body] (compile-form x)))))

(defmethod compile-form "if-some"
  [[_ bindings & body]]
  `(if-some ~bindings ~@(doall (for [x body] (compile-form x)))))

(defmethod compile-form "if-let"
  [[_ bindings & body]]
  `(if-let ~bindings ~@(doall (for [x body] (compile-form x)))))


(defmethod compile-form "case"
  [[_ v & cases]]
  `(case ~v
     ~@(doall (mapcat
               (fn [[test hiccup]]
                 (if hiccup
                   [test (compile-form hiccup)]
                   [(compile-form test)]))
               (partition-all 2 cases)))))


(tests
 (compile-form '(case a
                  1 [:div "1"]
                  2 (if (true? b) [:div "2-true"] [:div "2-false"])
                  [:div "else"]))
 := '(clojure.core/case
      a
       1
       (shadow.cljs.modern/js-template "<div>1</div>")
       2
       (if
        (true? b)
         (shadow.cljs.modern/js-template "<div>2-true</div>")
         (shadow.cljs.modern/js-template "<div>2-false</div>"))
       (shadow.cljs.modern/js-template "<div>else</div>")))


(defmethod compile-form "condp"
  [[_ f v & cases]]
  `(condp ~f ~v
     ~@(doall (mapcat
               (fn [[test hiccup]]
                 (if hiccup
                   [test (compile-form hiccup)]
                   [(compile-form test)]))
               (partition-all 2 cases)))))


(defmethod compile-form "cond"
  [[_ & clauses]]
  `(cond ~@(doall
            (mapcat
             (fn [[check expr]] [check (compile-form expr)])
             (partition 2 clauses)))))


(defn compile-js-template
  "Compiles hiccup into js-template"
  [content config _env]
  (binding [*jst-config* (merge default-jst-config config)]
    (emit-jst-fn content)))


(defmacro jst
  "Compiles hiccup to js-template"
  ([content]
   (compile-js-template content {:js-template-fn nil} &env))
  ([template-fn content]
   (compile-js-template content {:js-template-fn template-fn} &env))
  ([template-cljs-sym template-fn content]
   (compile-js-template content {:js-template-fn template-fn
                                 :cljs-template-fn template-cljs-sym} &env)))


(tests
 "The most basic template"
 (macroexpand '(jst lit/html [:div "Hello, world!"])) := '(shadow.cljs.modern/js-template* lit/html "<div>Hello, world!</div>")

 "No literal, with props"
 (macroexpand '(jst [:div {"style"      {"margin"  "10px"
                                         "padding" "10px"}
                           :on-click  '(fn [e] e)
                           :some-prop {:a 1}
                           "?checked"   true}
                     "Hello, world!"]))
 := '(shadow.cljs.modern/js-template*
      "<div style=\"margin:10px;padding:10px;\" @click="
      '(fn [e] e)
      ".someProp="
      {:a 1}
      "?checked="
      true
      ">Hello, world!</div>")


 "Replacing cljs-template-symbol"
 (macroexpand '(jst 'squint.core/js-template
                    lit/html
                    [:div {"style"      {"margin"  "10px"
                                         "padding" "10px"}
                           :on-click  '(fn [e] e)
                           :some-prop {:a 1}
                           "?checked"   true}
                     "Hello, world!"]))
 := '('squint.core/js-template
      lit/html
      "<div style=\"margin:10px;padding:10px;\" @click="
      '(fn [e] e)
      ".someProp="
      {:a 1}
      "?checked="
      true
      ">Hello, world!</div>")


 "Recursive children with some props in body"
 (macroexpand '(jst lit/html [:div {:style {"margin" "10px"}}
                              [:h1 "Hello, world!"]
                              [:div "Today is:" (:date comp)]]))
 := '(shadow.cljs.modern/js-template*
      lit/html
      "<div style=\"margin:10px;\"><h1>Hello, world!</h1><div>Today is:"
      (:date comp)
      "</div></div>")


 "A rather complex markup"
 (macroexpand '(jst lit/html [:div
                              [:h2 "ToDo List"]
                              [:ul {:style {"margin" "10px"}
                                    "class"  "todos"}
                               (todo-render (if hideCompleted
                                              (filter (fn [item]
                                                        (false? (:completed item)))
                                                      listItems)
                                              listItems))]
                              [:input {"id"         "newItem"
                                       "aria-label" "New Item"}]
                              [:button {:on-click (.-add-todo this)} "Add ToDo"]
                              [:label
                               [:input {"type"       "checkbox"
                                        :on-change (.-toggle-completed-todos this)}
                                "Hide Completed"]]]))
 := '(shadow.cljs.modern/js-template*
      lit/html
      "<div><h2>ToDo List</h2><ul style=\"margin:10px;\" class=\"todos\">"
      (todo-render (if hideCompleted (filter (fn [item] (false? (:completed item))) listItems) listItems))
      "</ul><input id=\"newItem\" aria-label=\"New Item\"></input><button @click="
      (.-add-todo this)
      ">Add ToDo</button><label><input type=\"checkbox\" @change="
      (.-toggle-completed-todos this)
      ">Hide Completed</input></label></div>")

 "Multiple children, no fragments required"
 (macroexpand '(jst lit/html
                    [[:h2 "ToDo List"]
                     [:ul {:style {"margin" "10px"}
                           "class"  "todos"}
                      (todo-render (if hideCompleted
                                     (filter (fn [item]
                                               (false? (:completed item)))
                                             listItems)
                                     listItems))]
                     [:input {"id"         "newItem"
                              "aria-label" "New Item"}]
                     [:button {:on-click (.-add-todo this)} "Add ToDo"]
                     [:label
                      [:input {"type"       "checkbox"
                               :on-change (.-toggle-completed-todos this)}
                       "Hide Completed"]]]))
 := '(shadow.cljs.modern/js-template*
      lit/html
      "<h2>ToDo List</h2><ul style=\"margin:10px;\" class=\"todos\">"
      (todo-render (if hideCompleted (filter (fn [item] (false? (:completed item))) listItems) listItems))
      "</ul><input id=\"newItem\" aria-label=\"New Item\"></input><button @click="
      (.-add-todo this)
      ">Add ToDo</button><label><input type=\"checkbox\" @change="
      (.-toggle-completed-todos this)
      ">Hide Completed</input></label>")
 
 "Tests Completed"
 )