Add Reagent to source dependencies
This commit is contained in:
Daniel Compton
parent
4e3fb7fae6
commit
9cfe463d02
|
|
@ -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.
|
||||
|
|
|
|||
32
project.clj
32
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]]]}})
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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))))
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
@ -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))
|
||||
|
|
@ -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#)))
|
||||
|
|
@ -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))
|
||||
|
|
@ -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")
|
||||
|
|
@ -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))))
|
||||
|
|
@ -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)))
|
||||
|
|
@ -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)))
|
||||
|
|
@ -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
|
||||
|
||||
;; <input type="??" >
|
||||
;; 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))))
|
||||
|
|
@ -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)))
|
||||
|
|
@ -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))
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
(ns mranderson047.reagent.v0v6v0.reagent.interop
|
||||
(:require-macros [mranderson047.reagent.v0v6v0.reagent.interop]))
|
||||
|
|
@ -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#)))))
|
||||
|
|
@ -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))
|
||||
Loading…
Reference in New Issue