From 9cfe463d02ec9efb0504186c9e65e00321cc5ee6 Mon Sep 17 00:00:00 2001 From: Daniel Compton Date: Fri, 22 Dec 2017 16:42:48 +1300 Subject: [PATCH] Add Reagent to source dependencies --- DEVELOPERS.md | 5 +- project.clj | 32 +- .../re_frame/v0v10v2/re_frame/interop.clj | 2 +- .../re_frame/v0v10v2/re_frame/interop.cljs | 26 +- .../reagent/v0v6v0/reagent/core.clj | 9 + .../reagent/v0v6v0/reagent/core.cljs | 359 +++++++++++ .../reagent/v0v6v0/reagent/debug.clj | 73 +++ .../reagent/v0v6v0/reagent/debug.cljs | 27 + .../reagent/v0v6v0/reagent/dom.cljs | 78 +++ .../reagent/v0v6v0/reagent/dom/server.cljs | 33 + .../reagent/v0v6v0/reagent/impl/batching.cljs | 113 ++++ .../v0v6v0/reagent/impl/component.cljs | 317 ++++++++++ .../reagent/v0v6v0/reagent/impl/template.cljs | 395 ++++++++++++ .../reagent/v0v6v0/reagent/impl/util.cljs | 102 +++ .../reagent/v0v6v0/reagent/interop.clj | 75 +++ .../reagent/v0v6v0/reagent/interop.cljs | 2 + .../reagent/v0v6v0/reagent/ratom.clj | 53 ++ .../reagent/v0v6v0/reagent/ratom.cljs | 592 ++++++++++++++++++ 18 files changed, 2264 insertions(+), 29 deletions(-) create mode 100644 src/mranderson047/reagent/v0v6v0/reagent/core.clj create mode 100644 src/mranderson047/reagent/v0v6v0/reagent/core.cljs create mode 100644 src/mranderson047/reagent/v0v6v0/reagent/debug.clj create mode 100644 src/mranderson047/reagent/v0v6v0/reagent/debug.cljs create mode 100644 src/mranderson047/reagent/v0v6v0/reagent/dom.cljs create mode 100644 src/mranderson047/reagent/v0v6v0/reagent/dom/server.cljs create mode 100644 src/mranderson047/reagent/v0v6v0/reagent/impl/batching.cljs create mode 100644 src/mranderson047/reagent/v0v6v0/reagent/impl/component.cljs create mode 100644 src/mranderson047/reagent/v0v6v0/reagent/impl/template.cljs create mode 100644 src/mranderson047/reagent/v0v6v0/reagent/impl/util.cljs create mode 100644 src/mranderson047/reagent/v0v6v0/reagent/interop.clj create mode 100644 src/mranderson047/reagent/v0v6v0/reagent/interop.cljs create mode 100644 src/mranderson047/reagent/v0v6v0/reagent/ratom.clj create mode 100644 src/mranderson047/reagent/v0v6v0/reagent/ratom.cljs diff --git a/DEVELOPERS.md b/DEVELOPERS.md index 9b62e61..ca5b211 100644 --- a/DEVELOPERS.md +++ b/DEVELOPERS.md @@ -52,12 +52,13 @@ We are using CSS preprocessing to isolate the panel styles, by namespacing the p ### Updating the internal version of re-frame used -We want to use re-frame, but we don't want to use the re-frame that the host is using, or tracing will get very messy. Instead, we use [mranderson](https://github.com/benedekfazekas/mranderson) to create source dependencies of re-frame. +We want to use re-frame, but we don't want to use the re-frame that the host is using, or tracing will get very messy. Instead, we use [mranderson](https://github.com/benedekfazekas/mranderson) to create source dependencies of re-frame and reagent. ```console $ lein do clean $ lein with-profile mranderson source-deps -$ cp -r target/srcdeps/mranderson047 src +$ cp -r target/srcdeps/mranderson047 src +# Then delete the META-INF directories ``` ### How does re-frame-trace build?? I don't see anything in the project.clj that looks like it will build. diff --git a/project.clj b/project.clj index 8829d02..c50f990 100644 --- a/project.clj +++ b/project.clj @@ -1,17 +1,17 @@ (defproject day8.re-frame/trace "0.1.15-SNAPSHOT" :description "Tracing and developer tools for re-frame apps" - :url "https://github.com/Day8/re-frame-trace" - :license {:name "MIT"} + :url "https://github.com/Day8/re-frame-trace" + :license {:name "MIT"} :dependencies [[org.clojure/clojure "1.9.0"] [org.clojure/clojurescript "1.9.671"] - [reagent "0.6.0" :scope "provided"] + [reagent "0.6.0" :scope "provided"] [re-frame "0.10.3-alpha2" :scope "provided"] - [binaryage/devtools "0.9.4"] [io.pyroclast/metamorphic "0.1.0-alpha1"] + [binaryage/devtools "0.9.4"] [garden "1.3.3"]] :plugins [[thomasa/mranderson "0.4.7"] [lein-less "RELEASE"]] - :deploy-repositories {"releases" :clojars + :deploy-repositories {"releases" :clojars "snapshots" :clojars} ;:source-paths ["target/srcdeps"] @@ -31,11 +31,17 @@ :target-path "resources/day8/re_frame/trace"} :profiles {:dev {:dependencies [[binaryage/dirac "RELEASE"]]} - :mranderson {:dependencies [^:source-dep [re-frame "0.10.2" :scope "provided" - :exclusions [org.clojure/clojurescript - reagent - cljsjs/react - cljsjs/react-dom - cljsjs/react-dom-server - org.clojure/tools.logging - net.cgrand/macrovich]]]}}) + :mranderson {:dependencies ^:replace [^:source-dep [re-frame "0.10.2" + :exclusions [org.clojure/clojurescript + cljsjs/react + cljsjs/react-dom + cljsjs/react-dom-server + org.clojure/tools.logging + net.cgrand/macrovich]] + ^:source-dep [reagent "0.6.0" + :exclusions [org.clojure/clojurescript + cljsjs/react + cljsjs/react-dom + cljsjs/react-dom-server + org.clojure/tools.logging + net.cgrand/macrovich]]]}}) diff --git a/src/mranderson047/re_frame/v0v10v2/re_frame/interop.clj b/src/mranderson047/re_frame/v0v10v2/re_frame/interop.clj index 1551302..15ddd31 100644 --- a/src/mranderson047/re_frame/v0v10v2/re_frame/interop.clj +++ b/src/mranderson047/re_frame/v0v10v2/re_frame/interop.clj @@ -48,7 +48,7 @@ (defn make-reaction "On JVM Clojure, return a `deref`-able thing which invokes the given function on every `deref`. That is, `make-reaction` here provides precisely none of the - benefits of `reagent.ratom/make-reaction` (which only invokes its function if + benefits of `mranderson047.reagent.v0v6v0.reagent.ratom/make-reaction` (which only invokes its function if the reactions that the function derefs have changed value). But so long as `f` only depends on other reactions (which also behave themselves), the only difference is one of efficiency. That is, your tests should see no difference diff --git a/src/mranderson047/re_frame/v0v10v2/re_frame/interop.cljs b/src/mranderson047/re_frame/v0v10v2/re_frame/interop.cljs index 6fbc41f..26c1841 100644 --- a/src/mranderson047/re_frame/v0v10v2/re_frame/interop.cljs +++ b/src/mranderson047/re_frame/v0v10v2/re_frame/interop.cljs @@ -1,13 +1,13 @@ (ns mranderson047.re-frame.v0v10v2.re-frame.interop (:require [goog.async.nextTick] - [reagent.core] - [reagent.ratom])) + [mranderson047.reagent.v0v6v0.reagent.core] + [mranderson047.reagent.v0v6v0.reagent.ratom])) (def next-tick goog.async.nextTick) (def empty-queue #queue []) -(def after-render reagent.core/after-render) +(def after-render mranderson047.reagent.v0v6v0.reagent.core/after-render) ;; Make sure the Google Closure compiler sees this as a boolean constant, ;; otherwise Dead Code Elimination won't happen in `:advanced` builds. @@ -16,23 +16,23 @@ (def ^boolean debug-enabled? "@define {boolean}" ^boolean js/goog.DEBUG) (defn ratom [x] - (reagent.core/atom x)) + (mranderson047.reagent.v0v6v0.reagent.core/atom x)) (defn ratom? [x] - (satisfies? reagent.ratom/IReactiveAtom x)) + (satisfies? mranderson047.reagent.v0v6v0.reagent.ratom/IReactiveAtom x)) (defn deref? [x] (satisfies? IDeref x)) (defn make-reaction [f] - (reagent.ratom/make-reaction f)) + (mranderson047.reagent.v0v6v0.reagent.ratom/make-reaction f)) (defn add-on-dispose! [a-ratom f] - (reagent.ratom/add-on-dispose! a-ratom f)) + (mranderson047.reagent.v0v6v0.reagent.ratom/add-on-dispose! a-ratom f)) (defn dispose! [a-ratom] - (reagent.ratom/dispose! a-ratom)) + (mranderson047.reagent.v0v6v0.reagent.ratom/dispose! a-ratom)) (defn set-timeout! [f ms] (js/setTimeout f ms)) @@ -46,11 +46,11 @@ "Produces an id for reactive Reagent values e.g. reactions, ratoms, cursors." [reactive-val] - (when (implements? reagent.ratom/IReactiveAtom reactive-val) + (when (implements? mranderson047.reagent.v0v6v0.reagent.ratom/IReactiveAtom reactive-val) (str (condp instance? reactive-val - reagent.ratom/RAtom "ra" - reagent.ratom/RCursor "rc" - reagent.ratom/Reaction "rx" - reagent.ratom/Track "tr" + mranderson047.reagent.v0v6v0.reagent.ratom/RAtom "ra" + mranderson047.reagent.v0v6v0.reagent.ratom/RCursor "rc" + mranderson047.reagent.v0v6v0.reagent.ratom/Reaction "rx" + mranderson047.reagent.v0v6v0.reagent.ratom/Track "tr" "other") (hash reactive-val)))) diff --git a/src/mranderson047/reagent/v0v6v0/reagent/core.clj b/src/mranderson047/reagent/v0v6v0/reagent/core.clj new file mode 100644 index 0000000..1503562 --- /dev/null +++ b/src/mranderson047/reagent/v0v6v0/reagent/core.clj @@ -0,0 +1,9 @@ +(ns mranderson047.reagent.v0v6v0.reagent.core + (:require [mranderson047.reagent.v0v6v0.reagent.ratom :as ra])) + +(defmacro with-let [bindings & body] + "Bind variables as with let, except that when used in a component + the bindings are only evaluated once. Also takes an optional finally + clause at the end, that is executed when the component is + destroyed." + `(ra/with-let ~bindings ~@body)) diff --git a/src/mranderson047/reagent/v0v6v0/reagent/core.cljs b/src/mranderson047/reagent/v0v6v0/reagent/core.cljs new file mode 100644 index 0000000..fd56926 --- /dev/null +++ b/src/mranderson047/reagent/v0v6v0/reagent/core.cljs @@ -0,0 +1,359 @@ +(ns mranderson047.reagent.v0v6v0.reagent.core + (:require-macros [mranderson047.reagent.v0v6v0.reagent.core]) + (:refer-clojure :exclude [partial atom flush]) + (:require [mranderson047.reagent.v0v6v0.reagent.impl.template :as tmpl] + [mranderson047.reagent.v0v6v0.reagent.impl.component :as comp] + [mranderson047.reagent.v0v6v0.reagent.impl.util :as util] + [mranderson047.reagent.v0v6v0.reagent.impl.batching :as batch] + [mranderson047.reagent.v0v6v0.reagent.ratom :as ratom] + [mranderson047.reagent.v0v6v0.reagent.debug :as deb :refer-macros [dbg prn]] + [mranderson047.reagent.v0v6v0.reagent.interop :refer-macros [$ $!]] + [mranderson047.reagent.v0v6v0.reagent.dom :as dom] + [mranderson047.reagent.v0v6v0.reagent.dom.server :as server])) + +(def is-client util/is-client) + +(def react util/react) + +(defn create-element + "Create a native React element, by calling React.createElement directly. + + That means the second argument must be a javascript object (or nil), and + that any Reagent hiccup forms must be processed with as-element. For example + like this: + + (r/create-element \"div\" #js{:className \"foo\"} + \"Hi \" (r/as-element [:strong \"world!\"]) + + which is equivalent to + + [:div.foo \"Hi\" [:strong \"world!\"]]" + ([type] + (create-element type nil)) + ([type props] + (assert (not (map? props))) + ($ react createElement type props)) + ([type props child] + (assert (not (map? props))) + ($ react createElement type props child)) + ([type props child & children] + (assert (not (map? props))) + (apply ($ react :createElement) type props child children))) + +(defn as-element + "Turns a vector of Hiccup syntax into a React element. Returns form + unchanged if it is not a vector." + [form] + (tmpl/as-element form)) + +(defn adapt-react-class + "Returns an adapter for a native React class, that may be used + just like a Reagent component function or class in Hiccup forms." + [c] + (assert c) + (tmpl/adapt-react-class c)) + +(defn reactify-component + "Returns an adapter for a Reagent component, that may be used from + React, for example in JSX. A single argument, props, is passed to + the component, converted to a map." + [c] + (assert c) + (comp/reactify-component c)) + +(defn render + "Render a Reagent component into the DOM. The first argument may be + either a vector (using Reagent's Hiccup syntax), or a React element. + The second argument should be a DOM node. + + Optionally takes a callback that is called when the component is in place. + + Returns the mounted component instance." + ([comp container] + (dom/render comp container)) + ([comp container callback] + (dom/render comp container callback))) + +(defn unmount-component-at-node + "Remove a component from the given DOM node." + [container] + (dom/unmount-component-at-node container)) + +(defn render-to-string + "Turns a component into an HTML string." + [component] + (server/render-to-string component)) + +;; For backward compatibility +(def as-component as-element) +(def render-component render) +(def render-component-to-string render-to-string) + +(defn render-to-static-markup + "Turns a component into an HTML string, without data-react-id attributes, etc." + [component] + (server/render-to-static-markup component)) + +(defn ^:export force-update-all + "Force re-rendering of all mounted Reagent components. This is + probably only useful in a development environment, when you want to + update components in response to some dynamic changes to code. + + Note that force-update-all may not update root components. This + happens if a component 'foo' is mounted with `(render [foo])` (since + functions are passed by value, and not by reference, in + ClojureScript). To get around this you'll have to introduce a layer + of indirection, for example by using `(render [#'foo])` instead." + [] + (ratom/flush!) + (dom/force-update-all) + (batch/flush-after-render)) + +(defn create-class + "Create a component, React style. Should be called with a map, + looking like this: + + {:get-initial-state (fn [this]) + :component-will-receive-props (fn [this new-argv]) + :should-component-update (fn [this old-argv new-argv]) + :component-will-mount (fn [this]) + :component-did-mount (fn [this]) + :component-will-update (fn [this new-argv]) + :component-did-update (fn [this old-argv]) + :component-will-unmount (fn [this]) + :reagent-render (fn [args....])} ;; or :render (fn [this]) + + Everything is optional, except either :reagent-render or :render." + [spec] + (comp/create-class spec)) + + +(defn current-component + "Returns the current React component (a.k.a this) in a component + function." + [] + comp/*current-component*) + +(defn state-atom + "Returns an atom containing a components state." + [this] + (assert (comp/reagent-component? this)) + (comp/state-atom this)) + +(defn state + "Returns the state of a component, as set with replace-state or set-state. + Equivalent to (deref (r/state-atom this))" + [this] + (assert (comp/reagent-component? this)) + (deref (state-atom this))) + +(defn replace-state + "Set state of a component. + Equivalent to (reset! (state-atom this) new-state)" + [this new-state] + (assert (comp/reagent-component? this)) + (assert (or (nil? new-state) (map? new-state))) + (reset! (state-atom this) new-state)) + +(defn set-state + "Merge component state with new-state. + Equivalent to (swap! (state-atom this) merge new-state)" + [this new-state] + (assert (comp/reagent-component? this)) + (assert (or (nil? new-state) (map? new-state))) + (swap! (state-atom this) merge new-state)) + +(defn force-update + "Force a component to re-render immediately. + + If the second argument is true, child components will also be + re-rendered, even is their arguments have not changed." + ([this] + (force-update this false)) + ([this deep] + (ratom/flush!) + (util/force-update this deep) + (batch/flush-after-render))) + +(defn props + "Returns the props passed to a component." + [this] + (assert (comp/reagent-component? this)) + (comp/get-props this)) + +(defn children + "Returns the children passed to a component." + [this] + (assert (comp/reagent-component? this)) + (comp/get-children this)) + +(defn argv + "Returns the entire Hiccup form passed to the component." + [this] + (assert (comp/reagent-component? this)) + (comp/get-argv this)) + +(defn dom-node + "Returns the root DOM node of a mounted component." + [this] + (dom/dom-node this)) + +(defn merge-props + "Utility function that merges two maps, handling :class and :style + specially, like React's transferPropsTo." + [defaults props] + (util/merge-props defaults props)) + +(defn flush + "Render dirty components immediately to the DOM. + + Note that this may not work in event handlers, since React.js does + batching of updates there." + [] + (batch/flush)) + + + +;; Ratom + +(defn atom + "Like clojure.core/atom, except that it keeps track of derefs. + Reagent components that derefs one of these are automatically + re-rendered." + ([x] (ratom/atom x)) + ([x & rest] (apply ratom/atom x rest))) + +(defn track + "Takes a function and optional arguments, and returns a derefable + containing the output of that function. If the function derefs + Reagent atoms (or track, etc), the value will be updated whenever + the atom changes. + + In other words, @(track foo bar) will produce the same result + as (foo bar), but foo will only be called again when the atoms it + depends on changes, and will only trigger updates of components when + its result changes. + + track is lazy, i.e the function is only evaluated on deref." + [f & args] + {:pre [(ifn? f)]} + (ratom/make-track f args)) + +(defn track! + "An eager version of track. The function passed is called + immediately, and continues to be called when needed, until stopped + with dispose!." + [f & args] + {:pre [(ifn? f)]} + (ratom/make-track! f args)) + +(defn dispose! + "Stop the result of track! from updating." + [x] + (ratom/dispose! x)) + +(defn wrap + "Provide a combination of value and callback, that looks like an atom. + + The first argument can be any value, that will be returned when the + result is deref'ed. + + The second argument should be a function, that is called with the + optional extra arguments provided to wrap, and the new value of the + resulting 'atom'. + + Use for example like this: + + (wrap (:foo @state) + swap! state assoc :foo) + + Probably useful only for passing to child components." + [value reset-fn & args] + (assert (ifn? reset-fn)) + (ratom/make-wrapper value reset-fn args)) + + +;; RCursor + +(defn cursor + "Provide a cursor into a Reagent atom. + + Behaves like a Reagent atom but focuses updates and derefs to + the specified path within the wrapped Reagent atom. e.g., + (let [c (cursor ra [:nested :content])] + ... @c ;; equivalent to (get-in @ra [:nested :content]) + ... (reset! c 42) ;; equivalent to (swap! ra assoc-in [:nested :content] 42) + ... (swap! c inc) ;; equivalence to (swap! ra update-in [:nested :content] inc) + ) + + The first parameter can also be a function, that should look + something like this: + + (defn set-get + ([k] (get-in @state k)) + ([k v] (swap! state assoc-in k v))) + + The function will be called with one argument – the path passed to + cursor – when the cursor is deref'ed, and two arguments (path and + new value) when the cursor is modified. + + Given that set-get function, (and that state is a Reagent atom, or + another cursor) these cursors are equivalent: + (cursor state [:foo]) and (cursor set-get [:foo]). + + Note that a cursor is lazy: its value will not change until it is + used. This may be noticed with add-watch." + ([src path] + (ratom/cursor src path))) + + +;; Utilities + +(defn rswap! + "Swaps the value of a to be (apply f current-value-of-atom args). + + rswap! works like swap!, except that recursive calls to rswap! on + the same atom are allowed – and it always returns nil." + [a f & args] + {:pre [(satisfies? IAtom a) + (ifn? f)]} + (if a.rswapping + (-> (or a.rswapfs (set! a.rswapfs (array))) + (.push #(apply f % args))) + (do (set! a.rswapping true) + (try (swap! a (fn [state] + (loop [s (apply f state args)] + (if-some [sf (some-> a.rswapfs .shift)] + (recur (sf s)) + s)))) + (finally + (set! a.rswapping false))))) + nil) + +(defn next-tick + "Run f using requestAnimationFrame or equivalent. + + f will be called just before components are rendered." + [f] + (batch/do-before-flush f)) + +(defn after-render + "Run f using requestAnimationFrame or equivalent. + + f will be called just after any queued renders in the next animation + frame (and even if no renders actually occur)." + [f] + (batch/do-after-render f)) + +(defn partial + "Works just like clojure.core/partial, except that it is an IFn, and + the result can be compared with =" + [f & args] + (util/partial-ifn. f args nil)) + +(defn component-path + ;; Try to return the path of component c as a string. + ;; Maybe useful for debugging and error reporting, but may break + ;; with future versions of React (and return nil). + [c] + (comp/component-path c)) diff --git a/src/mranderson047/reagent/v0v6v0/reagent/debug.clj b/src/mranderson047/reagent/v0v6v0/reagent/debug.clj new file mode 100644 index 0000000..45a21d4 --- /dev/null +++ b/src/mranderson047/reagent/v0v6v0/reagent/debug.clj @@ -0,0 +1,73 @@ +(ns mranderson047.reagent.v0v6v0.reagent.debug + (:refer-clojure :exclude [prn println time])) + +(defmacro log + "Print with console.log, if it exists." + [& forms] + `(when mranderson047.reagent.v0v6v0.reagent.debug.has-console + (.log js/console ~@forms))) + +(defmacro warn + "Print with console.warn." + [& forms] + (when *assert* + `(when mranderson047.reagent.v0v6v0.reagent.debug.has-console + (.warn (if mranderson047.reagent.v0v6v0.reagent.debug.tracking + mranderson047.reagent.v0v6v0.reagent.debug.track-console js/console) + (str "Warning: " ~@forms))))) + +(defmacro warn-unless + [cond & forms] + (when *assert* + `(when (not ~cond) + (warn ~@forms)))) + +(defmacro error + "Print with console.error." + [& forms] + (when *assert* + `(when mranderson047.reagent.v0v6v0.reagent.debug.has-console + (.error (if mranderson047.reagent.v0v6v0.reagent.debug.tracking + mranderson047.reagent.v0v6v0.reagent.debug.track-console js/console) + (str ~@forms))))) + +(defmacro println + "Print string with console.log" + [& forms] + `(log (str ~@forms))) + +(defmacro prn + "Like standard prn, but prints using console.log (so that we get +nice clickable links to source in modern browsers)." + [& forms] + `(log (pr-str ~@forms))) + +(defmacro dbg + "Useful debugging macro that prints the source and value of x, +as well as package name and line number. Returns x." + [x] + (let [ns (str cljs.analyzer/*cljs-ns*)] + `(let [x# ~x] + (println (str "dbg " + ~ns ":" + ~(:line (meta &form)) + ": " + ~(pr-str x) + ": " + (pr-str x#))) + x#))) + +(defmacro dev? + "True if assertions are enabled." + [] + (if *assert* true false)) + +(defmacro time [& forms] + (let [ns (str cljs.analyzer/*cljs-ns*) + label (str ns ":" (:line (meta &form)))] + `(let [label# ~label + res# (do + (js/console.time label#) + ~@forms)] + (js/console.timeEnd label#) + res#))) diff --git a/src/mranderson047/reagent/v0v6v0/reagent/debug.cljs b/src/mranderson047/reagent/v0v6v0/reagent/debug.cljs new file mode 100644 index 0000000..3b4818a --- /dev/null +++ b/src/mranderson047/reagent/v0v6v0/reagent/debug.cljs @@ -0,0 +1,27 @@ +(ns mranderson047.reagent.v0v6v0.reagent.debug + (:require-macros [mranderson047.reagent.v0v6v0.reagent.debug])) + +(def ^:const has-console (exists? js/console)) + +(def ^boolean tracking false) + +(defonce warnings (atom nil)) + +(defonce track-console + (let [o #js{}] + (set! (.-warn o) + (fn [& args] + (swap! warnings update-in [:warn] conj (apply str args)))) + (set! (.-error o) + (fn [& args] + (swap! warnings update-in [:error] conj (apply str args)))) + o)) + +(defn track-warnings [f] + (set! tracking true) + (reset! warnings nil) + (f) + (let [warns @warnings] + (reset! warnings nil) + (set! tracking false) + warns)) diff --git a/src/mranderson047/reagent/v0v6v0/reagent/dom.cljs b/src/mranderson047/reagent/v0v6v0/reagent/dom.cljs new file mode 100644 index 0000000..bc1fd19 --- /dev/null +++ b/src/mranderson047/reagent/v0v6v0/reagent/dom.cljs @@ -0,0 +1,78 @@ +(ns mranderson047.reagent.v0v6v0.reagent.dom + (:require [cljsjs.react.dom] + [mranderson047.reagent.v0v6v0.reagent.impl.util :as util] + [mranderson047.reagent.v0v6v0.reagent.impl.template :as tmpl] + [mranderson047.reagent.v0v6v0.reagent.impl.batching :as batch] + [mranderson047.reagent.v0v6v0.reagent.ratom :as ratom] + [mranderson047.reagent.v0v6v0.reagent.debug :refer-macros [dbg]] + [mranderson047.reagent.v0v6v0.reagent.interop :refer-macros [$ $!]])) + +(defonce ^:private imported nil) + +(defn module [] + (cond + (some? imported) imported + (exists? js/ReactDOM) (set! imported js/ReactDOM) + (exists? js/require) (or (set! imported (js/require "react-dom")) + (throw (js/Error. "require('react-dom') failed"))) + :else + (throw (js/Error. "js/ReactDOM is missing")))) + + +(defonce ^:private roots (atom {})) + +(defn- unmount-comp [container] + (swap! roots dissoc container) + ($ (module) unmountComponentAtNode container)) + +(defn- render-comp [comp container callback] + (binding [util/*always-update* true] + (->> ($ (module) render (comp) container + (fn [] + (binding [util/*always-update* false] + (swap! roots assoc container [comp container]) + (batch/flush-after-render) + (if (some? callback) + (callback)))))))) + +(defn- re-render-component [comp container] + (render-comp comp container nil)) + +(defn render + "Render a Reagent component into the DOM. The first argument may be + either a vector (using Reagent's Hiccup syntax), or a React element. The second argument should be a DOM node. + + Optionally takes a callback that is called when the component is in place. + + Returns the mounted component instance." + ([comp container] + (render comp container nil)) + ([comp container callback] + (ratom/flush!) + (let [f (fn [] + (tmpl/as-element (if (fn? comp) (comp) comp)))] + (render-comp f container callback)))) + +(defn unmount-component-at-node [container] + (unmount-comp container)) + +(defn dom-node + "Returns the root DOM node of a mounted component." + [this] + ($ (module) findDOMNode this)) + +(defn force-update-all + "Force re-rendering of all mounted Reagent components. This is + probably only useful in a development environment, when you want to + update components in response to some dynamic changes to code. + + Note that force-update-all may not update root components. This + happens if a component 'foo' is mounted with `(render [foo])` (since + functions are passed by value, and not by reference, in + ClojureScript). To get around this you'll have to introduce a layer + of indirection, for example by using `(render [#'foo])` instead." + [] + (ratom/flush!) + (doseq [v (vals @roots)] + (apply re-render-component v)) + "Updated") diff --git a/src/mranderson047/reagent/v0v6v0/reagent/dom/server.cljs b/src/mranderson047/reagent/v0v6v0/reagent/dom/server.cljs new file mode 100644 index 0000000..85999d3 --- /dev/null +++ b/src/mranderson047/reagent/v0v6v0/reagent/dom/server.cljs @@ -0,0 +1,33 @@ +(ns mranderson047.reagent.v0v6v0.reagent.dom.server + (:require [cljsjs.react.dom.server] + [mranderson047.reagent.v0v6v0.reagent.impl.util :as util] + [mranderson047.reagent.v0v6v0.reagent.impl.template :as tmpl] + [mranderson047.reagent.v0v6v0.reagent.ratom :as ratom] + [mranderson047.reagent.v0v6v0.reagent.interop :refer-macros [$ $!]])) + +(defonce ^:private imported nil) + +(defn module [] + (cond + (some? imported) imported + (exists? js/ReactDOMServer) (set! imported js/ReactDOMServer) + (exists? js/require) (or (set! imported (js/require "react-dom/server")) + (throw (js/Error. + "require('react-dom/server') failed"))) + :else + (throw (js/Error. "js/ReactDOMServer is missing")))) + + +(defn render-to-string + "Turns a component into an HTML string." + [component] + (ratom/flush!) + (binding [util/*non-reactive* true] + ($ (module) renderToString (tmpl/as-element component)))) + +(defn render-to-static-markup + "Turns a component into an HTML string, without data-react-id attributes, etc." + [component] + (ratom/flush!) + (binding [util/*non-reactive* true] + ($ (module) renderToStaticMarkup (tmpl/as-element component)))) diff --git a/src/mranderson047/reagent/v0v6v0/reagent/impl/batching.cljs b/src/mranderson047/reagent/v0v6v0/reagent/impl/batching.cljs new file mode 100644 index 0000000..71ef7df --- /dev/null +++ b/src/mranderson047/reagent/v0v6v0/reagent/impl/batching.cljs @@ -0,0 +1,113 @@ +(ns mranderson047.reagent.v0v6v0.reagent.impl.batching + (:refer-clojure :exclude [flush]) + (:require [mranderson047.reagent.v0v6v0.reagent.debug :refer-macros [dbg]] + [mranderson047.reagent.v0v6v0.reagent.interop :refer-macros [$ $!]] + [mranderson047.reagent.v0v6v0.reagent.impl.util :refer [is-client]] + [clojure.string :as string])) + +;;; Update batching + +(defonce mount-count 0) + +(defn next-mount-count [] + (set! mount-count (inc mount-count))) + +(defn fake-raf [f] + (js/setTimeout f 16)) + +(def next-tick + (if-not is-client + fake-raf + (let [w js/window] + (or ($ w :requestAnimationFrame) + ($ w :webkitRequestAnimationFrame) + ($ w :mozRequestAnimationFrame) + ($ w :msRequestAnimationFrame) + fake-raf)))) + +(defn compare-mount-order [c1 c2] + (- ($ c1 :cljsMountOrder) + ($ c2 :cljsMountOrder))) + +(defn run-queue [a] + ;; sort components by mount order, to make sure parents + ;; are rendered before children + (.sort a compare-mount-order) + (dotimes [i (alength a)] + (let [c (aget a i)] + (when (true? ($ c :cljsIsDirty)) + ($ c forceUpdate))))) + + +;; Set from ratom.cljs +(defonce ratom-flush (fn [])) + +(deftype RenderQueue [^:mutable ^boolean scheduled?] + Object + (enqueue [this k f] + (assert (some? f)) + (when (nil? (aget this k)) + (aset this k (array))) + (.push (aget this k) f) + (.schedule this)) + + (run-funs [this k] + (when-some [fs (aget this k)] + (aset this k nil) + (dotimes [i (alength fs)] + ((aget fs i))))) + + (schedule [this] + (when-not scheduled? + (set! scheduled? true) + (next-tick #(.run-queues this)))) + + (queue-render [this c] + (.enqueue this "componentQueue" c)) + + (add-before-flush [this f] + (.enqueue this "beforeFlush" f)) + + (add-after-render [this f] + (.enqueue this "afterRender" f)) + + (run-queues [this] + (set! scheduled? false) + (.flush-queues this)) + + (flush-after-render [this] + (.run-funs this "afterRender")) + + (flush-queues [this] + (.run-funs this "beforeFlush") + (ratom-flush) + (when-some [cs (aget this "componentQueue")] + (aset this "componentQueue" nil) + (run-queue cs)) + (.flush-after-render this))) + +(defonce render-queue (RenderQueue. false)) + +(defn flush [] + (.flush-queues render-queue)) + +(defn flush-after-render [] + (.flush-after-render render-queue)) + +(defn queue-render [c] + (when-not ($ c :cljsIsDirty) + ($! c :cljsIsDirty true) + (.queue-render render-queue c))) + +(defn mark-rendered [c] + ($! c :cljsIsDirty false)) + +(defn do-before-flush [f] + (.add-before-flush render-queue f)) + +(defn do-after-render [f] + (.add-after-render render-queue f)) + +(defn schedule [] + (when (false? (.-scheduled? render-queue)) + (.schedule render-queue))) diff --git a/src/mranderson047/reagent/v0v6v0/reagent/impl/component.cljs b/src/mranderson047/reagent/v0v6v0/reagent/impl/component.cljs new file mode 100644 index 0000000..2d4a26b --- /dev/null +++ b/src/mranderson047/reagent/v0v6v0/reagent/impl/component.cljs @@ -0,0 +1,317 @@ +(ns mranderson047.reagent.v0v6v0.reagent.impl.component + (:require [mranderson047.reagent.v0v6v0.reagent.impl.util :as util] + [mranderson047.reagent.v0v6v0.reagent.impl.batching :as batch] + [mranderson047.reagent.v0v6v0.reagent.ratom :as ratom] + [mranderson047.reagent.v0v6v0.reagent.interop :refer-macros [$ $!]] + [mranderson047.reagent.v0v6v0.reagent.debug :refer-macros [dbg prn dev? warn error warn-unless]])) + +(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) + ($ util/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 (ifn? 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 + (assert false "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 (not= old-argv new-argv)) + 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)))) + + nil)) + +(defn get-wrapper [key f name] + (let [wrap (custom-wrapper key f)] + (when (and wrap f) + (assert (ifn? f) + (str "Expected function in " name key " but got " 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 (ifn? render-fun) (str "Render must be a function, not " + (pr-str 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 + ($ util/react createClass))) + +(defn component-path [c] + (let [elem (some-> (or (some-> c ($ :_reactInternalInstance)) + c) + ($ :_currentElement)) + name (some-> elem + ($ :type) + ($ :displayName)) + path (some-> elem + ($ :_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 (ifn? f) (str "Expected a function, not " (pr-str 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))) diff --git a/src/mranderson047/reagent/v0v6v0/reagent/impl/template.cljs b/src/mranderson047/reagent/v0v6v0/reagent/impl/template.cljs new file mode 100644 index 0000000..2347898 --- /dev/null +++ b/src/mranderson047/reagent/v0v6v0/reagent/impl/template.cljs @@ -0,0 +1,395 @@ +(ns mranderson047.reagent.v0v6v0.reagent.impl.template + (:require [clojure.string :as string] + [clojure.walk :refer [prewalk]] + [mranderson047.reagent.v0v6v0.reagent.impl.util :as util :refer [is-client]] + [mranderson047.reagent.v0v6v0.reagent.impl.component :as comp] + [mranderson047.reagent.v0v6v0.reagent.impl.batching :as batch] + [mranderson047.reagent.v0v6v0.reagent.ratom :as ratom] + [mranderson047.reagent.v0v6v0.reagent.interop :refer-macros [$ $!]] + [mranderson047.reagent.v0v6v0.reagent.debug :refer-macros [dbg prn println log dev? + warn warn-unless]])) + +;; From Weavejester's Hiccup, via pump: +(def ^{:doc "Regular expression that parses a CSS-style id and class + from a tag name."} + re-tag #"([^\s\.#]+)(?:#([^\s\.#]+))?(?:\.([^\s#]+))?") + +(deftype NativeWrapper []) + + +;;; Common utilities + +(defn ^boolean named? [x] + (or (keyword? x) + (symbol? x))) + +(defn ^boolean hiccup-tag? [x] + (or (named? x) + (string? x))) + +(defn ^boolean valid-tag? [x] + (or (hiccup-tag? x) + (ifn? x) + (instance? NativeWrapper x))) + + +;;; Props conversion + +(def prop-name-cache #js{:class "className" + :for "htmlFor" + :charset "charSet"}) + +(defn cache-get [o k] + (when ^boolean (.hasOwnProperty o k) + (aget o k))) + +(defn cached-prop-name [k] + (if (named? k) + (if-some [k' (cache-get prop-name-cache (name k))] + k' + (aset prop-name-cache (name k) + (util/dash-to-camel k))) + k)) + +(defn ^boolean js-val? [x] + (not (identical? "object" (goog/typeOf x)))) + +(declare convert-prop-value) + +(defn kv-conv [o k v] + (doto o + (aset (cached-prop-name k) + (convert-prop-value v)))) + +(defn convert-prop-value [x] + (cond (js-val? x) x + (named? x) (name x) + (map? x) (reduce-kv kv-conv #js{} x) + (coll? x) (clj->js x) + (ifn? x) (fn [& args] + (apply x args)) + :else (clj->js x))) + +(defn oset [o k v] + (doto (if (nil? o) #js{} o) + (aset k v))) + +(defn oget [o k] + (if (nil? o) nil (aget o k))) + +(defn set-id-class [p id-class] + (let [id ($ id-class :id) + p (if (and (some? id) + (nil? (oget p "id"))) + (oset p "id" id) + p)] + (if-some [class ($ id-class :className)] + (let [old (oget p "className")] + (oset p "className" (if (nil? old) + class + (str class " " old)))) + p))) + +(defn convert-props [props id-class] + (-> props + convert-prop-value + (set-id-class id-class))) + + +;;; Specialization for input components + +;; +;; The properites 'selectionStart' and 'selectionEnd' only exist on some inputs +;; See: https://html.spec.whatwg.org/multipage/forms.html#do-not-apply +(def these-inputs-have-selection-api #{"text" "textarea" "password" "search" + "tel" "url"}) + +(defn ^boolean has-selection-api? + [input-type] + (contains? these-inputs-have-selection-api input-type)) + +(defn input-set-value [this] + (when-some [node ($ this :cljsInputElement)] + ($! this :cljsInputDirty false) + (let [rendered-value ($ this :cljsRenderedValue) + dom-value ($ this :cljsDOMValue)] + (when (not= rendered-value dom-value) + (if-not (and (identical? node ($ js/document :activeElement)) + (has-selection-api? ($ node :type)) + (string? rendered-value) + (string? dom-value)) + ;; just set the value, no need to worry about a cursor + (do + ($! this :cljsDOMValue rendered-value) + ($! node :value rendered-value)) + + ;; Setting "value" (below) moves the cursor position to the + ;; end which gives the user a jarring experience. + ;; + ;; But repositioning the cursor within the text, turns out to + ;; be quite a challenge because changes in the text can be + ;; triggered by various events like: + ;; - a validation function rejecting a user inputted char + ;; - the user enters a lower case char, but is transformed to + ;; upper. + ;; - the user selects multiple chars and deletes text + ;; - the user pastes in multiple chars, and some of them are + ;; rejected by a validator. + ;; - the user selects multiple chars and then types in a + ;; single new char to repalce them all. + ;; Coming up with a sane cursor repositioning strategy hasn't + ;; been easy ALTHOUGH in the end, it kinda fell out nicely, + ;; and it appears to sanely handle all the cases we could + ;; think of. + ;; So this is just a warning. The code below is simple + ;; enough, but if you are tempted to change it, be aware of + ;; all the scenarios you have handle. + (let [node-value ($ node :value)] + (if (not= node-value dom-value) + ;; IE has not notified us of the change yet, so check again later + (batch/do-after-render #(input-set-value this)) + (let [existing-offset-from-end (- (count node-value) + ($ node :selectionStart)) + new-cursor-offset (- (count rendered-value) + existing-offset-from-end)] + ($! this :cljsDOMValue rendered-value) + ($! node :value rendered-value) + ($! node :selectionStart new-cursor-offset) + ($! node :selectionEnd new-cursor-offset))))))))) + +(defn input-handle-change [this on-change e] + ($! this :cljsDOMValue (-> e .-target .-value)) + ;; Make sure the input is re-rendered, in case on-change + ;; wants to keep the value unchanged + (when-not ($ this :cljsInputDirty) + ($! this :cljsInputDirty true) + (batch/do-after-render #(input-set-value this))) + (on-change e)) + +(defn input-render-setup [this jsprops] + ;; Don't rely on React for updating "controlled inputs", since it + ;; doesn't play well with async rendering (misses keystrokes). + (when (and (some? jsprops) + (.hasOwnProperty jsprops "onChange") + (.hasOwnProperty jsprops "value")) + (let [v ($ jsprops :value) + value (if (nil? v) "" v) + on-change ($ jsprops :onChange)] + (when (nil? ($ this :cljsInputElement)) + ;; set initial value + ($! this :cljsDOMValue value)) + ($! this :cljsRenderedValue value) + (js-delete jsprops "value") + (doto jsprops + ($! :defaultValue value) + ($! :onChange #(input-handle-change this on-change %)) + ($! :ref #($! this :cljsInputElement %1)))))) + +(defn ^boolean input-component? [x] + (case x + ("input" "textarea") true + false)) + +(def reagent-input-class nil) + +(declare make-element) + +(def input-spec + {:display-name "ReagentInput" + :component-did-update input-set-value + :reagent-render + (fn [argv comp jsprops first-child] + (let [this comp/*current-component*] + (input-render-setup this jsprops) + (make-element argv comp jsprops first-child)))}) + +(defn reagent-input [] + (when (nil? reagent-input-class) + (set! reagent-input-class (comp/create-class input-spec))) + reagent-input-class) + + +;;; Conversion from Hiccup forms + +(defn parse-tag [hiccup-tag] + (let [[tag id class] (->> hiccup-tag name (re-matches re-tag) next) + class (when-not (nil? class) + (string/replace class #"\." " "))] + (assert tag (str "Invalid tag: '" hiccup-tag "'" + (comp/comp-name))) + #js{:name tag + :id id + :className class})) + +(defn try-get-key [x] + ;; try catch to avoid clojurescript peculiarity with + ;; sorted-maps with keys that are numbers + (try (get x :key) + (catch :default e))) + +(defn get-key [x] + (when (map? x) + (try-get-key x))) + +(defn key-from-vec [v] + (if-some [k (-> (meta v) get-key)] + k + (-> v (nth 1 nil) get-key))) + +(defn reag-element [tag v] + (let [c (comp/as-class tag) + jsprops #js{:argv v}] + (when-some [key (key-from-vec v)] + ($! jsprops :key key)) + ($ util/react createElement c jsprops))) + +(defn adapt-react-class [c] + (doto (NativeWrapper.) + ($! :name c) + ($! :id nil) + ($! :class nil))) + +(def tag-name-cache #js{}) + +(defn cached-parse [x] + (if-some [s (cache-get tag-name-cache x)] + s + (aset tag-name-cache x (parse-tag x)))) + +(declare as-element) + +(defn native-element [parsed argv first] + (let [comp ($ parsed :name)] + (let [props (nth argv first nil) + hasprops (or (nil? props) (map? props)) + jsprops (convert-props (if hasprops props) parsed) + first-child (+ first (if hasprops 1 0))] + (if (input-component? comp) + (-> [(reagent-input) argv comp jsprops first-child] + (with-meta (meta argv)) + as-element) + (let [key (-> (meta argv) get-key) + p (if (nil? key) + jsprops + (oset jsprops "key" key))] + (make-element argv comp p first-child)))))) + +(defn str-coll [coll] + (if (dev?) + (str (prewalk (fn [x] + (if (fn? x) + (let [n (util/fun-name x)] + (case n "" x (symbol n))) + x)) coll)) + (str coll))) + +(defn hiccup-err [v & msg] + (str (apply str msg) ": " (str-coll v) "\n" (comp/comp-name))) + +(defn vec-to-elem [v] + (assert (pos? (count v)) (hiccup-err v "Hiccup form should not be empty")) + (let [tag (nth v 0 nil)] + (assert (valid-tag? tag) (hiccup-err v "Invalid Hiccup form")) + (cond + (hiccup-tag? tag) + (let [n (name tag) + pos (.indexOf n ">")] + (case pos + -1 (native-element (cached-parse n) v 1) + 0 (let [comp (nth v 1 nil)] + ;; Support [:> comp ...] + (assert (= ">" n) (hiccup-err v "Invalid Hiccup tag")) + (assert (or (string? comp) (fn? comp)) + (hiccup-err v "Expected React component in")) + (native-element #js{:name comp} v 2)) + ;; Support extended hiccup syntax, i.e :div.bar>a.foo + (recur [(subs n 0 pos) + (assoc v 0 (subs n (inc pos)))]))) + + (instance? NativeWrapper tag) + (native-element tag v 1) + + :else (reag-element tag v)))) + +(declare expand-seq) +(declare expand-seq-check) + +(defn as-element [x] + (cond (js-val? x) x + (vector? x) (vec-to-elem x) + (seq? x) (if (dev?) + (expand-seq-check x) + (expand-seq x)) + (named? x) (name x) + (satisfies? IPrintWithWriter x) (pr-str x) + :else x)) + +(set! comp/as-element as-element) + +(defn expand-seq [s] + (let [a (into-array s)] + (dotimes [i (alength a)] + (aset a i (as-element (aget a i)))) + a)) + +(defn expand-seq-dev [s o] + (let [a (into-array s)] + (dotimes [i (alength a)] + (let [val (aget a i)] + (when (and (vector? val) + (nil? (key-from-vec val))) + ($! o :no-key true)) + (aset a i (as-element val)))) + a)) + +(defn expand-seq-check [x] + (let [ctx #js{} + [res derefed] (ratom/check-derefs #(expand-seq-dev x ctx))] + (when derefed + (warn (hiccup-err x "Reactive deref not supported in lazy seq, " + "it should be wrapped in doall"))) + (when ($ ctx :no-key) + (warn (hiccup-err x "Every element in a seq should have a unique :key"))) + res)) + +;; From https://github.com/babel/babel/commit/1d0e68f5a19d721fe8799b1ea331041d8bf9120e +;; (def react-element-type (or (and (exists? js/Symbol) +;; ($ js/Symbol :for) +;; ($ js/Symbol for "react.element")) +;; 60103)) + +;; (defn make-element-fast [argv comp jsprops first-child] +;; (let [key (some-> jsprops ($ :key)) +;; ref (some-> jsprops ($ :ref)) +;; props (if (nil? jsprops) (js-obj) jsprops)] +;; ($! props :children +;; (case (- (count argv) first-child) +;; 0 nil +;; 1 (as-element (nth argv first-child)) +;; (reduce-kv (fn [a k v] +;; (when (>= k first-child) +;; (.push a (as-element v))) +;; a) +;; #js[] argv))) +;; (js-obj "key" key +;; "ref" ref +;; "props" props +;; "$$typeof" react-element-type +;; "type" comp +;; ;; "_store" (js-obj) +;; ))) + +(defn make-element [argv comp jsprops first-child] + (case (- (count argv) first-child) + ;; Optimize cases of zero or one child + 0 ($ util/react createElement comp jsprops) + + 1 ($ util/react createElement comp jsprops + (as-element (nth argv first-child nil))) + + (.apply ($ util/react :createElement) nil + (reduce-kv (fn [a k v] + (when (>= k first-child) + (.push a (as-element v))) + a) + #js[comp jsprops] argv)))) diff --git a/src/mranderson047/reagent/v0v6v0/reagent/impl/util.cljs b/src/mranderson047/reagent/v0v6v0/reagent/impl/util.cljs new file mode 100644 index 0000000..805e6e2 --- /dev/null +++ b/src/mranderson047/reagent/v0v6v0/reagent/impl/util.cljs @@ -0,0 +1,102 @@ +(ns mranderson047.reagent.v0v6v0.reagent.impl.util + (:require [cljsjs.react] + [mranderson047.reagent.v0v6v0.reagent.debug :refer-macros [dbg log warn]] + [mranderson047.reagent.v0v6v0.reagent.interop :refer-macros [$ $!]] + [clojure.string :as string])) + +(defonce react + (cond (exists? js/React) js/React + (exists? js/require) (or (js/require "react") + (throw (js/Error. "require('react') failed"))) + :else (throw (js/Error. "js/React is missing")))) + +(def is-client (and (exists? js/window) + (-> js/window ($ :document) nil? not))) + +(def ^:dynamic ^boolean *non-reactive* false) + +;;; Props accessors + +;; Misc utilities + +(defn memoize-1 [f] + (let [mem (atom {})] + (fn [arg] + (let [v (get @mem arg)] + (if-not (nil? v) + v + (let [ret (f arg)] + (swap! mem assoc arg ret) + ret)))))) + +(def dont-camel-case #{"aria" "data"}) + +(defn capitalize [s] + (if (< (count s) 2) + (string/upper-case s) + (str (string/upper-case (subs s 0 1)) (subs s 1)))) + +(defn dash-to-camel [dashed] + (if (string? dashed) + dashed + (let [name-str (name dashed) + [start & parts] (string/split name-str #"-")] + (if (dont-camel-case start) + name-str + (apply str start (map capitalize parts)))))) + +(defn fun-name [f] + (let [n (or (and (fn? f) + (or ($ f :displayName) + ($ f :name))) + (and (implements? INamed f) + (name f)) + (let [m (meta f)] + (if (map? m) + (:name m))))] + (-> n + str + (clojure.string/replace "$" ".")))) + +(deftype partial-ifn [f args ^:mutable p] + IFn + (-invoke [_ & a] + (or p (set! p (apply clojure.core/partial f args))) + (apply p a)) + IEquiv + (-equiv [_ other] + (and (= f (.-f other)) (= args (.-args other)))) + IHash + (-hash [_] (hash [f args]))) + +(defn- merge-class [p1 p2] + (let [class (when-let [c1 (:class p1)] + (when-let [c2 (:class p2)] + (str c1 " " c2)))] + (if (nil? class) + p2 + (assoc p2 :class class)))) + +(defn- merge-style [p1 p2] + (let [style (when-let [s1 (:style p1)] + (when-let [s2 (:style p2)] + (merge s1 s2)))] + (if (nil? style) + p2 + (assoc p2 :style style)))) + +(defn merge-props [p1 p2] + (if (nil? p1) + p2 + (do + (assert (map? p1)) + (merge-style p1 (merge-class p1 (merge p1 p2)))))) + + +(def ^:dynamic *always-update* false) + +(defn force-update [comp deep] + (if deep + (binding [*always-update* true] + ($ comp forceUpdate)) + ($ comp forceUpdate))) diff --git a/src/mranderson047/reagent/v0v6v0/reagent/interop.clj b/src/mranderson047/reagent/v0v6v0/reagent/interop.clj new file mode 100644 index 0000000..07d39f9 --- /dev/null +++ b/src/mranderson047/reagent/v0v6v0/reagent/interop.clj @@ -0,0 +1,75 @@ +(ns mranderson047.reagent.v0v6v0.reagent.interop + (:require [clojure.string :as string :refer [join]] + [clojure.java.io :as io])) + +(defn- js-call [f args] + (let [argstr (->> (repeat (count args) "~{}") + (join ","))] + (list* 'js* (str "~{}(" argstr ")") f args))) + +(defn- dot-args [object member] + (assert (or (symbol? member) + (keyword? member)) + (str "Symbol or keyword expected, not " member)) + (assert (or (not (symbol? object)) + (not (re-find #"\." (name object)))) + (str "Dot not allowed in " object)) + (let [n (name member) + field? (or (keyword? member) + (= (subs n 0 1) "-")) + names (-> (if (symbol? member) + (string/replace n #"^-" "") + n) + (string/split #"\."))] + [field? names])) + +(defmacro $ + "Access member in a javascript object, in a Closure-safe way. + 'member' is assumed to be a field if it is a keyword or if + the name starts with '-', otherwise the named function is + called with the optional args. + 'member' may contain '.', to allow access in nested objects. + If 'object' is a symbol it is not allowed contain '.'. + + ($ o :foo) is equivalent to (.-foo o), except that it gives + the same result under advanced compilation. + ($ o foo arg1 arg2) is the same as (.foo o arg1 arg2)." + [object member & args] + (let [[field names] (dot-args object member)] + (if field + (do + (assert (empty? args) + (str "Passing args to field doesn't make sense: " member)) + `(aget ~object ~@names)) + (js-call (list* 'aget object names) args)))) + +(defmacro $! + "Set field in a javascript object, in a Closure-safe way. + 'field' should be a keyword or a symbol starting with '-'. + 'field' may contain '.', to allow access in nested objects. + If 'object' is a symbol it is not allowed contain '.'. + + ($! o :foo 1) is equivalent to (set! (.-foo o) 1), except that it + gives the same result under advanced compilation." + [object field value] + (let [[field names] (dot-args object field)] + (assert field (str "Field name must start with - in " field)) + `(aset ~object ~@names ~value))) + +(defmacro .' [& args] + ;; Deprecated since names starting with . cause problems with bootstrapped cljs. + (let [ns (str cljs.analyzer/*cljs-ns*) + line (:line (meta &form))] + (binding [*out* *err*] + (println "WARNING: mranderson047.reagent.v0v6v0.reagent.interop/.' is deprecated in " ns " line " line + ". Use mranderson047.reagent.v0v6v0.reagent.interop/$ instead."))) + `($ ~@args)) + +(defmacro .! [& args] + ;; Deprecated since names starting with . cause problems with bootstrapped cljs. + (let [ns (str cljs.analyzer/*cljs-ns*) + line (:line (meta &form))] + (binding [*out* *err*] + (println "WARNING: mranderson047.reagent.v0v6v0.reagent.interop/.! is deprecated in " ns " line " line + ". Use mranderson047.reagent.v0v6v0.reagent.interop/$! instead."))) + `($! ~@args)) diff --git a/src/mranderson047/reagent/v0v6v0/reagent/interop.cljs b/src/mranderson047/reagent/v0v6v0/reagent/interop.cljs new file mode 100644 index 0000000..f69691d --- /dev/null +++ b/src/mranderson047/reagent/v0v6v0/reagent/interop.cljs @@ -0,0 +1,2 @@ +(ns mranderson047.reagent.v0v6v0.reagent.interop + (:require-macros [mranderson047.reagent.v0v6v0.reagent.interop])) diff --git a/src/mranderson047/reagent/v0v6v0/reagent/ratom.clj b/src/mranderson047/reagent/v0v6v0/reagent/ratom.clj new file mode 100644 index 0000000..b05051b --- /dev/null +++ b/src/mranderson047/reagent/v0v6v0/reagent/ratom.clj @@ -0,0 +1,53 @@ +(ns mranderson047.reagent.v0v6v0.reagent.ratom + (:refer-clojure :exclude [run!]) + (:require [mranderson047.reagent.v0v6v0.reagent.debug :as d])) + +(defmacro reaction [& body] + `(mranderson047.reagent.v0v6v0.reagent.ratom/make-reaction + (fn [] ~@body))) + +(defmacro run! + "Runs body immediately, and runs again whenever atoms deferenced in the body change. Body should side effect." + [& body] + `(let [co# (mranderson047.reagent.v0v6v0.reagent.ratom/make-reaction (fn [] ~@body) + :auto-run true)] + (deref co#) + co#)) + +(defmacro with-let [bindings & body] + (assert (vector? bindings)) + (let [v (gensym "with-let") + k (keyword v) + init (gensym "init") + bs (into [init `(zero? (alength ~v))] + (map-indexed (fn [i x] + (if (even? i) + x + (let [j (quot i 2)] + `(if ~init + (aset ~v ~j ~x) + (aget ~v ~j))))) + bindings)) + [forms destroy] (let [fin (last body)] + (if (and (list? fin) + (= 'finally (first fin))) + [(butlast body) `(fn [] ~@(rest fin))] + [body nil])) + add-destroy (when destroy + `(let [destroy# ~destroy] + (if (mranderson047.reagent.v0v6v0.reagent.ratom/reactive?) + (when (nil? (.-destroy ~v)) + (set! (.-destroy ~v) destroy#)) + (destroy#)))) + asserting (if *assert* true false)] + `(let [~v (mranderson047.reagent.v0v6v0.reagent.ratom/with-let-values ~k)] + (when ~asserting + (when-some [c# mranderson047.reagent.v0v6v0.reagent.ratom/*ratom-context*] + (when (== (.-generation ~v) (.-ratomGeneration c#)) + (d/error "Warning: The same with-let is being used more " + "than once in the same reactive context.")) + (set! (.-generation ~v) (.-ratomGeneration c#)))) + (let ~bs + (let [res# (do ~@forms)] + ~add-destroy + res#))))) diff --git a/src/mranderson047/reagent/v0v6v0/reagent/ratom.cljs b/src/mranderson047/reagent/v0v6v0/reagent/ratom.cljs new file mode 100644 index 0000000..3ceee38 --- /dev/null +++ b/src/mranderson047/reagent/v0v6v0/reagent/ratom.cljs @@ -0,0 +1,592 @@ +(ns mranderson047.reagent.v0v6v0.reagent.ratom + (:refer-clojure :exclude [atom]) + (:require-macros [mranderson047.reagent.v0v6v0.reagent.ratom :refer [with-let]]) + (:require [mranderson047.reagent.v0v6v0.reagent.impl.util :as util] + [mranderson047.reagent.v0v6v0.reagent.debug :refer-macros [dbg log warn error dev? time]] + [mranderson047.reagent.v0v6v0.reagent.impl.batching :as batch] + [clojure.set :as s])) + +(declare ^:dynamic *ratom-context*) +(defonce ^boolean debug false) +(defonce ^:private generation 0) +(defonce ^:private -running (clojure.core/atom 0)) + +(defn ^boolean reactive? [] + (some? *ratom-context*)) + + +;;; Utilities + +(defn running [] + (+ @-running)) + +(defn- ^number arr-len [x] + (if (nil? x) 0 (alength x))) + +(defn- ^boolean arr-eq [x y] + (let [len (arr-len x)] + (and (== len (arr-len y)) + (loop [i 0] + (or (== i len) + (if (identical? (aget x i) (aget y i)) + (recur (inc i)) + false)))))) + +(defn- in-context [obj f] + (binding [*ratom-context* obj] + (f))) + +(defn- deref-capture [f r] + (set! (.-captured r) nil) + (when (dev?) + (set! (.-ratomGeneration r) (set! generation (inc generation)))) + (let [res (in-context r f) + c (.-captured r)] + (set! (.-dirty? r) false) + ;; Optimize common case where derefs occur in same order + (when-not (arr-eq c (.-watching r)) + (._update-watching r c)) + res)) + +(defn- notify-deref-watcher! [derefed] + (when-some [r *ratom-context*] + (let [c (.-captured r)] + (if (nil? c) + (set! (.-captured r) (array derefed)) + (.push c derefed))))) + +(defn- check-watches [old new] + (when debug + (swap! -running + (- (count new) (count old)))) + new) + +(defn- add-w [this key f] + (let [w (.-watches this)] + (set! (.-watches this) (check-watches w (assoc w key f))) + (set! (.-watchesArr this) nil))) + +(defn- remove-w [this key] + (let [w (.-watches this)] + (set! (.-watches this) (check-watches w (dissoc w key))) + (set! (.-watchesArr this) nil))) + +(defn- notify-w [this old new] + (let [w (.-watchesArr this) + a (if (nil? w) + ;; Copy watches to array for speed + (->> (.-watches this) + (reduce-kv #(doto %1 (.push %2) (.push %3)) #js[]) + (set! (.-watchesArr this))) + w)] + (let [len (alength a)] + (loop [i 0] + (when (< i len) + (let [k (aget a i) + f (aget a (inc i))] + (f k this old new)) + (recur (+ 2 i))))))) + +(defn- pr-atom [a writer opts s] + (-write writer (str "#<" s " ")) + (pr-writer (binding [*ratom-context* nil] (-deref a)) writer opts) + (-write writer ">")) + + +;;; Queueing + +(defonce ^:private rea-queue nil) + +(defn- rea-enqueue [r] + (when (nil? rea-queue) + (set! rea-queue (array)) + (batch/schedule)) + (.push rea-queue r)) + +(defn flush! [] + (loop [] + (let [q rea-queue] + (when-not (nil? q) + (set! rea-queue nil) + (dotimes [i (alength q)] + (._queued-run (aget q i))) + (recur))))) + +(set! batch/ratom-flush flush!) + + +;;; Atom + +(defprotocol IReactiveAtom) + +(deftype RAtom [^:mutable state meta validator ^:mutable watches] + IAtom + IReactiveAtom + + IEquiv + (-equiv [o other] (identical? o other)) + + IDeref + (-deref [this] + (notify-deref-watcher! this) + state) + + IReset + (-reset! [a new-value] + (when-not (nil? validator) + (assert (validator new-value) "Validator rejected reference state")) + (let [old-value state] + (set! state new-value) + (when-not (nil? watches) + (notify-w a old-value new-value)) + new-value)) + + ISwap + (-swap! [a f] (-reset! a (f state))) + (-swap! [a f x] (-reset! a (f state x))) + (-swap! [a f x y] (-reset! a (f state x y))) + (-swap! [a f x y more] (-reset! a (apply f state x y more))) + + IMeta + (-meta [_] meta) + + IPrintWithWriter + (-pr-writer [a w opts] (pr-atom a w opts "Atom:")) + + IWatchable + (-notify-watches [this old new] (notify-w this old new)) + (-add-watch [this key f] (add-w this key f)) + (-remove-watch [this key] (remove-w this key)) + + IHash + (-hash [this] (goog/getUid this))) + +(defn atom + "Like clojure.core/atom, except that it keeps track of derefs." + ([x] (RAtom. x nil nil nil)) + ([x & {:keys [meta validator]}] (RAtom. x meta validator nil))) + + +;;; track + +(declare make-reaction) + +(def ^{:private true :const true} cache-key "reagReactionCache") + +(defn- cached-reaction [f o k obj destroy] + (let [m (aget o cache-key) + m (if (nil? m) {} m) + r (m k nil)] + (cond + (some? r) (-deref r) + (nil? *ratom-context*) (f) + :else (let [r (make-reaction + f :on-dispose (fn [x] + (when debug (swap! -running dec)) + (as-> (aget o cache-key) _ + (dissoc _ k) + (aset o cache-key _)) + (when (some? obj) + (set! (.-reaction obj) nil)) + (when (some? destroy) + (destroy x)))) + v (-deref r)] + (aset o cache-key (assoc m k r)) + (when debug (swap! -running inc)) + (when (some? obj) + (set! (.-reaction obj) r)) + v)))) + +(deftype Track [f args ^:mutable reaction] + IReactiveAtom + + IDeref + (-deref [this] + (if-some [r reaction] + (-deref r) + (cached-reaction #(apply f args) f args this nil))) + + IEquiv + (-equiv [_ other] + (and (instance? Track other) + (= f (.-f other)) + (= args (.-args other)))) + + IHash + (-hash [_] (hash [f args])) + + IPrintWithWriter + (-pr-writer [a w opts] (pr-atom a w opts "Track:"))) + +(defn make-track [f args] + (Track. f args nil)) + +(defn make-track! [f args] + (let [t (make-track f args) + r (make-reaction #(-deref t) + :auto-run true)] + @r + r)) + +(defn track [f & args] + {:pre [(ifn? f)]} + (make-track f args)) + +(defn track! [f & args] + {:pre [(ifn? f)]} + (make-track! f args)) + +;;; cursor + +(deftype RCursor [ratom path ^:mutable reaction + ^:mutable state ^:mutable watches] + IAtom + IReactiveAtom + + IEquiv + (-equiv [_ other] + (and (instance? RCursor other) + (= path (.-path other)) + (= ratom (.-ratom other)))) + + Object + (_peek [this] + (binding [*ratom-context* nil] + (-deref this))) + + (_set-state [this oldstate newstate] + (when-not (identical? oldstate newstate) + (set! state newstate) + (when (some? watches) + (notify-w this oldstate newstate)))) + + IDeref + (-deref [this] + (let [oldstate state + newstate (if-some [r reaction] + (-deref r) + (let [f (if (satisfies? IDeref ratom) + #(get-in @ratom path) + #(ratom path))] + (cached-reaction f ratom path this nil)))] + (._set-state this oldstate newstate) + newstate)) + + IReset + (-reset! [this new-value] + (let [oldstate state] + (._set-state this oldstate new-value) + (if (satisfies? IDeref ratom) + (if (= path []) + (reset! ratom new-value) + (swap! ratom assoc-in path new-value)) + (ratom path new-value)) + new-value)) + + ISwap + (-swap! [a f] (-reset! a (f (._peek a)))) + (-swap! [a f x] (-reset! a (f (._peek a) x))) + (-swap! [a f x y] (-reset! a (f (._peek a) x y))) + (-swap! [a f x y more] (-reset! a (apply f (._peek a) x y more))) + + IPrintWithWriter + (-pr-writer [a w opts] (pr-atom a w opts (str "Cursor: " path))) + + IWatchable + (-notify-watches [this old new] (notify-w this old new)) + (-add-watch [this key f] (add-w this key f)) + (-remove-watch [this key] (remove-w this key)) + + IHash + (-hash [_] (hash [ratom path]))) + +(defn cursor + [src path] + (assert (or (satisfies? IReactiveAtom src) + (and (ifn? src) + (not (vector? src)))) + (str "src must be a reactive atom or a function, not " + (pr-str src))) + (RCursor. src path nil nil nil)) + + +;;; with-let support + +(defn with-let-destroy [v] + (when-some [f (.-destroy v)] + (f))) + +(defn with-let-values [key] + (if-some [c *ratom-context*] + (cached-reaction array c key + nil with-let-destroy) + (array))) + + +;;;; reaction + +(defprotocol IDisposable + (dispose! [this]) + (add-on-dispose! [this f])) + +(defprotocol IRunnable + (run [this])) + +(defn- handle-reaction-change [this sender old new] + (._handle-change this sender old new)) + + +(deftype Reaction [f ^:mutable state ^:mutable ^boolean dirty? ^boolean nocache? + ^:mutable watching ^:mutable watches ^:mutable auto-run + ^:mutable caught] + IAtom + IReactiveAtom + + IWatchable + (-notify-watches [this old new] (notify-w this old new)) + (-add-watch [this key f] (add-w this key f)) + (-remove-watch [this key] + (let [was-empty (empty? watches)] + (remove-w this key) + (when (and (not was-empty) + (empty? watches) + (nil? auto-run)) + (dispose! this)))) + + IReset + (-reset! [a newval] + (assert (fn? (.-on-set a)) "Reaction is read only.") + (let [oldval state] + (set! state newval) + (.on-set a oldval newval) + (notify-w a oldval newval) + newval)) + + ISwap + (-swap! [a f] (-reset! a (f (._peek-at a)))) + (-swap! [a f x] (-reset! a (f (._peek-at a) x))) + (-swap! [a f x y] (-reset! a (f (._peek-at a) x y))) + (-swap! [a f x y more] (-reset! a (apply f (._peek-at a) x y more))) + + Object + (_peek-at [this] + (binding [*ratom-context* nil] + (-deref this))) + + (_handle-change [this sender oldval newval] + (when-not (or (identical? oldval newval) + dirty?) + (if (nil? auto-run) + (do + (set! dirty? true) + (rea-enqueue this)) + (if (true? auto-run) + (._run this false) + (auto-run this))))) + + (_update-watching [this derefed] + (let [new (set derefed) + old (set watching)] + (set! watching derefed) + (doseq [w (s/difference new old)] + (-add-watch w this handle-reaction-change)) + (doseq [w (s/difference old new)] + (-remove-watch w this)))) + + (_queued-run [this] + (when (and dirty? (some? watching)) + (._run this true))) + + (_try-capture [this f] + (try + (set! caught nil) + (deref-capture f this) + (catch :default e + (set! state e) + (set! caught e) + (set! dirty? false)))) + + (_run [this check] + (let [oldstate state + res (if check + (._try-capture this f) + (deref-capture f this))] + (when-not nocache? + (set! state res) + ;; Use = to determine equality from reactions, since + ;; they are likely to produce new data structures. + (when-not (or (nil? watches) + (= oldstate res)) + (notify-w this oldstate res))) + res)) + + (_set-opts [this {:keys [auto-run on-set on-dispose no-cache]}] + (when (some? auto-run) + (set! (.-auto-run this) auto-run)) + (when (some? on-set) + (set! (.-on-set this) on-set)) + (when (some? on-dispose) + (set! (.-on-dispose this) on-dispose)) + (when (some? no-cache) + (set! (.-nocache? this) no-cache))) + + IRunnable + (run [this] + (flush!) + (._run this false)) + + IDeref + (-deref [this] + (when-some [e caught] + (throw e)) + (let [non-reactive (nil? *ratom-context*)] + (when non-reactive + (flush!)) + (if (and non-reactive (nil? auto-run)) + (when dirty? + (let [oldstate state] + (set! state (f)) + (when-not (or (nil? watches) (= oldstate state)) + (notify-w this oldstate state)))) + (do + (notify-deref-watcher! this) + (when dirty? + (._run this false))))) + state) + + IDisposable + (dispose! [this] + (let [s state + wg watching] + (set! watching nil) + (set! state nil) + (set! auto-run nil) + (set! dirty? true) + (doseq [w (set wg)] + (-remove-watch w this)) + (when (some? (.-on-dispose this)) + (.on-dispose this s)) + (when-some [a (.-on-dispose-arr this)] + (dotimes [i (alength a)] + ((aget a i) this))))) + + (add-on-dispose! [this f] + ;; f is called with the reaction as argument when it is no longer active + (if-some [a (.-on-dispose-arr this)] + (.push a f) + (set! (.-on-dispose-arr this) (array f)))) + + IEquiv + (-equiv [o other] (identical? o other)) + + IPrintWithWriter + (-pr-writer [a w opts] (pr-atom a w opts (str "Reaction " (hash a) ":"))) + + IHash + (-hash [this] (goog/getUid this))) + + +(defn make-reaction [f & {:keys [auto-run on-set on-dispose]}] + (let [reaction (Reaction. f nil true false nil nil nil nil)] + (._set-opts reaction {:auto-run auto-run + :on-set on-set + :on-dispose on-dispose}) + reaction)) + + + +(def ^:private temp-reaction (make-reaction nil)) + +(defn run-in-reaction [f obj key run opts] + (let [r temp-reaction + res (deref-capture f r)] + (when-not (nil? (.-watching r)) + (set! temp-reaction (make-reaction nil)) + (._set-opts r opts) + (set! (.-f r) f) + (set! (.-auto-run r) #(run obj)) + (aset obj key r)) + res)) + +(defn check-derefs [f] + (let [ctx (js-obj) + res (in-context ctx f)] + [res (some? (.-captured ctx))])) + + +;;; wrap + +(deftype Wrapper [^:mutable state callback ^:mutable ^boolean changed + ^:mutable watches] + + IAtom + + IDeref + (-deref [this] + (when (dev?) + (when (and changed (some? *ratom-context*)) + (warn "derefing stale wrap: " + (pr-str this)))) + state) + + IReset + (-reset! [this newval] + (let [oldval state] + (set! changed true) + (set! state newval) + (when (some? watches) + (notify-w this oldval newval)) + (callback newval) + newval)) + + ISwap + (-swap! [a f] (-reset! a (f state))) + (-swap! [a f x] (-reset! a (f state x))) + (-swap! [a f x y] (-reset! a (f state x y))) + (-swap! [a f x y more] (-reset! a (apply f state x y more))) + + IEquiv + (-equiv [_ other] + (and (instance? Wrapper other) + ;; If either of the wrappers have changed, equality + ;; cannot be relied on. + (not changed) + (not (.-changed other)) + (= state (.-state other)) + (= callback (.-callback other)))) + + IWatchable + (-notify-watches [this old new] (notify-w this old new)) + (-add-watch [this key f] (add-w this key f)) + (-remove-watch [this key] (remove-w this key)) + + IPrintWithWriter + (-pr-writer [a w opts] (pr-atom a w opts "Wrap:"))) + +(defn make-wrapper [value callback-fn args] + (Wrapper. value + (util/partial-ifn. callback-fn args nil) + false nil)) + + + + +#_(do + (defn ratom-perf [] + (set! debug false) + (dotimes [_ 10] + (let [nite 100000 + a (atom 0) + f (fn [] + (quot @a 10)) + mid (make-reaction f) + res (track! (fn [] + ;; (with-let [x 1]) + ;; @(track f) + (inc @mid) + ))] + @res + (time (dotimes [x nite] + (swap! a inc) + (flush!))) + (dispose! res)))) + (ratom-perf))