├── Makefile ├── deps.edn ├── system.properties ├── .gitignore ├── README.md ├── src └── hicada │ ├── util.cljc │ ├── input.cljs │ ├── normalize.cljc │ ├── interpreter.cljc │ └── compiler.clj ├── project.clj └── LICENSE /Makefile: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /deps.edn: -------------------------------------------------------------------------------- 1 | {:paths ["src"]} 2 | -------------------------------------------------------------------------------- /system.properties: -------------------------------------------------------------------------------- 1 | java.runtime.version=1.8 2 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | pom.xml 2 | pom.xml.asc 3 | *.jar 4 | *.class 5 | **.swp 6 | **.swo 7 | **.jar 8 | **.class 9 | **.#** 10 | /lib/ 11 | /classes/ 12 | /target/ 13 | /checkouts/ 14 | .lein-deps-sum 15 | .lein-repl-history 16 | .lein-plugins/ 17 | .lein-failures 18 | .nrepl-port 19 | .nrepl-history 20 | /.lein-* 21 | /resources/public/ 22 | /out 23 | .idea/ 24 | *.iml 25 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # A Fast CLJS Hiccup Compiler 2 | 3 | This is a fork of [Hicada](https://github.com/rauhs/hicada) that: 4 | 5 | + warns about runtime interpretation, which nudges you to write faster code 6 | + uses type inference to avoid interpretation of values that can be passed directly to React 7 | 8 | For background, see [this article](https://kevinlynagh.com/notes/fast-cljs-react-templates/) and [this minimal usage example repo](https://github.com/lynaghk/cljs-hiccup-inference). 9 | 10 | There will be no versioned releases of this fork, as I may wish to adjust the API to suit my needs. 11 | I suggest depending on the code via git submodule or pinned `deps.edn` and reading all commits. 12 | -------------------------------------------------------------------------------- /src/hicada/util.cljc: -------------------------------------------------------------------------------- 1 | (ns hicada.util 2 | (:require 3 | [clojure.string :as str] 4 | [clojure.set :refer [rename-keys]])) 5 | 6 | (defn join-classes-js 7 | "Joins strings space separated" 8 | ([] "") 9 | ([& xs] 10 | (let [strs (->> (repeat (count xs) "~{}") 11 | (interpose ",") 12 | (apply str))] 13 | (list* 'js* (str "[" strs "].join(' ')") xs)))) 14 | 15 | (defn camel-case 16 | "Returns camel case version of the key, e.g. :http-equiv becomes :httpEquiv." 17 | [k] 18 | (if (or (keyword? k) 19 | (string? k) 20 | (symbol? k)) 21 | (let [[first-word & words] (str/split (name k) #"-")] 22 | (if (or (empty? words) 23 | (= "aria" first-word) 24 | (= "data" first-word)) 25 | k 26 | (-> (map str/capitalize words) 27 | (conj first-word) 28 | str/join 29 | keyword))) 30 | k)) 31 | 32 | (defn camel-case-keys 33 | "Recursively transforms all map keys into camel case." 34 | [m] 35 | (cond 36 | (map? m) 37 | (reduce-kv 38 | (fn [m k v] 39 | (assoc m (camel-case k) v)) 40 | {} m) 41 | ;; React native accepts :style [{:foo-bar ..} other-styles] so camcase those keys: 42 | (vector? m) 43 | (mapv camel-case-keys m) 44 | :else 45 | m)) 46 | 47 | (defn element? 48 | "- is x a vector? 49 | AND 50 | - first element is a keyword?" 51 | [x] 52 | (and (vector? x) (keyword? (first x)))) 53 | 54 | (defn join-classes 55 | "Join the `classes` with a whitespace." 56 | [classes] 57 | (->> (map #(if (string? %) % (seq %)) classes) 58 | (flatten) 59 | (remove nil?) 60 | (str/join " "))) 61 | 62 | (defn controlled-input-class 63 | "Returns the React class that is to be used for this component or nil if it's not a controlled 64 | input." 65 | [type attrs] 66 | (when (keyword? type) 67 | (case (name type) 68 | "input" (cond 69 | (:checked attrs) '(hicada.input/wrapped-checked) 70 | (:value attrs) '(hicada.input/wrapped-input) 71 | :else nil) 72 | "select" (when (:value attrs) '(hicada.input/wrapped-select)) 73 | "textarea" (when (:value attrs) '(hicada.input/wrapped-textarea)) 74 | nil))) 75 | 76 | 77 | 78 | 79 | (defn html-to-dom-attrs 80 | "Converts all HTML attributes to their DOM equivalents." 81 | [attrs] 82 | (rename-keys (camel-case-keys attrs) 83 | {:class :className 84 | :for :htmlFor})) 85 | -------------------------------------------------------------------------------- /src/hicada/input.cljs: -------------------------------------------------------------------------------- 1 | (ns hicada.input 2 | " 3 | DO NOT USE! This ns will be unmainted! 4 | 5 | 6 | Code for controlled input. 7 | Copied form sablono. 8 | " 9 | (:require 10 | [clojure.string :refer [blank? join]] 11 | [goog.object :as object] 12 | [goog.functions :as gf])) 13 | 14 | (defn update-state 15 | "Updates the state of the wrapped input element." 16 | [component next-props property value] 17 | (let [on-change (object/getValueByKeys component "state" "onChange") 18 | next-state #js{}] 19 | (object/extend next-state next-props #js {:onChange on-change}) 20 | (object/set next-state property value) 21 | (.setState component next-state))) 22 | 23 | (defn wrap-form-element [element property] 24 | (let [ctor (fn [props] 25 | (this-as this 26 | (set! (.-state this) 27 | (let [state #js {}] 28 | (->> #js{:onChange (goog/bind (object/get this "onChange") this)} 29 | (object/extend state props)) 30 | state)) 31 | (.call js/React.Component this props)))] 32 | (set! (.-displayName ctor) (str "wrapped-" element)) 33 | (goog/inherits ctor js/React.Component) 34 | (specify! (.-prototype ctor) 35 | Object 36 | (onChange [this event] 37 | (when-let [handler (.-onChange (.-props this))] 38 | (handler event) 39 | (update-state 40 | this (.-props this) property 41 | (object/getValueByKeys event "target" property)))) 42 | 43 | (componentWillReceiveProps [this new-props] 44 | (let [state-value (object/getValueByKeys this "state" property) 45 | element-value (object/get (js/ReactDOM.findDOMNode this) property)] 46 | ;; On IE, onChange event might come after actual value of 47 | ;; an element have changed. We detect this and render 48 | ;; element as-is, hoping that next onChange will 49 | ;; eventually come and bring our modifications anyways. 50 | ;; Ignoring this causes skipped letters in controlled 51 | ;; components 52 | ;; https://github.com/facebook/react/issues/7027 53 | ;; https://github.com/reagent-project/reagent/issues/253 54 | ;; https://github.com/tonsky/rum/issues/86 55 | ;; TODO: Find a better solution, since this conflicts 56 | ;; with controlled/uncontrolled inputs. 57 | ;; https://github.com/r0man/sablono/issues/148 58 | (if (not= state-value element-value) 59 | (update-state this new-props property element-value) 60 | (update-state this new-props property (object/get new-props property))))) 61 | 62 | (render [this] 63 | (js/React.createElement element (.-state this)))) 64 | ctor)) 65 | 66 | (def wrapped-input (gf/cacheReturnValue 67 | #(wrap-form-element "input" "value"))) 68 | (def wrapped-checked (gf/cacheReturnValue 69 | #(wrap-form-element "input" "checked"))) 70 | (def wrapped-select (gf/cacheReturnValue 71 | #(wrap-form-element "select" "value"))) 72 | (def wrapped-textarea (gf/cacheReturnValue 73 | #(wrap-form-element "textarea" "value"))) 74 | 75 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject hicada "0.1.8" 2 | :description "A hiccup compiler for clojurescript" 3 | :url "http://www.github.com/rauhs/hicada" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html"} 6 | 7 | :source-paths ["src" "env/dev/clj"] 8 | 9 | :profiles {:dev 10 | {:source-paths ["env/dev/clj"] 11 | :dependencies [[figwheel-sidecar "0.5.4-6" :exclusions [org.clojure/clojure]] 12 | [com.cemerick/piggieback "0.2.2" :exclusions [org.clojure/clojure]] 13 | [org.clojure/tools.nrepl "0.2.10"]] 14 | :repl-options {:nrepl-middleware [cemerick.piggieback/wrap-cljs-repl] 15 | :init-ns hicada.dev 16 | :welcome (println "TODO")}}} 17 | 18 | 19 | :dependencies [[org.clojure/clojure "1.9.0" :scope "provided"] 20 | [org.clojure/clojurescript "1.9.229" :classifier "aot" :scope "provided"] 21 | [com.cognitect/transit-clj "0.8.300" :scope "provided"] 22 | [figwheel-sidecar "0.5.10" :scope "provided"]] 23 | 24 | :repositories [["clojars" {:sign-releases false}]] 25 | :plugins [[lein-cljsbuild "1.1.4"] 26 | [lein-figwheel "0.5.13"] 27 | [lein-environ "1.0.0"] 28 | [lein-ring "0.9.1"]] 29 | 30 | ;; Global exclusions are applied across the board, as an alternative 31 | ;; to duplication for multiple dependencies with the same excluded libraries. 32 | :exclusions [org.clojure/tools.nrepl] 33 | 34 | :uberjar-name "hicada.jar" 35 | 36 | :jvm-opts ["-Xverify:none"] 37 | 38 | :clean-targets ^{:protect false} ["resources/public/js"] 39 | 40 | :cljsbuild 41 | {:builds 42 | {:dev {:source-paths ["src/cljs" "demo"] 43 | :figwheel true 44 | :compiler {:output-to "resources/public/js/app.js" 45 | :output-dir "resources/public/js/out" 46 | :asset-path "js/out" 47 | :optimizations :none 48 | :pretty-print true}} 49 | :prod_debug {:source-paths ["src/cljs"] 50 | :compiler {:output-to "resources/public/cljs/production_debug/app.js" 51 | :output-dir "resources/public/cljs/production_debug/out" 52 | :asset-path "js/out" 53 | :output-wrapper false 54 | :pseudo-names true 55 | :optimizations :advanced 56 | :pretty-print true}} 57 | :demo {:source-paths ["src/cljs" "demo"] 58 | :compiler {:output-to "resources/public/cljs/demo/app.js" 59 | :output-dir "resources/public/cljs/demo/out" 60 | :asset-path "js/out" 61 | :output-wrapper false 62 | ;;:static-fns true 63 | :pseudo-names false 64 | :optimizations :simple 65 | :pretty-print false}} 66 | :prod {:source-paths ["src/cljs"] 67 | :compiler {:output-to "resources/public/cljs/production/app.js" 68 | :output-dir "resources/public/cljs/production/out" 69 | :asset-path "js/out" 70 | :output-wrapper false 71 | :static-fns true ;; should be true by default 72 | :optimizations :advanced 73 | :pretty-print false}}}} 74 | 75 | :jar-exclusions [#"resources" #"demo" #"docs" #"env" #"public" #"test" #"main" #"\.swp" #"templates"] 76 | :uberjar {:hooks [leiningen.cljsbuild] 77 | ;;:hooks [leiningen.cljsbuild] 78 | ;;:env {:production true} 79 | :aot :all 80 | ;;:resource-paths [];; no resources 81 | :omit-source false 82 | :source-paths ["src/cljs"]}) 83 | -------------------------------------------------------------------------------- /src/hicada/normalize.cljc: -------------------------------------------------------------------------------- 1 | (ns hicada.normalize 2 | " 3 | Mostly from sablono + hiccup project. 4 | " 5 | (:require 6 | [hicada.util :as util])) 7 | 8 | (defn compact-map 9 | "Removes all map entries where the value of the entry is empty." 10 | [m] 11 | (reduce 12 | (fn [m k] 13 | (let [v (get m k)] 14 | (if (empty? v) 15 | (dissoc m k) m))) 16 | m (keys m))) 17 | 18 | (defn class-name 19 | [x] 20 | (cond 21 | (string? x) x 22 | (keyword? x) (name x) 23 | :else x)) 24 | 25 | (defn vec+stringify-class 26 | "Normalize `class` into a vector of classes (keywords will be stringified)." 27 | [klass] 28 | (cond 29 | (nil? klass) 30 | nil 31 | 32 | (list? klass) 33 | (if (symbol? (first klass)) 34 | [klass] 35 | (map class-name klass)) 36 | 37 | (symbol? klass) 38 | [klass] 39 | 40 | (string? klass) 41 | [klass] 42 | 43 | (keyword? klass) 44 | [(class-name klass)] 45 | 46 | (or (set? klass) 47 | (sequential? klass)) 48 | (mapv class-name klass) 49 | 50 | (map? klass) 51 | [klass] 52 | 53 | :else klass)) 54 | #_(vec+stringify-class :foo) 55 | 56 | (defn attributes 57 | "Normalize the :class, :class-name and :className elements" 58 | [attrs] 59 | (reduce (fn [attrs kw] 60 | (if-some [m (get attrs kw)] 61 | (-> attrs 62 | (dissoc kw) 63 | (update :class (fnil into []) (vec+stringify-class m))) 64 | attrs)) 65 | attrs [:class :className :class-name])) 66 | 67 | (defn merge-with-class 68 | "Like clojure.core/merge but concatenate :class entries." 69 | [m0 m1] 70 | (let [m0 (attributes m0) 71 | m1 (attributes m1) 72 | classes (into [] (comp (mapcat :class)) [m0 m1])] 73 | (cond-> (conj m0 m1) 74 | (not (empty? classes)) 75 | (assoc :class classes)))) 76 | #_(merge-with-class {:class "a"} {:class ["b"]}) 77 | 78 | (defn strip-css 79 | "Strip the # and . characters from the beginning of `s`." 80 | [s] 81 | (when (some? s) 82 | (cond 83 | (.startsWith s ".") (subs s 1) 84 | (.startsWith s "#") (subs s 1) 85 | :else s))) 86 | #_(strip-css "#foo") 87 | #_(strip-css ".foo") 88 | 89 | (defn match-tag 90 | "Match `s` as a CSS tag and return a vector of tag name, CSS id and 91 | CSS classes." 92 | [s] 93 | (let [matches (re-seq #"[#.]?[^#.]+" (subs (str s) 1)) 94 | [tag-name names] 95 | (cond (empty? matches) 96 | (throw (ex-info (str "Can't match CSS tag: " s) {:tag s})) 97 | (#{\# \.} (ffirst matches)) ;; shorthand for div 98 | ["div" matches] 99 | :default 100 | [(first matches) (rest matches)])] 101 | [(keyword tag-name) 102 | (first (map strip-css (filter #(= \# (first %1)) names))) 103 | (vec (map strip-css (filter #(= \. (first %1)) names)))])) 104 | #_(match-tag :.foo.bar#some-id) 105 | #_(match-tag :foo/span.foo.bar#some-id.hi) 106 | 107 | (defn children 108 | "Normalize the children of a HTML element." 109 | [x] 110 | (->> (cond 111 | (string? x) 112 | (list x) 113 | 114 | (util/element? x) 115 | (list x) 116 | 117 | (and (list? x) 118 | (symbol? x)) 119 | (list x) 120 | 121 | (list? x) 122 | x 123 | 124 | (and (sequential? x) 125 | (sequential? (first x)) 126 | (not (string? (first x))) 127 | (not (util/element? (first x))) 128 | (= (count x) 1)) 129 | (children (first x)) 130 | 131 | (sequential? x) 132 | x 133 | :else (list x)) 134 | (filterv some?))) 135 | 136 | (defn element 137 | "Given: 138 | [:div.x.y#id (other)] 139 | Returns: 140 | [:div {:id \"id\" 141 | :class [\"x\" \"y\"]} 142 | (other)]" 143 | [[tag & content]] 144 | (when (not (or (keyword? tag) (symbol? tag) (string? tag))) 145 | (throw (ex-info (str tag " is not a valid element name.") {:tag tag :content content}))) 146 | (let [[tag id klass] (match-tag tag) 147 | tag-attrs (compact-map {:id id :class klass}) 148 | map-attrs (first content)] 149 | (if (map? map-attrs) 150 | [tag 151 | (merge-with-class tag-attrs map-attrs) 152 | (children (next content))] 153 | [tag 154 | (attributes tag-attrs) 155 | (children content)]))) 156 | #_(element [:div#foo 'a]) 157 | #_(element [:div.a#foo]) 158 | #_(element [:h1.b {:className "a"}]) 159 | 160 | -------------------------------------------------------------------------------- /src/hicada/interpreter.cljc: -------------------------------------------------------------------------------- 1 | (ns hicada.interpreter 2 | (:require #?(:cljs [goog.object :as object]) 3 | [clojure.string :as str] 4 | [clojure.string :refer [blank? join]] 5 | [hicada.normalize :as normalize] 6 | hicada.input 7 | [hicada.util :as util])) 8 | 9 | (defprotocol IInterpreter 10 | (interpret [this] "Interpret a Clojure data structure as a React fn call.")) 11 | 12 | #?(:cljs (defn update-state 13 | "Updates the state of the wrapped input element." 14 | [component next-props property value] 15 | (let [on-change (object/getValueByKeys component "state" "onChange") 16 | next-state #js {}] 17 | (object/extend next-state next-props #js {:onChange on-change}) 18 | (object/set next-state property value) 19 | (.setState component next-state)))) 20 | 21 | ;; A hack to force input elements to always update itself immediately, 22 | ;; without waiting for requestAnimationFrame. 23 | 24 | #?(:cljs 25 | (defn wrap-form-element [element property] 26 | (let [ctor (fn [props] 27 | (this-as this 28 | (set! (.-state this) 29 | (let [state #js {}] 30 | (->> #js {:onChange (goog.bind (object/get this "onChange") this)} 31 | (object/extend state props)) 32 | state)) 33 | (.call js/React.Component this props)))] 34 | (set! (.-displayName ctor) (str "wrapped-" element)) 35 | (goog.inherits ctor js/React.Component) 36 | (specify! (.-prototype ctor) 37 | Object 38 | (onChange [this event] 39 | (when-let [handler (.-onChange (.-props this))] 40 | (handler event) 41 | (update-state 42 | this (.-props this) property 43 | (object/getValueByKeys event "target" property)))) 44 | 45 | (componentWillReceiveProps [this new-props] 46 | (let [state-value (object/getValueByKeys this "state" property) 47 | element-value (object/get (js/ReactDOM.findDOMNode this) property)] 48 | ;; On IE, onChange event might come after actual value of 49 | ;; an element have changed. We detect this and render 50 | ;; element as-is, hoping that next onChange will 51 | ;; eventually come and bring our modifications anyways. 52 | ;; Ignoring this causes skipped letters in controlled 53 | ;; components 54 | ;; https://github.com/facebook/react/issues/7027 55 | ;; https://github.com/reagent-project/reagent/issues/253 56 | ;; https://github.com/tonsky/rum/issues/86 57 | ;; TODO: Find a better solution, since this conflicts 58 | ;; with controlled/uncontrolled inputs. 59 | ;; https://github.com/r0man/sablono/issues/148 60 | (if (not= state-value element-value) 61 | (update-state this new-props property element-value) 62 | (update-state this new-props property (object/get new-props property))))) 63 | 64 | (render [this] 65 | (js/React.createElement element (.-state this)))) 66 | ctor))) 67 | 68 | #?(:cljs (def wrapped-input)) 69 | #?(:cljs (def wrapped-checked)) 70 | #?(:cljs (def wrapped-select)) 71 | #?(:cljs (def wrapped-textarea)) 72 | 73 | #?(:cljs (defn lazy-load-wrappers [] 74 | (when-not wrapped-textarea 75 | (set! wrapped-input (wrap-form-element "input" "value")) 76 | (set! wrapped-checked (wrap-form-element "input" "checked")) 77 | (set! wrapped-select (wrap-form-element "select" "value")) 78 | (set! wrapped-textarea (wrap-form-element "textarea" "value"))))) 79 | 80 | (defn ^boolean controlled-input? 81 | "Returns true if `type` and `props` are used a controlled input, 82 | otherwise false." 83 | [type props] 84 | #?(:cljs (and (object? props) 85 | (case type 86 | "input" 87 | (or (exists? (.-checked props)) 88 | (exists? (.-value props))) 89 | "select" 90 | (exists? (.-value props)) 91 | "textarea" 92 | (exists? (.-value props)) 93 | false)))) 94 | 95 | #?(:cljs 96 | (defn element-class 97 | "Returns either `type` or a wrapped element for controlled 98 | inputs." 99 | [type props] 100 | (if (controlled-input? type props) 101 | (do (lazy-load-wrappers) 102 | (case type 103 | "input" 104 | (case (and (object? props) (.-type props)) 105 | "radio" wrapped-checked 106 | "checkbox" wrapped-checked 107 | wrapped-input) 108 | "select" wrapped-select 109 | "textarea" wrapped-textarea 110 | type)) 111 | type))) 112 | 113 | (defn create-element 114 | "Create a React element. Returns a JavaScript object when running 115 | under ClojureScript, and a om.dom.Element record in Clojure." 116 | [type props & children] 117 | #?(:clj nil 118 | :cljs (apply js/React.createElement (element-class type props) props children))) 119 | 120 | (defn attributes [attrs] 121 | #?(:clj (-> (util/html-to-dom-attrs attrs) 122 | (update :className #(some->> % (str/join " ")))) 123 | :cljs (when-let [js-attrs (clj->js (util/html-to-dom-attrs attrs))] 124 | (let [class (.-className js-attrs) 125 | class (if (array? class) (join " " class) class)] 126 | (if (blank? class) 127 | (js-delete js-attrs "className") 128 | (set! (.-className js-attrs) class)) 129 | js-attrs)))) 130 | 131 | (defn- interpret-seq 132 | "Eagerly interpret the seq `x` as HTML elements." 133 | [x] 134 | (into [] (map interpret) x)) 135 | 136 | (defn element 137 | "Render an element vector as a HTML element." 138 | [element] 139 | (let [[type attrs content] (normalize/element element)] 140 | (apply create-element (name type) ;;hicada uses keyword tags, unlike sablono 141 | (attributes attrs) 142 | (interpret-seq content)))) 143 | 144 | (defn- interpret-vec 145 | "Interpret the vector `x` as an HTML element or a the children of an 146 | element." 147 | [x] 148 | (if (util/element? x) 149 | (element x) 150 | (interpret-seq x))) 151 | 152 | (extend-protocol IInterpreter 153 | 154 | #?(:clj clojure.lang.ChunkedCons 155 | :cljs cljs.core.ChunkedCons) 156 | (interpret [this] 157 | (interpret-seq this)) 158 | 159 | ;;TODO: this type extension seems brittle. 160 | #?@(:cljs [cljs.core.Repeat 161 | (interpret [this] 162 | (interpret-seq this))]) 163 | 164 | #?(:clj clojure.lang.PersistentVector$ChunkedSeq 165 | :cljs cljs.core.ChunkedSeq) 166 | (interpret [this] 167 | (interpret-seq this)) 168 | 169 | #?(:clj clojure.lang.Cons 170 | :cljs cljs.core.Cons) 171 | (interpret [this] 172 | (interpret-seq this)) 173 | 174 | #?(:clj clojure.lang.LazySeq 175 | :cljs cljs.core.LazySeq) 176 | (interpret [this] 177 | (interpret-seq this)) 178 | 179 | #?(:clj clojure.lang.PersistentList 180 | :cljs cljs.core.List) 181 | (interpret [this] 182 | (interpret-seq this)) 183 | 184 | #?(:clj clojure.lang.IndexedSeq 185 | :cljs cljs.core.IndexedSeq) 186 | (interpret [this] 187 | (interpret-seq this)) 188 | 189 | #?(:clj clojure.lang.APersistentVector$SubVector 190 | :cljs cljs.core.Subvec) 191 | (interpret [this] 192 | (interpret-vec this)) 193 | 194 | #?(:clj clojure.lang.PersistentVector 195 | :cljs cljs.core.PersistentVector) 196 | (interpret [this] 197 | (interpret-vec this)) 198 | 199 | #?(:clj Object :cljs default) 200 | (interpret [this] 201 | this) 202 | 203 | nil 204 | (interpret [this] 205 | nil)) 206 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Eclipse Public License - v 1.0 2 | 3 | THE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE PUBLIC 4 | LICENSE ("AGREEMENT"). ANY USE, REPRODUCTION OR DISTRIBUTION OF THE PROGRAM 5 | CONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS AGREEMENT. 6 | 7 | 1. DEFINITIONS 8 | 9 | "Contribution" means: 10 | 11 | a) in the case of the initial Contributor, the initial code and documentation 12 | distributed under this Agreement, and 13 | b) in the case of each subsequent Contributor: 14 | i) changes to the Program, and 15 | ii) additions to the Program; 16 | 17 | where such changes and/or additions to the Program originate from and are 18 | distributed by that particular Contributor. A Contribution 'originates' 19 | from a Contributor if it was added to the Program by such Contributor 20 | itself or anyone acting on such Contributor's behalf. Contributions do not 21 | include additions to the Program which: (i) are separate modules of 22 | software distributed in conjunction with the Program under their own 23 | license agreement, and (ii) are not derivative works of the Program. 24 | 25 | "Contributor" means any person or entity that distributes the Program. 26 | 27 | "Licensed Patents" mean patent claims licensable by a Contributor which are 28 | necessarily infringed by the use or sale of its Contribution alone or when 29 | combined with the Program. 30 | 31 | "Program" means the Contributions distributed in accordance with this 32 | Agreement. 33 | 34 | "Recipient" means anyone who receives the Program under this Agreement, 35 | including all Contributors. 36 | 37 | 2. GRANT OF RIGHTS 38 | a) Subject to the terms of this Agreement, each Contributor hereby grants 39 | Recipient a non-exclusive, worldwide, royalty-free copyright license to 40 | reproduce, prepare derivative works of, publicly display, publicly 41 | perform, distribute and sublicense the Contribution of such Contributor, 42 | if any, and such derivative works, in source code and object code form. 43 | b) Subject to the terms of this Agreement, each Contributor hereby grants 44 | Recipient a non-exclusive, worldwide, royalty-free patent license under 45 | Licensed Patents to make, use, sell, offer to sell, import and otherwise 46 | transfer the Contribution of such Contributor, if any, in source code and 47 | object code form. This patent license shall apply to the combination of 48 | the Contribution and the Program if, at the time the Contribution is 49 | added by the Contributor, such addition of the Contribution causes such 50 | combination to be covered by the Licensed Patents. The patent license 51 | shall not apply to any other combinations which include the Contribution. 52 | No hardware per se is licensed hereunder. 53 | c) Recipient understands that although each Contributor grants the licenses 54 | to its Contributions set forth herein, no assurances are provided by any 55 | Contributor that the Program does not infringe the patent or other 56 | intellectual property rights of any other entity. Each Contributor 57 | disclaims any liability to Recipient for claims brought by any other 58 | entity based on infringement of intellectual property rights or 59 | otherwise. As a condition to exercising the rights and licenses granted 60 | hereunder, each Recipient hereby assumes sole responsibility to secure 61 | any other intellectual property rights needed, if any. For example, if a 62 | third party patent license is required to allow Recipient to distribute 63 | the Program, it is Recipient's responsibility to acquire that license 64 | before distributing the Program. 65 | d) Each Contributor represents that to its knowledge it has sufficient 66 | copyright rights in its Contribution, if any, to grant the copyright 67 | license set forth in this Agreement. 68 | 69 | 3. REQUIREMENTS 70 | 71 | A Contributor may choose to distribute the Program in object code form under 72 | its own license agreement, provided that: 73 | 74 | a) it complies with the terms and conditions of this Agreement; and 75 | b) its license agreement: 76 | i) effectively disclaims on behalf of all Contributors all warranties 77 | and conditions, express and implied, including warranties or 78 | conditions of title and non-infringement, and implied warranties or 79 | conditions of merchantability and fitness for a particular purpose; 80 | ii) effectively excludes on behalf of all Contributors all liability for 81 | damages, including direct, indirect, special, incidental and 82 | consequential damages, such as lost profits; 83 | iii) states that any provisions which differ from this Agreement are 84 | offered by that Contributor alone and not by any other party; and 85 | iv) states that source code for the Program is available from such 86 | Contributor, and informs licensees how to obtain it in a reasonable 87 | manner on or through a medium customarily used for software exchange. 88 | 89 | When the Program is made available in source code form: 90 | 91 | a) it must be made available under this Agreement; and 92 | b) a copy of this Agreement must be included with each copy of the Program. 93 | Contributors may not remove or alter any copyright notices contained 94 | within the Program. 95 | 96 | Each Contributor must identify itself as the originator of its Contribution, 97 | if 98 | any, in a manner that reasonably allows subsequent Recipients to identify the 99 | originator of the Contribution. 100 | 101 | 4. COMMERCIAL DISTRIBUTION 102 | 103 | Commercial distributors of software may accept certain responsibilities with 104 | respect to end users, business partners and the like. While this license is 105 | intended to facilitate the commercial use of the Program, the Contributor who 106 | includes the Program in a commercial product offering should do so in a manner 107 | which does not create potential liability for other Contributors. Therefore, 108 | if a Contributor includes the Program in a commercial product offering, such 109 | Contributor ("Commercial Contributor") hereby agrees to defend and indemnify 110 | every other Contributor ("Indemnified Contributor") against any losses, 111 | damages and costs (collectively "Losses") arising from claims, lawsuits and 112 | other legal actions brought by a third party against the Indemnified 113 | Contributor to the extent caused by the acts or omissions of such Commercial 114 | Contributor in connection with its distribution of the Program in a commercial 115 | product offering. The obligations in this section do not apply to any claims 116 | or Losses relating to any actual or alleged intellectual property 117 | infringement. In order to qualify, an Indemnified Contributor must: 118 | a) promptly notify the Commercial Contributor in writing of such claim, and 119 | b) allow the Commercial Contributor to control, and cooperate with the 120 | Commercial Contributor in, the defense and any related settlement 121 | negotiations. The Indemnified Contributor may participate in any such claim at 122 | its own expense. 123 | 124 | For example, a Contributor might include the Program in a commercial product 125 | offering, Product X. That Contributor is then a Commercial Contributor. If 126 | that Commercial Contributor then makes performance claims, or offers 127 | warranties related to Product X, those performance claims and warranties are 128 | such Commercial Contributor's responsibility alone. Under this section, the 129 | Commercial Contributor would have to defend claims against the other 130 | Contributors related to those performance claims and warranties, and if a 131 | court requires any other Contributor to pay any damages as a result, the 132 | Commercial Contributor must pay those damages. 133 | 134 | 5. NO WARRANTY 135 | 136 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, THE PROGRAM IS PROVIDED ON AN 137 | "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, EITHER EXPRESS OR 138 | IMPLIED INCLUDING, WITHOUT LIMITATION, ANY WARRANTIES OR CONDITIONS OF TITLE, 139 | NON-INFRINGEMENT, MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. Each 140 | Recipient is solely responsible for determining the appropriateness of using 141 | and distributing the Program and assumes all risks associated with its 142 | exercise of rights under this Agreement , including but not limited to the 143 | risks and costs of program errors, compliance with applicable laws, damage to 144 | or loss of data, programs or equipment, and unavailability or interruption of 145 | operations. 146 | 147 | 6. DISCLAIMER OF LIABILITY 148 | 149 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, NEITHER RECIPIENT NOR ANY 150 | CONTRIBUTORS SHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT, INCIDENTAL, 151 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING WITHOUT LIMITATION 152 | LOST PROFITS), HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN 153 | CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 154 | ARISING IN ANY WAY OUT OF THE USE OR DISTRIBUTION OF THE PROGRAM OR THE 155 | EXERCISE OF ANY RIGHTS GRANTED HEREUNDER, EVEN IF ADVISED OF THE POSSIBILITY 156 | OF SUCH DAMAGES. 157 | 158 | 7. GENERAL 159 | 160 | If any provision of this Agreement is invalid or unenforceable under 161 | applicable law, it shall not affect the validity or enforceability of the 162 | remainder of the terms of this Agreement, and without further action by the 163 | parties hereto, such provision shall be reformed to the minimum extent 164 | necessary to make such provision valid and enforceable. 165 | 166 | If Recipient institutes patent litigation against any entity (including a 167 | cross-claim or counterclaim in a lawsuit) alleging that the Program itself 168 | (excluding combinations of the Program with other software or hardware) 169 | infringes such Recipient's patent(s), then such Recipient's rights granted 170 | under Section 2(b) shall terminate as of the date such litigation is filed. 171 | 172 | All Recipient's rights under this Agreement shall terminate if it fails to 173 | comply with any of the material terms or conditions of this Agreement and does 174 | not cure such failure in a reasonable period of time after becoming aware of 175 | such noncompliance. If all Recipient's rights under this Agreement terminate, 176 | Recipient agrees to cease use and distribution of the Program as soon as 177 | reasonably practicable. However, Recipient's obligations under this Agreement 178 | and any licenses granted by Recipient relating to the Program shall continue 179 | and survive. 180 | 181 | Everyone is permitted to copy and distribute copies of this Agreement, but in 182 | order to avoid inconsistency the Agreement is copyrighted and may only be 183 | modified in the following manner. The Agreement Steward reserves the right to 184 | publish new versions (including revisions) of this Agreement from time to 185 | time. No one other than the Agreement Steward has the right to modify this 186 | Agreement. The Eclipse Foundation is the initial Agreement Steward. The 187 | Eclipse Foundation may assign the responsibility to serve as the Agreement 188 | Steward to a suitable separate entity. Each new version of the Agreement will 189 | be given a distinguishing version number. The Program (including 190 | Contributions) may always be distributed subject to the version of the 191 | Agreement under which it was received. In addition, after a new version of the 192 | Agreement is published, Contributor may elect to distribute the Program 193 | (including its Contributions) under the new version. Except as expressly 194 | stated in Sections 2(a) and 2(b) above, Recipient receives no rights or 195 | licenses to the intellectual property of any Contributor under this Agreement, 196 | whether expressly, by implication, estoppel or otherwise. All rights in the 197 | Program not expressly granted under this Agreement are reserved. 198 | 199 | This Agreement is governed by the laws of the State of New York and the 200 | intellectual property laws of the United States of America. No party to this 201 | Agreement will bring a legal action under this Agreement more than one year 202 | after the cause of action arose. Each party waives its rights to a jury trial in 203 | any resulting litigation. 204 | -------------------------------------------------------------------------------- /src/hicada/compiler.clj: -------------------------------------------------------------------------------- 1 | (ns hicada.compiler 2 | " 3 | Hicada - Hiccup compiler aus dem Allgaeu 4 | 5 | NOTE: The code for has been forked like this: 6 | weavejester/hiccup -> r0man/sablono -> Hicada. 7 | 8 | Note about :array-children? : 9 | Go read the React.createElement() function, it's very short and easy to understand. 10 | Do you see how the children are just copied from the arguments and then just put into 11 | props.children? This is exactly what :array-children? avoids. It's completely safe to do. 12 | 13 | Dev Note: Do NOT use any laziness here! Not when generating code! Or it won't pick up 14 | the ^:dynamic config anymore!" 15 | (:refer-clojure :exclude [compile]) 16 | (:require 17 | cljs.analyzer 18 | [hicada.normalize :as norm] 19 | [hicada.util :as util])) 20 | 21 | (def default-handlers {:> (fn [_ klass attrs & children] 22 | [klass attrs children]) 23 | :* (fn [_ attrs & children] 24 | (if (map? attrs) 25 | ['js/React.Fragment attrs children] 26 | ['js/React.Fragment {} (cons attrs children)]))}) 27 | 28 | 29 | ;; TODO: We should take &env around everything and also expect it as an argument. 30 | (def default-config {:inline? false 31 | :wrap-input? false 32 | :array-children? false 33 | :emit-fn nil 34 | :rewrite-for? false 35 | :server-render? false 36 | :warn-on-interpretation? true 37 | ;; If you also want to camelcase string map keys, add string? here: 38 | :camelcase-key-pred (some-fn keyword? symbol?) 39 | ;; A fn that will get [tag attr children] and return 40 | ;; [tag attr children] just before emitting. 41 | :transform-fn identity 42 | :create-element 'js/React.createElement 43 | :inlineable-types #{'number 'string} 44 | :child-config (fn [options form expanded] options)}) 45 | 46 | (def ^:dynamic *config* default-config) 47 | (def ^:dynamic *handlers* default-handlers) 48 | (def ^:dynamic *env* nil) 49 | 50 | (defmacro with-child-config [form expanded-form & body] 51 | `(let [cfg# *config* 52 | new-cfg# ((:child-config *config*) *config* ~form ~expanded-form)] 53 | (binding [*config* new-cfg#] ~@body))) 54 | 55 | (defmulti compile-react 56 | "Compile a Clojure data structure into a React fn call." 57 | (fn [x] 58 | (cond 59 | (vector? x) :vector 60 | (seq? x) :seq 61 | :else (class x)))) 62 | 63 | (defmulti compile-config-kv (fn [name value] name)) 64 | 65 | (defmethod compile-config-kv :class [name value] 66 | (cond (or (nil? value) 67 | (keyword? value) 68 | (string? value)) 69 | value 70 | 71 | (and (or (sequential? value) 72 | (set? value)) 73 | (every? string? value)) 74 | (util/join-classes value) 75 | 76 | (and (vector? value) (not (:server-render? *config*))) 77 | (apply util/join-classes-js value) 78 | 79 | :else value)) 80 | 81 | (defmethod compile-config-kv :style [name value] 82 | (if (list? value) 83 | (list 'clj->js value) 84 | (util/camel-case-keys value))) 85 | 86 | (defmethod compile-config-kv :default [name value] 87 | (if (list? value) 88 | (list 'clj->js value) 89 | value)) 90 | 91 | (defn compile-config 92 | "Compile a HTML attribute map to react (class -> className), camelCases :style." 93 | [attrs] 94 | (if (map? attrs) 95 | (reduce-kv (fn [m k v] 96 | (assoc m 97 | (case k 98 | :class :className 99 | :for :htmlFor 100 | (if ((:camelcase-key-pred *config*) k) 101 | (util/camel-case k) 102 | k)) 103 | (compile-config-kv k v))) {} attrs) 104 | attrs)) 105 | #_(compile-config {:class ["b" 'c] :style {:border-width "2px"}}) ;; camelcase style 106 | ;; React native style: 107 | #_(compile-config {:class ["b" 'c] :style [{:border-width "2px"}]}) ;; camelcase style 108 | #_(compile-config {:on-click ()}) 109 | 110 | 111 | (defn- unevaluated? 112 | "True if the expression has not been evaluated. 113 | - expr is a symbol? OR 114 | - it's something like (foo bar)" 115 | [expr] 116 | (or (symbol? expr) 117 | (and (seq? expr) 118 | (not= (first expr) `quote)))) 119 | #_(unevaluated? '(foo)) 120 | 121 | (defn- form-name 122 | "Get the name of the supplied form." 123 | [form] 124 | (when (and (seq? form) (symbol? (first form))) 125 | (name (first form)))) 126 | 127 | (declare compile-html) 128 | 129 | (defmulti compile-form 130 | "Pre-compile certain standard forms, where possible." 131 | form-name) 132 | 133 | (declare emitter) 134 | (defmethod compile-form "do" 135 | [[_ & forms]] 136 | `(do ~@(butlast forms) ~(emitter (last forms)))) 137 | 138 | (defmethod compile-form "array" 139 | [[_ & forms]] 140 | `(cljs.core/array ~@(mapv emitter forms))) 141 | 142 | (defmethod compile-form "let" 143 | [[_ bindings & body]] 144 | `(let ~bindings ~@(butlast body) ~(emitter (last body)))) 145 | 146 | (defmethod compile-form "let*" 147 | [[_ bindings & body]] 148 | `(let* ~bindings ~@(butlast body) ~(emitter (last body)))) 149 | 150 | (defmethod compile-form "letfn" 151 | [[_ bindings & body]] 152 | `(letfn ~bindings ~@(butlast body) ~(emitter (last body)))) 153 | 154 | (defmethod compile-form "letfn*" 155 | [[_ bindings & body]] 156 | `(letfn* ~bindings ~@(butlast body) ~(emitter (last body)))) 157 | 158 | (defmethod hicada.compiler/compile-form "list" 159 | [[_ & forms]] 160 | `(cljs.core/array ~@(mapv emitter forms))) 161 | 162 | (defmethod compile-form "for" 163 | [[_ bindings body]] 164 | ;; Special optimization: For a simple (for [x xs] ...) we rewrite the for 165 | ;; to a fast reduce outputting a JS array: 166 | (if (:rewrite-for? *config*) 167 | (if (== 2 (count bindings)) 168 | (let [[item coll] bindings] 169 | `(reduce (fn ~'hicada-for-reducer [out-arr# ~item] 170 | (.push out-arr# ~(emitter body)) 171 | out-arr#) 172 | (cljs.core/array) ~coll)) 173 | ;; Still optimize a little by giving React an array: 174 | (list 'cljs.core/into-array `(for ~bindings ~(emitter body)))) 175 | `(for ~bindings ~(emitter body)))) 176 | 177 | (defmethod compile-form "when" 178 | [[_ condition & body]] 179 | `(when ~condition ~@(butlast body) ~(emitter (last body)))) 180 | 181 | (defmethod compile-form "when-let" 182 | [[_ bindings & body]] 183 | `(when-let ~bindings ~@(butlast body) ~(emitter (last body)))) 184 | 185 | (defmethod compile-form "when-some" 186 | [[_ bindings & body]] 187 | `(when-some ~bindings ~@(butlast body) ~(emitter (last body)))) 188 | 189 | (defmethod compile-form "when-not" 190 | [[_ condition & body]] 191 | `(when-not ~condition ~@(butlast body) ~(emitter (last body)))) 192 | 193 | (defmethod compile-form "if" 194 | [[_ condition & body]] 195 | `(if ~condition ~@(doall (for [x body] (emitter x))))) 196 | 197 | (defmethod compile-form "if-let" 198 | [[_ bindings & body]] 199 | `(if-let ~bindings ~@(doall (for [x body] (emitter x))))) 200 | 201 | (defmethod compile-form "if-not" 202 | [[_ condition & body]] 203 | `(if-not ~condition ~@(doall (for [x body] (emitter x))))) 204 | 205 | (defmethod compile-form "if-some" 206 | [[_ bindings & body]] 207 | `(if-some ~bindings ~@(doall (for [x body] (emitter x))))) 208 | 209 | (defmethod compile-form "case" 210 | [[_ v & cases]] 211 | `(case ~v 212 | ~@(doall (mapcat 213 | (fn [[test hiccup]] 214 | (if hiccup 215 | [test (emitter hiccup)] 216 | [(emitter test)])) 217 | (partition-all 2 cases))))) 218 | 219 | (defmethod compile-form "condp" 220 | [[_ f v & cases]] 221 | `(condp ~f ~v 222 | ~@(doall (mapcat 223 | (fn [[test hiccup]] 224 | (if hiccup 225 | [test (emitter hiccup)] 226 | [(emitter test)])) 227 | (partition-all 2 cases))))) 228 | 229 | (defmethod compile-form "cond" 230 | [[_ & clauses]] 231 | `(cond ~@(mapcat 232 | (fn [[check expr]] [check (emitter expr)]) 233 | (partition 2 clauses)))) 234 | 235 | 236 | (defn infer-type 237 | [expr env] 238 | (cljs.analyzer/infer-tag env (cljs.analyzer/no-warn (cljs.analyzer/analyze env expr)))) 239 | 240 | 241 | (defmacro interpret-when-necessary 242 | "Macro that wraps `expr` with interpreter call, if it cannot be inlined based on inferred type." 243 | [expr] 244 | (let [tag (infer-type expr &env)] 245 | (if (contains? (:inlineable-types *config*) tag) 246 | expr 247 | (binding [*out* *err*] 248 | (when (:warn-on-interpretation? *config*) 249 | (println "WARNING: interpreting by default, please specify ^:inline or ^:interpret") 250 | (prn expr) 251 | (println "Inferred tag was:" tag) 252 | (let [{:keys [line file]} (meta expr)] 253 | (when (and line file) 254 | (println (str file ":" line)))) 255 | (println "")) 256 | `(hicada.interpreter/interpret ~expr))))) 257 | 258 | 259 | (defmethod compile-form :default 260 | [expr] 261 | 262 | (let [interpret-or-inline ((:interpret-or-inline-fn *config* (constantly nil)) expr)] 263 | (cond 264 | (or (= interpret-or-inline :inline) 265 | (-> expr meta :inline)) 266 | expr 267 | 268 | (or (= interpret-or-inline :interpret) 269 | (-> expr meta :interpret)) 270 | `(hicada.interpreter/interpret ~expr) 271 | 272 | :else 273 | `(interpret-when-necessary ~expr)))) 274 | 275 | 276 | (defn- literal? 277 | "True if x is a literal value that can be rendered as-is." 278 | [x] 279 | (and (not (unevaluated? x)) 280 | (or (not (or (vector? x) (map? x))) 281 | (and (every? literal? x) 282 | (not (keyword? (first x))))))) 283 | #_(literal? [:div "foo"]) 284 | 285 | (declare emit-react) 286 | 287 | (defn compile-react-element 288 | "Render an element vector as a HTML element." 289 | [element] 290 | (let [[tag attrs content] (norm/element element)] 291 | (emit-react tag attrs (when content (compile-react content))))) 292 | 293 | (defn compile-element 294 | "Returns an unevaluated form that will render the supplied vector as a HTML element." 295 | [[tag attrs & children :as element]] 296 | (cond 297 | ;; Special syntax: 298 | ;; [:> ReactNav {:key "xyz", :foo "bar} ch0 ch1] 299 | (get *handlers* tag) 300 | (let [f (get *handlers* tag) 301 | [klass attrs children] (apply f element)] 302 | (emit-react klass attrs 303 | (with-child-config element [klass attrs] 304 | (mapv compile-html children)))) 305 | 306 | ;; e.g. [:span "foo"] 307 | ;(every? literal? element) 308 | ;(compile-react-element element) 309 | 310 | ;; e.g. [:span {} x] 311 | (and (literal? tag) (map? attrs)) 312 | (let [[tag attrs _] (norm/element [tag attrs])] 313 | (emit-react tag attrs 314 | (with-child-config element [tag attrs] 315 | (mapv compile-html children)))) 316 | 317 | (literal? tag) 318 | ;; We could now interpet this as either: 319 | ;; 1. First argument is the attributes (in #js{} provided by the user) OR: 320 | ;; 2. First argument is the first child element. 321 | ;; We assume #2. Always! 322 | (compile-element (list* tag {} attrs children)) 323 | 324 | ;; Problem: [a b c] could be interpreted as: 325 | ;; 1. The coll of ReactNodes [a b c] OR 326 | ;; 2. a is a React Element, b are the props and c is the first child 327 | ;; We default to 1) (handled below) BUT, if b is a map, we know this must be 2) 328 | ;; since a map doesn't make any sense as a ReactNode. 329 | ;; [foo {...} ch0 ch1] NEVER makes sense to interpret as a sequence 330 | (and (vector? element) (map? attrs)) 331 | (emit-react tag attrs 332 | (with-child-config element [tag attrs] 333 | (mapv compile-html children))) 334 | 335 | (seq? element) 336 | (seq (mapv compile-html element)) 337 | 338 | ;; We have nested children 339 | ;; [[:div "foo"] [:span "foo"]] 340 | :else 341 | (mapv compile-html element))) 342 | #_(compile-element '[:> A {:foo "bar"} a]) 343 | #_(compile-element '[:> A a b]) 344 | #_(compile-element '[A {:foo "bar"} 345 | [:span a]]) 346 | #_(compile-element '[A b a]) 347 | #_(compile-element '[:* 0 1 2]) 348 | #_(compile-element '(array [:div "foo"] [:span "foo"])) 349 | 350 | (defn compile-html 351 | "Pre-compile data structures" 352 | [content] 353 | (cond 354 | (vector? content) (compile-element content) 355 | (literal? content) content 356 | :else (compile-form content))) 357 | 358 | (defmethod compile-react :vector [xs] 359 | (if (util/element? xs) 360 | (compile-react-element xs) 361 | (compile-react (seq xs)))) 362 | 363 | (defmethod compile-react :seq [xs] 364 | (mapv compile-react xs)) 365 | 366 | (defmethod compile-react :default [x] x) 367 | 368 | #_(ns-unmap *ns* 'to-js) 369 | (defmulti to-js 370 | "Compiles to JS" 371 | (fn [x] 372 | (cond 373 | (:server-render? *config*) :server-render ;; ends up in default but let user handle it 374 | (map? x) :map 375 | (vector? x) :vector 376 | (keyword? x) :keyword 377 | :else (class x)))) 378 | 379 | (defn- to-js-map 380 | "Convert a map into a JavaScript object." 381 | [m] 382 | (when-not (empty? m) 383 | (let [key-strs (mapv to-js (keys m)) 384 | non-str (remove string? key-strs) 385 | _ (assert (empty? non-str) 386 | (str "Hicada: Props can't be dynamic:" 387 | (pr-str non-str) "in: " (pr-str m))) 388 | kvs-str (->> (mapv #(-> (str \' % "':~{}")) key-strs) 389 | (interpose ",") 390 | (apply str))] 391 | (vary-meta 392 | (list* 'js* (str "{" kvs-str "}") (mapv to-js (vals m))) 393 | assoc :tag 'object))) 394 | ;; We avoid cljs.core/js-obj here since it introduces a let and an IIFE: 395 | #_(apply list 'cljs.core/js-obj 396 | (doall (interleave (mapv to-js (keys m)) 397 | (mapv to-js (vals m)))))) 398 | 399 | (defmethod to-js :keyword [x] (name x)) 400 | (defmethod to-js :map [m] (to-js-map m)) 401 | (defmethod to-js :vector [xs] 402 | (apply list 'cljs.core/array (mapv to-js xs))) 403 | (defmethod to-js :default [x] x) 404 | 405 | (defn collapse-one 406 | "We can collapse children to a non-vector if there is only one." 407 | [xs] 408 | (cond-> xs 409 | (== 1 (count xs)) first)) 410 | 411 | (defn tag->el 412 | "A :div is translated to \"div\" and symbol 'ReactRouter stays." 413 | [x] 414 | (assert (or (symbol? x) (keyword? x) (string? x) (seq? x)) 415 | (str "Got: " (class x))) 416 | (if (keyword? x) 417 | (if (:no-string-tags? *config*) 418 | (symbol (or (namespace x) (some-> (:default-ns *config*) name)) (name x)) 419 | (name x)) 420 | x)) 421 | 422 | 423 | (defn emit-react 424 | "Emits the final react js code" 425 | [tag attrs children] 426 | (let [{:keys [transform-fn emit-fn inline? wrap-input? 427 | create-element array-children?]} *config* 428 | [tag attrs children] (transform-fn [tag attrs children *env*])] 429 | (if inline? 430 | (let [type (or (and wrap-input? (util/controlled-input-class tag attrs)) 431 | (tag->el tag)) 432 | props (to-js 433 | (merge (when-not (empty? children) {:children (collapse-one children)}) 434 | (compile-config (dissoc attrs :key :ref))))] 435 | (if emit-fn 436 | (emit-fn type (:key attrs) (:ref attrs) props) 437 | (list create-element type (:key attrs) (:ref attrs) props))) 438 | (let [children (if (and array-children? 439 | (not (empty? children)) 440 | (< 1 (count children))) 441 | ;; In production: 442 | ;; React.createElement will just copy all arguments into 443 | ;; the children array. We can avoid this by just passing 444 | ;; one argument and make it the array already. Faster. 445 | ;; Though, in debug builds of react this will warn about "no keys". 446 | [(apply list 'cljs.core/array children)] 447 | children) 448 | el (if-some [wrapper-class (util/controlled-input-class tag attrs)] 449 | (if wrap-input? 450 | wrapper-class 451 | (tag->el tag)) 452 | (tag->el tag)) 453 | cfg (to-js (compile-config attrs))] 454 | (if emit-fn 455 | (emit-fn el cfg children) 456 | (apply list create-element el cfg children)))))) 457 | 458 | (defn emitter 459 | [content] 460 | (cond-> (compile-html content) 461 | (:inline? *config*) to-js)) 462 | 463 | (defn compile 464 | "Arguments: 465 | - content: The hiccup to compile 466 | - opts 467 | o :warn-on-interpretation? - Print warnings when code cannot be pre-compiled and must be interpreted at runtime? (Defaults to `true`) 468 | o :inlineable-types - CLJS type tags that are safe to inline without interpretation. Defaults to `#{'number 'string}` 469 | o :interpret-or-inline-fn - optional; fn of expr that returns `:inline` or `:interpret` to force one of those options. 470 | o :array-children? - for product build of React only or you'll enojoy a lot of warnings :) 471 | o :create-element 'js/React.createElement - you can also use your own function here. 472 | o :wrap-input? - if inputs should be wrapped. Try without! 473 | o :rewrite-for? - rewrites simple (for [x xs] ...) into efficient reduce pushing into 474 | a JS array. 475 | o :emit-fn - optinal: called with [type config-js child-or-children] 476 | o :server-render? - defaults to false. Doesn't do any JS outputting. Still requires an :emit-fn! 477 | o :camelcase-key-pred - defaults to (some-fn keyword? symbol?), ie. map keys that have 478 | string keys, are NOT by default converted from kebab-case to camelCase! 479 | o :inline? false - NOT supported yet. Possibly in the future... 480 | o :child-config - Called for every element with [config raw-element normalized-element] 481 | to get a new configuration for element's children 482 | o :transform-fn - Called with [[tag attrs children *env*]] before emitting, to get 483 | transformed element as [tag attrs children] 484 | 485 | React Native special recommended options: 486 | o :no-string-tags? - Never output string tags (don't exits in RN) 487 | o :default-ns - Any unprefixed component will get prefixed with this ns. 488 | o :child-config - (fn [config raw-element normalized-element] -> config) change processing options as hicada goes down the tree 489 | - handlers: 490 | A map to handle special tags. See default-handlers in this namespace. 491 | - env: The macro environment. Not used currently." 492 | ([content] 493 | (compile content default-config)) 494 | ([content opts] 495 | (compile content opts default-handlers)) 496 | ([content opts handlers] 497 | (compile content opts handlers nil)) 498 | ([content opts handlers env] 499 | (assert (not (:inline? opts)) ":inline? isn't supported yet") 500 | (binding [*config* (merge default-config opts) 501 | *handlers* (merge default-handlers handlers) 502 | *env* env] 503 | (emitter content)))) 504 | 505 | (comment 506 | 507 | (compile [:h1.b.c {:class "a"}]) ;; should be "b c a", order preserved 508 | (compile [:h1.b.c {:className "a"}]) 509 | (compile [:h1.b.c {:class-name "a"}]) 510 | 511 | (compile '[:div {:class [a]} "hmm"] 512 | {:server-render? true 513 | :emit-fn (fn [a b c] 514 | (into [a b] c))}) 515 | 516 | (compile '[:div (for [x xs] 517 | [:span x])] 518 | {:rewrite-for? true}) 519 | 520 | ;; Example :clone handler + emitter: 521 | (compile '[:div 522 | [:span {:key "foo"} a b c] 523 | [:clone x {:key k} one two] 524 | [:clone x {:key k}]] 525 | {:array-children? false ;; works with both! 526 | :emit-fn (fn [tag attr children] 527 | ;; Now handle the emitter case: 528 | (if (and (seq? tag) (= ::clone (first tag))) 529 | (list* 'js/React.cloneElement (second tag) attr children) 530 | (list* 'js/React.createElement tag attr children)))} 531 | {:clone (fn [_ node attrs & children] 532 | ;; Ensure props + children are in the right position: 533 | [(list ::clone node) attrs children])}) 534 | 535 | (compile '[:* {:key "a"} a b]) 536 | 537 | (compile '[:* a b]) 538 | (compile '[:> :div props b]) 539 | 540 | ;; Doesn't convert string keys, but do convert keywords & symbols: 541 | (compile '[X {"kebab-case" y :camel-case x camel-case-2 8}]) 542 | 543 | (compile '[Transition {:in in-prop} (fn [state])]) ;; works eq to :> 544 | (compile '[a b c]) ;; We have a coll of ReactNodes. Don't touch 545 | (compile '(some-fn {:in in-prop} (fn [state]))) ;; FN call, don't touch 546 | 547 | (compile 548 | '[:> Transition {:in in-prop 549 | :unmount-on-exit true 550 | :timeout {:enter 300, :exit 100}} 551 | (fn [state])]) 552 | 553 | ;; Issue #2: 554 | (compile '[:div {:ihtml "
hi
"}] 555 | {:transform-fn (fn [[tag attr ch]] 556 | (if-some [html (:ihtml attr)] 557 | [tag 558 | (-> attr 559 | (dissoc :ihtml) 560 | (assoc :dangerouslySetInnerHTML {:__html html})) 561 | ch] 562 | [tag attr ch]))}) 563 | 564 | (compile '[:Text a b] 565 | {:no-string-tags? true 566 | :default-ns 'my.rn.native}) 567 | (compile '[:rn/Text a b] {}) 568 | (compile '[:Text a b] {:no-string-tags? true}) 569 | 570 | (compile '[:Text {:style [{:border-bottom "2px"}]}]) 571 | 572 | (compile '[:div a b] {:array-children? false}) 573 | 574 | (compile '[:div {:style (assoc {} :width 10)}]) 575 | (compile '[:div {:data-style (assoc {} :width 10)}]) 576 | (compile '[:div (assoc {} :style {:width 10})]) 577 | 578 | ) 579 | 580 | --------------------------------------------------------------------------------