mirror of
https://github.com/status-im/pluto.git
synced 2026-08-31 12:31:08 +00:00
346 lines
10 KiB
Clojure
346 lines
10 KiB
Clojure
(ns reagent.impl.component
|
|
(:require [create-react-class :as create-react-class]
|
|
[react :as react]
|
|
[reagent.impl.util :as util]
|
|
[reagent.impl.batching :as batch]
|
|
[reagent.ratom :as ratom]
|
|
[reagent.interop :refer-macros [$ $!]]
|
|
[reagent.debug :refer-macros [dbg prn dev? warn error warn-unless
|
|
assert-callable]]))
|
|
|
|
(declare ^:dynamic *current-component*)
|
|
|
|
|
|
;;; Argv access
|
|
|
|
(defn shallow-obj-to-map [o]
|
|
(let [ks (js-keys o)
|
|
len (alength ks)]
|
|
(loop [m {} i 0]
|
|
(if (< i len)
|
|
(let [k (aget ks i)]
|
|
(recur (assoc m (keyword k) (aget o k)) (inc i)))
|
|
m))))
|
|
|
|
(defn extract-props [v]
|
|
(let [p (nth v 1 nil)]
|
|
(if (map? p) p)))
|
|
|
|
(defn extract-children [v]
|
|
(let [p (nth v 1 nil)
|
|
first-child (if (or (nil? p) (map? p)) 2 1)]
|
|
(if (> (count v) first-child)
|
|
(subvec v first-child))))
|
|
|
|
(defn props-argv [c p]
|
|
(if-some [a ($ p :argv)]
|
|
a
|
|
[(.-constructor c) (shallow-obj-to-map p)]))
|
|
|
|
(defn get-argv [c]
|
|
(props-argv c ($ c :props)))
|
|
|
|
(defn get-props [c]
|
|
(let [p ($ c :props)]
|
|
(if-some [v ($ p :argv)]
|
|
(extract-props v)
|
|
(shallow-obj-to-map p))))
|
|
|
|
(defn get-children [c]
|
|
(let [p ($ c :props)]
|
|
(if-some [v ($ p :argv)]
|
|
(extract-children v)
|
|
(->> ($ p :children)
|
|
(react/Children.toArray)
|
|
(into [])))))
|
|
|
|
(defn ^boolean reagent-class? [c]
|
|
(and (fn? c)
|
|
(some? (some-> c .-prototype ($ :reagentRender)))))
|
|
|
|
(defn ^boolean react-class? [c]
|
|
(and (fn? c)
|
|
(some? (some-> c .-prototype ($ :render)))))
|
|
|
|
(defn ^boolean reagent-component? [c]
|
|
(some? ($ c :reagentRender)))
|
|
|
|
(defn cached-react-class [c]
|
|
($ c :cljsReactClass))
|
|
|
|
(defn cache-react-class [c constructor]
|
|
($! c :cljsReactClass constructor))
|
|
|
|
|
|
;;; State
|
|
|
|
(defn state-atom [this]
|
|
(let [sa ($ this :cljsState)]
|
|
(if-not (nil? sa)
|
|
sa
|
|
($! this :cljsState (ratom/atom nil)))))
|
|
|
|
;; avoid circular dependency: this gets set from template.cljs
|
|
(defonce as-element nil)
|
|
|
|
|
|
;;; Rendering
|
|
|
|
(defn wrap-render [c]
|
|
(let [f ($ c :reagentRender)
|
|
_ (assert-callable f)
|
|
res (if (true? ($ c :cljsLegacyRender))
|
|
(.call f c c)
|
|
(let [v (get-argv c)
|
|
n (count v)]
|
|
(case n
|
|
1 (.call f c)
|
|
2 (.call f c (nth v 1))
|
|
3 (.call f c (nth v 1) (nth v 2))
|
|
4 (.call f c (nth v 1) (nth v 2) (nth v 3))
|
|
5 (.call f c (nth v 1) (nth v 2) (nth v 3) (nth v 4))
|
|
(.apply f c (.slice (into-array v) 1)))))]
|
|
(cond
|
|
(vector? res) (as-element res)
|
|
(ifn? res) (let [f (if (reagent-class? res)
|
|
(fn [& args]
|
|
(as-element (apply vector res args)))
|
|
res)]
|
|
($! c :reagentRender f)
|
|
(recur c))
|
|
:else res)))
|
|
|
|
(declare comp-name)
|
|
|
|
(defn do-render [c]
|
|
(binding [*current-component* c]
|
|
(if (dev?)
|
|
;; Log errors, without using try/catch (and mess up call stack)
|
|
(let [ok (array false)]
|
|
(try
|
|
(let [res (wrap-render c)]
|
|
(aset ok 0 true)
|
|
res)
|
|
(finally
|
|
(when-not (aget ok 0)
|
|
(error (str "Error rendering component"
|
|
(comp-name)))))))
|
|
(wrap-render c))))
|
|
|
|
|
|
;;; Method wrapping
|
|
|
|
(def rat-opts {:no-cache true})
|
|
|
|
(def static-fns
|
|
{:render
|
|
(fn render []
|
|
(this-as c (if util/*non-reactive*
|
|
(do-render c)
|
|
(let [rat ($ c :cljsRatom)]
|
|
(batch/mark-rendered c)
|
|
(if (nil? rat)
|
|
(ratom/run-in-reaction #(do-render c) c "cljsRatom"
|
|
batch/queue-render rat-opts)
|
|
(._run rat false))))))})
|
|
|
|
(defn custom-wrapper [key f]
|
|
(case key
|
|
:getDefaultProps
|
|
(throw (js/Error. "getDefaultProps not supported"))
|
|
|
|
:getInitialState
|
|
(fn getInitialState []
|
|
(this-as c (reset! (state-atom c) (.call f c c))))
|
|
|
|
:componentWillReceiveProps
|
|
(fn componentWillReceiveProps [nextprops]
|
|
(this-as c (.call f c c (props-argv c nextprops))))
|
|
|
|
:shouldComponentUpdate
|
|
(fn shouldComponentUpdate [nextprops nextstate]
|
|
(or util/*always-update*
|
|
(this-as c
|
|
;; Don't care about nextstate here, we use forceUpdate
|
|
;; when only when state has changed anyway.
|
|
(let [old-argv ($ c :props.argv)
|
|
new-argv ($ nextprops :argv)
|
|
noargv (or (nil? old-argv) (nil? new-argv))]
|
|
(cond
|
|
(nil? f) (or noargv (try (not= old-argv new-argv)
|
|
(catch :default e
|
|
(warn "Exception thrown while comparing argv's in shouldComponentUpdate: " old-argv " " new-argv " " e)
|
|
false)))
|
|
noargv (.call f c c (get-argv c) (props-argv c nextprops))
|
|
:else (.call f c c old-argv new-argv))))))
|
|
|
|
:componentWillUpdate
|
|
(fn componentWillUpdate [nextprops]
|
|
(this-as c (.call f c c (props-argv c nextprops))))
|
|
|
|
:componentDidUpdate
|
|
(fn componentDidUpdate [oldprops]
|
|
(this-as c (.call f c c (props-argv c oldprops))))
|
|
|
|
:componentWillMount
|
|
(fn componentWillMount []
|
|
(this-as c
|
|
($! c :cljsMountOrder (batch/next-mount-count))
|
|
(when-not (nil? f)
|
|
(.call f c c))))
|
|
|
|
:componentDidMount
|
|
(fn componentDidMount []
|
|
(this-as c (.call f c c)))
|
|
|
|
:componentWillUnmount
|
|
(fn componentWillUnmount []
|
|
(this-as c
|
|
(some-> ($ c :cljsRatom)
|
|
ratom/dispose!)
|
|
(batch/mark-rendered c)
|
|
(when-not (nil? f)
|
|
(.call f c c))))
|
|
|
|
:componentDidCatch
|
|
(fn componentDidCatch [error info]
|
|
(this-as c (.call f c c error info)))
|
|
|
|
nil))
|
|
|
|
(defn get-wrapper [key f name]
|
|
(let [wrap (custom-wrapper key f)]
|
|
(when (and wrap f)
|
|
(assert-callable f))
|
|
(or wrap f)))
|
|
|
|
(def obligatory {:shouldComponentUpdate nil
|
|
:componentWillMount nil
|
|
:componentWillUnmount nil})
|
|
|
|
(def dash-to-camel (util/memoize-1 util/dash-to-camel))
|
|
|
|
(defn camelify-map-keys [fun-map]
|
|
(reduce-kv (fn [m k v]
|
|
(assoc m (-> k dash-to-camel keyword) v))
|
|
{} fun-map))
|
|
|
|
(defn add-obligatory [fun-map]
|
|
(merge obligatory fun-map))
|
|
|
|
(defn wrap-funs [fmap]
|
|
(when (dev?)
|
|
(let [renders (select-keys fmap [:render :reagentRender :componentFunction])
|
|
render-fun (-> renders vals first)]
|
|
(assert (pos? (count renders)) "Missing reagent-render")
|
|
(assert (== 1 (count renders)) "Too many render functions supplied")
|
|
(assert-callable render-fun)))
|
|
(let [render-fun (or (:reagentRender fmap)
|
|
(:componentFunction fmap))
|
|
legacy-render (nil? render-fun)
|
|
render-fun (or render-fun
|
|
(:render fmap))
|
|
name (str (or (:displayName fmap)
|
|
(util/fun-name render-fun)))
|
|
name (case name
|
|
"" (str (gensym "reagent"))
|
|
name)
|
|
fmap (reduce-kv (fn [m k v]
|
|
(assoc m k (get-wrapper k v name)))
|
|
{} fmap)]
|
|
(assoc fmap
|
|
:displayName name
|
|
:autobind false
|
|
:cljsLegacyRender legacy-render
|
|
:reagentRender render-fun
|
|
:render (:render static-fns))))
|
|
|
|
(defn map-to-js [m]
|
|
(reduce-kv (fn [o k v]
|
|
(doto o
|
|
(aset (name k) v)))
|
|
#js{} m))
|
|
|
|
(defn cljsify [body]
|
|
(-> body
|
|
camelify-map-keys
|
|
add-obligatory
|
|
wrap-funs
|
|
map-to-js))
|
|
|
|
(defn create-class [body]
|
|
{:pre [(map? body)]}
|
|
(->> body
|
|
cljsify
|
|
create-react-class))
|
|
|
|
(defn fiber-component-path [fiber]
|
|
(let [name (some-> fiber
|
|
($ :type)
|
|
($ :displayName))
|
|
parent (some-> fiber
|
|
($ :return))
|
|
path (some-> parent
|
|
fiber-component-path
|
|
(str " > "))
|
|
res (str path name)]
|
|
(when-not (empty? res) res)))
|
|
|
|
(defn component-path [c]
|
|
;; Alternative branch for React 16
|
|
;; Try both original name (for UMD foreign-lib) and manged name (property access, for Closure optimized React)
|
|
(if-let [fiber (or (some-> c ($ :_reactInternalFiber))
|
|
(some-> c (.-_reactInternalFiber)))]
|
|
(fiber-component-path fiber)
|
|
(let [instance (or (some-> c ($ :_reactInternalInstance))
|
|
(some-> c (.-_reactInternalInstance))
|
|
c)
|
|
elem (or (some-> instance ($ :_currentElement))
|
|
(some-> instance (.-_currentElement)))
|
|
name (some-> elem
|
|
($ :type)
|
|
($ :displayName))
|
|
owner (or (some-> elem ($ :_owner))
|
|
(some-> elem (.-_owner)))
|
|
path (some-> owner
|
|
component-path
|
|
(str " > "))
|
|
res (str path name)]
|
|
(when-not (empty? res) res))))
|
|
|
|
(defn comp-name []
|
|
(if (dev?)
|
|
(let [c *current-component*
|
|
n (or (component-path c)
|
|
(some-> c .-constructor util/fun-name))]
|
|
(if-not (empty? n)
|
|
(str " (in " n ")")
|
|
""))
|
|
""))
|
|
|
|
(defn fn-to-class [f]
|
|
(assert-callable f)
|
|
(warn-unless (not (and (react-class? f)
|
|
(not (reagent-class? f))))
|
|
"Using native React classes directly in Hiccup forms "
|
|
"is not supported. Use create-element or "
|
|
"adapt-react-class instead: " (let [n (util/fun-name f)]
|
|
(if (empty? n) f n))
|
|
(comp-name))
|
|
(if (reagent-class? f)
|
|
(cache-react-class f f)
|
|
(let [spec (meta f)
|
|
withrender (assoc spec :reagent-render f)
|
|
res (create-class withrender)]
|
|
(cache-react-class f res))))
|
|
|
|
(defn as-class [tag]
|
|
(if-some [cached-class (cached-react-class tag)]
|
|
cached-class
|
|
(fn-to-class tag)))
|
|
|
|
(defn reactify-component [comp]
|
|
(if (react-class? comp)
|
|
comp
|
|
(as-class comp)))
|