mirror of
https://github.com/status-im/re-frame-10x.git
synced 2025-01-12 15:14:55 +00:00
Use mranderson to bundle an isolated copy of re-frame
This allows us to re-frame, while we instrument re-frame.
This commit is contained in:
parent
6bd14f1799
commit
900bb414e9
@ -73,3 +73,14 @@ We are using CSS preprocessing because in order to isolate the panel styles, we
|
||||
- You must touch or save the `styles.cljs` file to trigger a CSS reload if you're editing `main.less`. This is because `styles.cljs` slurps `main.css` with a macro that happens before Clojurescript compilation, so figwheel isn't aware of the changes.
|
||||
- Did you run `lein less auto` or `lein less once` to compile LESS to CSS?
|
||||
- Try clearing your browser cache/hard-reloading.
|
||||
|
||||
### 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.
|
||||
|
||||
```console
|
||||
$ lein do clean
|
||||
$ lein with-profile mranderson source-deps
|
||||
$ cp -r target/srcdeps/mranderson047 src
|
||||
```
|
||||
|
||||
|
17
project.clj
17
project.clj
@ -5,13 +5,16 @@
|
||||
:dependencies [[org.clojure/clojure "1.8.0"]
|
||||
[org.clojure/clojurescript "1.9.227"]
|
||||
[reagent "0.6.0" :scope "provided"]
|
||||
[re-frame "0.9.0" :scope "provided"]
|
||||
[re-frame "0.10.2" :scope "provided"]
|
||||
[cljsjs/d3 "4.3.0-5"]
|
||||
[binaryage/devtools "0.9.4"]]
|
||||
:plugins [[lein-less "1.7.5"]]
|
||||
:plugins [[lein-less "1.7.5"]
|
||||
[thomasa/mranderson "0.4.7"]]
|
||||
:deploy-repositories {"releases" :clojars
|
||||
"snapshots" :clojars}
|
||||
|
||||
;:source-paths ["target/srcdeps"]
|
||||
|
||||
:release-tasks [["vcs" "assert-committed"]
|
||||
["change" "version" "leiningen.release/bump-version" "release"]
|
||||
["less" "once"]
|
||||
@ -27,4 +30,12 @@
|
||||
:less {:source-paths ["resources/day8/re_frame/trace"]
|
||||
:target-path "resources/day8/re_frame/trace"}
|
||||
|
||||
:profiles {:dev {:dependencies [[binaryage/dirac "RELEASE"]]}})
|
||||
: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]]]}})
|
||||
|
114
src/mranderson047/re_frame/v0v10v2/re_frame/cofx.cljc
Normal file
114
src/mranderson047/re_frame/v0v10v2/re_frame/cofx.cljc
Normal file
@ -0,0 +1,114 @@
|
||||
(ns mranderson047.re-frame.v0v10v2.re-frame.cofx
|
||||
(:require
|
||||
[mranderson047.re-frame.v0v10v2.re-frame.db :refer [app-db]]
|
||||
[mranderson047.re-frame.v0v10v2.re-frame.interceptor :refer [->interceptor]]
|
||||
[mranderson047.re-frame.v0v10v2.re-frame.registrar :refer [get-handler clear-handlers register-handler]]
|
||||
[mranderson047.re-frame.v0v10v2.re-frame.loggers :refer [console]]))
|
||||
|
||||
|
||||
;; -- Registration ------------------------------------------------------------
|
||||
|
||||
(def kind :cofx)
|
||||
(assert (mranderson047.re-frame.v0v10v2.re-frame.registrar/kinds kind))
|
||||
|
||||
(defn reg-cofx
|
||||
"Register the given coeffect `handler` for the given `id`, for later use
|
||||
within `inject-cofx`.
|
||||
|
||||
`id` is keyword, often namespaced.
|
||||
`handler` is a function which takes either one or two arguements, the first of which is
|
||||
always `coeffects` and which returns an updated `coeffects`.
|
||||
|
||||
See the docs for `inject-cofx` for example use."
|
||||
[id handler]
|
||||
(register-handler kind id handler))
|
||||
|
||||
|
||||
;; -- Interceptor -------------------------------------------------------------
|
||||
|
||||
(defn inject-cofx
|
||||
"Given an `id`, and an optional, arbitrary `value`, returns an interceptor
|
||||
whose `:before` adds to the `:coeffects` (map) by calling a pre-registered
|
||||
'coeffect handler' identified by the `id`.
|
||||
|
||||
The previous association of a `coeffect handler` with an `id` will have
|
||||
happened via a call to `mranderson047.re-frame.v0v10v2.re-frame.core/reg-cofx` - generally on program startup.
|
||||
|
||||
Within the created interceptor, this 'looked up' `coeffect handler` will
|
||||
be called (within the `:before`) with two arguments:
|
||||
- the current value of `:coeffects`
|
||||
- optionally, the originally supplied arbitrary `value`
|
||||
|
||||
This `coeffect handler` is expected to modify and return its first, `coeffects` argument.
|
||||
|
||||
Example Of how `inject-cofx` and `reg-cofx` work together
|
||||
---------------------------------------------------------
|
||||
|
||||
1. Early in app startup, you register a `coeffect handler` for `:datetime`:
|
||||
|
||||
(mranderson047.re-frame.v0v10v2.re-frame.core/reg-cofx
|
||||
:datetime ;; usage (inject-cofx :datetime)
|
||||
(fn coeffect-handler
|
||||
[coeffect]
|
||||
(assoc coeffect :now (js/Date.)))) ;; modify and return first arg
|
||||
|
||||
2. Later, add an interceptor to an -fx event handler, using `inject-cofx`:
|
||||
|
||||
(mranderson047.re-frame.v0v10v2.re-frame.core/reg-event-fx ;; we are registering an event handler
|
||||
:event-id
|
||||
[ ... (inject-cofx :datetime) ... ] ;; <-- create an injecting interceptor
|
||||
(fn event-handler
|
||||
[coeffect event]
|
||||
... in here can access (:now coeffect) to obtain current datetime ... )))
|
||||
|
||||
Background
|
||||
----------
|
||||
|
||||
`coeffects` are the input resources required by an event handler
|
||||
to perform its job. The two most obvious ones are `db` and `event`.
|
||||
But sometimes an event handler might need other resources.
|
||||
|
||||
Perhaps an event handler needs a random number or a GUID or the current
|
||||
datetime. Perhaps it needs access to a DataScript database connection.
|
||||
|
||||
If an event handler directly accesses these resources, it stops being
|
||||
pure and, consequently, it becomes harder to test, etc. So we don't
|
||||
want that.
|
||||
|
||||
Instead, the interceptor created by this function is a way to 'inject'
|
||||
'necessary resources' into the `:coeffects` (map) subsequently given
|
||||
to the event handler at call time."
|
||||
([id]
|
||||
(->interceptor
|
||||
:id :coeffects
|
||||
:before (fn coeffects-before
|
||||
[context]
|
||||
(if-let [handler (get-handler kind id)]
|
||||
(update context :coeffects handler)
|
||||
(console :error "No cofx handler registered for \"" id "\"")))))
|
||||
([id value]
|
||||
(->interceptor
|
||||
:id :coeffects
|
||||
:before (fn coeffects-before
|
||||
[context]
|
||||
(if-let [handler (get-handler kind id)]
|
||||
(update context :coeffects handler value)
|
||||
(console :error "No cofx handler registered for \"" id "\""))))))
|
||||
|
||||
|
||||
;; -- Builtin CoEffects Handlers ---------------------------------------------
|
||||
|
||||
;; :db
|
||||
;;
|
||||
;; Adds to coeffects the value in `app-db`, under the key `:db`
|
||||
(reg-cofx
|
||||
:db
|
||||
(fn db-coeffects-handler
|
||||
[coeffects]
|
||||
(assoc coeffects :db @app-db)))
|
||||
|
||||
|
||||
;; Because this interceptor is used so much, we reify it
|
||||
(def inject-db (inject-cofx :db))
|
||||
|
||||
|
233
src/mranderson047/re_frame/v0v10v2/re_frame/core.cljc
Normal file
233
src/mranderson047/re_frame/v0v10v2/re_frame/core.cljc
Normal file
@ -0,0 +1,233 @@
|
||||
(ns mranderson047.re-frame.v0v10v2.re-frame.core
|
||||
(:require
|
||||
[mranderson047.re-frame.v0v10v2.re-frame.events :as events]
|
||||
[mranderson047.re-frame.v0v10v2.re-frame.subs :as subs]
|
||||
[mranderson047.re-frame.v0v10v2.re-frame.interop :as interop]
|
||||
[mranderson047.re-frame.v0v10v2.re-frame.db :as db]
|
||||
[mranderson047.re-frame.v0v10v2.re-frame.fx :as fx]
|
||||
[mranderson047.re-frame.v0v10v2.re-frame.cofx :as cofx]
|
||||
[mranderson047.re-frame.v0v10v2.re-frame.router :as router]
|
||||
[mranderson047.re-frame.v0v10v2.re-frame.loggers :as loggers]
|
||||
[mranderson047.re-frame.v0v10v2.re-frame.registrar :as registrar]
|
||||
[mranderson047.re-frame.v0v10v2.re-frame.interceptor :as interceptor]
|
||||
[mranderson047.re-frame.v0v10v2.re-frame.std-interceptors :as std-interceptors :refer [db-handler->interceptor
|
||||
fx-handler->interceptor
|
||||
ctx-handler->interceptor]]
|
||||
[clojure.set :as set]))
|
||||
|
||||
|
||||
;; -- API ---------------------------------------------------------------------
|
||||
;;
|
||||
;; This namespace represents the mranderson047.re-frame.v0v10v2.re-frame API
|
||||
;;
|
||||
;; Below, you'll see we've used this technique:
|
||||
;; (def api-name-for-fn deeper.namespace/where-the-defn-is)
|
||||
;;
|
||||
;; So, we promote a `defn` in a deeper namespace "up" to the API
|
||||
;; via a `def` in this namespace.
|
||||
;;
|
||||
;; Turns out, this approach makes it hard:
|
||||
;; - to auto-generate API docs
|
||||
;; - for IDEs to provide code completion on functions in the API
|
||||
;;
|
||||
;; Which is annoying. But there are pros and cons and we haven't
|
||||
;; yet revisited the decision. To compensate, we've added more nudity
|
||||
;; to the docs.
|
||||
;;
|
||||
|
||||
|
||||
;; -- dispatch ----------------------------------------------------------------
|
||||
(def dispatch router/dispatch)
|
||||
(def dispatch-sync router/dispatch-sync)
|
||||
|
||||
|
||||
;; -- subscriptions -----------------------------------------------------------
|
||||
(def reg-sub subs/reg-sub)
|
||||
(def subscribe subs/subscribe)
|
||||
|
||||
(def clear-sub (partial registrar/clear-handlers subs/kind)) ;; think unreg-sub
|
||||
(def clear-subscription-cache! subs/clear-subscription-cache!)
|
||||
|
||||
(defn reg-sub-raw
|
||||
"This is a low level, advanced function. You should probably be
|
||||
using reg-sub instead.
|
||||
Docs in https://github.com/Day8/re-frame/blob/master/docs/SubscriptionFlow.md"
|
||||
[query-id handler-fn]
|
||||
(registrar/register-handler subs/kind query-id handler-fn))
|
||||
|
||||
|
||||
;; -- effects -----------------------------------------------------------------
|
||||
(def reg-fx fx/reg-fx)
|
||||
(def clear-fx (partial registrar/clear-handlers fx/kind)) ;; think unreg-fx
|
||||
|
||||
;; -- coeffects ---------------------------------------------------------------
|
||||
(def reg-cofx cofx/reg-cofx)
|
||||
(def inject-cofx cofx/inject-cofx)
|
||||
(def clear-cofx (partial registrar/clear-handlers cofx/kind)) ;; think unreg-cofx
|
||||
|
||||
|
||||
;; -- Events ------------------------------------------------------------------
|
||||
|
||||
(defn reg-event-db
|
||||
"Register the given event `handler` (function) for the given `id`. Optionally, provide
|
||||
an `interceptors` chain.
|
||||
`id` is typically a namespaced keyword (but can be anything)
|
||||
`handler` is a function: (db event) -> db
|
||||
`interceptors` is a collection of interceptors. Will be flattened and nils removed.
|
||||
`handler` is wrapped in its own interceptor and added to the end of the interceptor
|
||||
chain, so that, in the end, only a chain is registered.
|
||||
Special effects and coeffects interceptors are added to the front of this
|
||||
chain."
|
||||
([id handler]
|
||||
(reg-event-db id nil handler))
|
||||
([id interceptors handler]
|
||||
(events/register id [cofx/inject-db fx/do-fx interceptors (db-handler->interceptor handler)])))
|
||||
|
||||
|
||||
(defn reg-event-fx
|
||||
"Register the given event `handler` (function) for the given `id`. Optionally, provide
|
||||
an `interceptors` chain.
|
||||
`id` is typically a namespaced keyword (but can be anything)
|
||||
`handler` is a function: (coeffects-map event-vector) -> effects-map
|
||||
`interceptors` is a collection of interceptors. Will be flattened and nils removed.
|
||||
`handler` is wrapped in its own interceptor and added to the end of the interceptor
|
||||
chain, so that, in the end, only a chain is registered.
|
||||
Special effects and coeffects interceptors are added to the front of the
|
||||
interceptor chain. These interceptors inject the value of app-db into coeffects,
|
||||
and, later, action effects."
|
||||
([id handler]
|
||||
(reg-event-fx id nil handler))
|
||||
([id interceptors handler]
|
||||
(events/register id [cofx/inject-db fx/do-fx interceptors (fx-handler->interceptor handler)])))
|
||||
|
||||
|
||||
(defn reg-event-ctx
|
||||
"Register the given event `handler` (function) for the given `id`. Optionally, provide
|
||||
an `interceptors` chain.
|
||||
`id` is typically a namespaced keyword (but can be anything)
|
||||
`handler` is a function: (context-map event-vector) -> context-map
|
||||
|
||||
This form of registration is almost never used. "
|
||||
([id handler]
|
||||
(reg-event-ctx id nil handler))
|
||||
([id interceptors handler]
|
||||
(events/register id [cofx/inject-db fx/do-fx interceptors (ctx-handler->interceptor handler)])))
|
||||
|
||||
(def clear-event (partial registrar/clear-handlers events/kind)) ;; think unreg-event-*
|
||||
|
||||
;; -- interceptors ------------------------------------------------------------
|
||||
|
||||
;; Standard interceptors.
|
||||
;; Detailed docs on each in std-interceptors.cljs
|
||||
(def debug std-interceptors/debug)
|
||||
(def path std-interceptors/path)
|
||||
(def enrich std-interceptors/enrich)
|
||||
(def trim-v std-interceptors/trim-v)
|
||||
(def after std-interceptors/after)
|
||||
(def on-changes std-interceptors/on-changes)
|
||||
|
||||
|
||||
;; Utility functions for creating your own interceptors
|
||||
;;
|
||||
;; (def my-interceptor
|
||||
;; (->interceptor ;; used to create an interceptor
|
||||
;; :id :my-interceptor ;; an id - decorative only
|
||||
;; :before (fn [context] ;; you normally want to change :coeffects
|
||||
;; ... use get-coeffect and assoc-coeffect
|
||||
;; )
|
||||
;; :after (fn [context] ;; you normally want to change :effects
|
||||
;; (let [db (get-effect context :db)] ;; (get-in context [:effects :db])
|
||||
;; (assoc-effect context :http-ajax {...}])))))
|
||||
;;
|
||||
(def ->interceptor interceptor/->interceptor)
|
||||
(def get-coeffect interceptor/get-coeffect)
|
||||
(def assoc-coeffect interceptor/assoc-coeffect)
|
||||
(def get-effect interceptor/get-effect)
|
||||
(def assoc-effect interceptor/assoc-effect)
|
||||
(def enqueue interceptor/enqueue)
|
||||
|
||||
|
||||
;; -- logging ----------------------------------------------------------------
|
||||
;; Internally, mranderson047.re-frame.v0v10v2.re-frame uses the logging functions: warn, log, error, group and groupEnd
|
||||
;; By default, these functions map directly to the js/console implementations,
|
||||
;; but you can override with your own fns (set or subset).
|
||||
;; Example Usage:
|
||||
;; (defn my-fn [& args] (post-it-somewhere (apply str args))) ;; here is my alternative
|
||||
;; (mranderson047.re-frame.v0v10v2.re-frame.core/set-loggers! {:warn my-fn :log my-fn}) ;; override the defaults with mine
|
||||
(def set-loggers! loggers/set-loggers!)
|
||||
|
||||
;; If you are writing an extension to re-frame, like perhaps
|
||||
;; an effects handler, you may want to use mranderson047.re-frame.v0v10v2.re-frame logging.
|
||||
;;
|
||||
;; usage: (console :error "Oh, dear God, it happened: " a-var " and " another)
|
||||
;; (console :warn "Possible breach of containment wall at: " dt)
|
||||
(def console loggers/console)
|
||||
|
||||
|
||||
;; -- unit testing ------------------------------------------------------------
|
||||
|
||||
(defn make-restore-fn
|
||||
"Checkpoints the state of mranderson047.re-frame.v0v10v2.re-frame and returns a function which, when
|
||||
later called, will restore mranderson047.re-frame.v0v10v2.re-frame to that checkpointed state.
|
||||
|
||||
Checkpoint includes app-db, all registered handlers and all subscriptions.
|
||||
"
|
||||
[]
|
||||
(let [handlers @registrar/kind->id->handler
|
||||
app-db @db/app-db
|
||||
subs-cache @subs/query->reaction]
|
||||
(fn []
|
||||
;; call `dispose!` on all current subscriptions which
|
||||
;; didn't originally exist.
|
||||
(let [original-subs (set (vals subs-cache))
|
||||
current-subs (set (vals @subs/query->reaction))]
|
||||
(doseq [sub (set/difference current-subs original-subs)]
|
||||
(interop/dispose! sub)))
|
||||
|
||||
;; Reset the atoms
|
||||
;; We don't need to reset subs/query->reaction, as
|
||||
;; disposing of the subs removes them from the cache anyway
|
||||
(reset! registrar/kind->id->handler handlers)
|
||||
(reset! db/app-db app-db)
|
||||
nil)))
|
||||
|
||||
|
||||
;; -- Event Processing Callbacks ---------------------------------------------
|
||||
|
||||
(defn add-post-event-callback
|
||||
"Registers a function `f` to be called after each event is processed
|
||||
`f` will be called with two arguments:
|
||||
- `event`: a vector. The event just processed.
|
||||
- `queue`: a PersistentQueue, possibly empty, of events yet to be processed.
|
||||
|
||||
This is useful in advanced cases like:
|
||||
- you are implementing a complex bootstrap pipeline
|
||||
- you want to create your own handling infrastructure, with perhaps multiple
|
||||
handlers for the one event, etc. Hook in here.
|
||||
- libraries providing 'isomorphic javascript' rendering on Nodejs or Nashorn.
|
||||
|
||||
'id' is typically a keyword. Supplied at \"add time\" so it can subsequently
|
||||
be used at \"remove time\" to get rid of the right callback.
|
||||
"
|
||||
([f]
|
||||
(add-post-event-callback f f)) ;; use f as its own identifier
|
||||
([id f]
|
||||
(router/add-post-event-callback mranderson047.re-frame.v0v10v2.re-frame.router/event-queue id f)))
|
||||
|
||||
|
||||
(defn remove-post-event-callback
|
||||
[id]
|
||||
(router/remove-post-event-callback mranderson047.re-frame.v0v10v2.re-frame.router/event-queue id))
|
||||
|
||||
|
||||
;; -- Deprecation ------------------------------------------------------------
|
||||
;; Assisting the v0.7.x -> v0.8.x transition.
|
||||
(defn register-handler
|
||||
[& args]
|
||||
(console :warn "re-frame: \"register-handler\" has been renamed \"reg-event-db\" (look for registration of " (str (first args)) ")")
|
||||
(apply reg-event-db args))
|
||||
|
||||
(defn register-sub
|
||||
[& args]
|
||||
(console :warn "re-frame: \"register-sub\" is deprecated. Use \"reg-sub-raw\" (look for registration of " (str (first args)) ")")
|
||||
(apply reg-sub-raw args))
|
11
src/mranderson047/re_frame/v0v10v2/re_frame/db.cljc
Normal file
11
src/mranderson047/re_frame/v0v10v2/re_frame/db.cljc
Normal file
@ -0,0 +1,11 @@
|
||||
(ns mranderson047.re-frame.v0v10v2.re-frame.db
|
||||
(:require [mranderson047.re-frame.v0v10v2.re-frame.interop :refer [ratom]]))
|
||||
|
||||
|
||||
;; -- Application State --------------------------------------------------------------------------
|
||||
;;
|
||||
;; Should not be accessed directly by application code.
|
||||
;; Read access goes through subscriptions.
|
||||
;; Updates via event handlers.
|
||||
(def app-db (ratom {}))
|
||||
|
66
src/mranderson047/re_frame/v0v10v2/re_frame/events.cljc
Normal file
66
src/mranderson047/re_frame/v0v10v2/re_frame/events.cljc
Normal file
@ -0,0 +1,66 @@
|
||||
(ns mranderson047.re-frame.v0v10v2.re-frame.events
|
||||
(:require [mranderson047.re-frame.v0v10v2.re-frame.db :refer [app-db]]
|
||||
[mranderson047.re-frame.v0v10v2.re-frame.utils :refer [first-in-vector]]
|
||||
[mranderson047.re-frame.v0v10v2.re-frame.interop :refer [empty-queue debug-enabled?]]
|
||||
[mranderson047.re-frame.v0v10v2.re-frame.registrar :refer [get-handler register-handler]]
|
||||
[mranderson047.re-frame.v0v10v2.re-frame.loggers :refer [console]]
|
||||
[mranderson047.re-frame.v0v10v2.re-frame.interceptor :as interceptor]
|
||||
[mranderson047.re-frame.v0v10v2.re-frame.trace :as trace :include-macros true]))
|
||||
|
||||
|
||||
(def kind :event)
|
||||
(assert (mranderson047.re-frame.v0v10v2.re-frame.registrar/kinds kind))
|
||||
|
||||
(defn- flatten-and-remove-nils
|
||||
"`interceptors` might have nested collections, and contain nil elements.
|
||||
return a flat collection, with all nils removed.
|
||||
This function is 9/10 about giving good error messages."
|
||||
[id interceptors]
|
||||
(let [make-chain #(->> % flatten (remove nil?))]
|
||||
(if-not debug-enabled?
|
||||
(make-chain interceptors)
|
||||
(do ;; do a whole lot of development time checks
|
||||
(when-not (coll? interceptors)
|
||||
(console :error "re-frame: when registering " id ", expected a collection of interceptors, got: " interceptors))
|
||||
(let [chain (make-chain interceptors)]
|
||||
(when (empty? chain)
|
||||
(console :error "re-frame: when registering " id ", given an empty interceptor chain"))
|
||||
(when-let [not-i (first (remove interceptor/interceptor? chain))]
|
||||
(if (fn? not-i)
|
||||
(console :error "re-frame: when registering " id ", got a function instead of an interceptor. Did you provide old style middleware by mistake? Got: " not-i)
|
||||
(console :error "re-frame: when registering " id ", expected interceptors, but got: " not-i)))
|
||||
chain)))))
|
||||
|
||||
|
||||
(defn register
|
||||
"Associate the given event `id` with the given collection of `interceptors`.
|
||||
|
||||
`interceptors` may contain nested collections and there may be nils
|
||||
at any level,so process this structure into a simple, nil-less vector
|
||||
before registration.
|
||||
|
||||
Typically, an `event handler` will be at the end of the chain (wrapped
|
||||
in an interceptor)."
|
||||
[id interceptors]
|
||||
(register-handler kind id (flatten-and-remove-nils id interceptors)))
|
||||
|
||||
|
||||
|
||||
;; -- handle event --------------------------------------------------------------------------------
|
||||
|
||||
(def ^:dynamic *handling* nil) ;; remember what event we are currently handling
|
||||
|
||||
(defn handle
|
||||
"Given an event vector `event-v`, look up the associated interceptor chain, and execute it."
|
||||
[event-v]
|
||||
(let [event-id (first-in-vector event-v)]
|
||||
(if-let [interceptors (get-handler kind event-id true)]
|
||||
(if *handling*
|
||||
(console :error "re-frame: while handling \"" *handling* "\", dispatch-sync was called for \"" event-v "\". You can't call dispatch-sync within an event handler.")
|
||||
(binding [*handling* event-v]
|
||||
(trace/with-trace {:operation event-id
|
||||
:op-type kind
|
||||
:tags {:event event-v}}
|
||||
(interceptor/execute event-v interceptors)))))))
|
||||
|
||||
|
164
src/mranderson047/re_frame/v0v10v2/re_frame/fx.cljc
Normal file
164
src/mranderson047/re_frame/v0v10v2/re_frame/fx.cljc
Normal file
@ -0,0 +1,164 @@
|
||||
(ns mranderson047.re-frame.v0v10v2.re-frame.fx
|
||||
(:require
|
||||
[mranderson047.re-frame.v0v10v2.re-frame.router :as router]
|
||||
[mranderson047.re-frame.v0v10v2.re-frame.db :refer [app-db]]
|
||||
[mranderson047.re-frame.v0v10v2.re-frame.interceptor :refer [->interceptor]]
|
||||
[mranderson047.re-frame.v0v10v2.re-frame.interop :refer [set-timeout!]]
|
||||
[mranderson047.re-frame.v0v10v2.re-frame.events :as events]
|
||||
[mranderson047.re-frame.v0v10v2.re-frame.registrar :refer [get-handler clear-handlers register-handler]]
|
||||
[mranderson047.re-frame.v0v10v2.re-frame.loggers :refer [console]]))
|
||||
|
||||
|
||||
;; -- Registration ------------------------------------------------------------
|
||||
|
||||
(def kind :fx)
|
||||
(assert (mranderson047.re-frame.v0v10v2.re-frame.registrar/kinds kind))
|
||||
|
||||
(defn reg-fx
|
||||
"Register the given effect `handler` for the given `id`.
|
||||
|
||||
`id` is keyword, often namespaced.
|
||||
`handler` is a side-effecting function which takes a single argument and whose return
|
||||
value is ignored.
|
||||
|
||||
Example Use
|
||||
-----------
|
||||
|
||||
First, registration ... associate `:effect2` with a handler.
|
||||
|
||||
(reg-fx
|
||||
:effect2
|
||||
(fn [value]
|
||||
... do something side-effect-y))
|
||||
|
||||
Then, later, if an event handler were to return this effects map ...
|
||||
|
||||
{...
|
||||
:effect2 [1 2]}
|
||||
|
||||
... then the `handler` `fn` we registered previously, using `reg-fx`, will be
|
||||
called with an argument of `[1 2]`."
|
||||
[id handler]
|
||||
(register-handler kind id handler))
|
||||
|
||||
;; -- Interceptor -------------------------------------------------------------
|
||||
|
||||
(def do-fx
|
||||
"An interceptor whose `:after` actions the contents of `:effects`. As a result,
|
||||
this interceptor is Domino 3.
|
||||
|
||||
This interceptor is silently added (by reg-event-db etc) to the front of
|
||||
interceptor chains for all events.
|
||||
|
||||
For each key in `:effects` (a map), it calls the registered `effects handler`
|
||||
(see `reg-fx` for registration of effect handlers).
|
||||
|
||||
So, if `:effects` was:
|
||||
{:dispatch [:hello 42]
|
||||
:db {...}
|
||||
:undo \"set flag\"}
|
||||
|
||||
it will call the registered effect handlers for each of the map's keys:
|
||||
`:dispatch`, `:undo` and `:db`. When calling each handler, provides the map
|
||||
value for that key - so in the example above the effect handler for :dispatch
|
||||
will be given one arg `[:hello 42]`.
|
||||
|
||||
You cannot rely on the ordering in which effects are executed."
|
||||
(->interceptor
|
||||
:id :do-fx
|
||||
:after (fn do-fx-after
|
||||
[context]
|
||||
(doseq [[effect-key effect-value] (:effects context)]
|
||||
(if-let [effect-fn (get-handler kind effect-key false)]
|
||||
(effect-fn effect-value)
|
||||
(console :error "re-frame: no handler registered for effect: \"" effect-key "\". Ignoring."))))))
|
||||
|
||||
;; -- Builtin Effect Handlers ------------------------------------------------
|
||||
|
||||
;; :dispatch-later
|
||||
;;
|
||||
;; `dispatch` one or more events after given delays. Expects a collection
|
||||
;; of maps with two keys: :`ms` and `:dispatch`
|
||||
;;
|
||||
;; usage:
|
||||
;;
|
||||
;; {:dispatch-later [{:ms 200 :dispatch [:event-id "param"]} ;; in 200ms do this: (dispatch [:event-id "param"])
|
||||
;; {:ms 100 :dispatch [:also :this :in :100ms]}]}
|
||||
;;
|
||||
(reg-fx
|
||||
:dispatch-later
|
||||
(fn [value]
|
||||
(doseq [{:keys [ms dispatch] :as effect} value]
|
||||
(if (or (empty? dispatch) (not (number? ms)))
|
||||
(console :error "re-frame: ignoring bad :dispatch-later value:" effect)
|
||||
(set-timeout! #(router/dispatch dispatch) ms)))))
|
||||
|
||||
|
||||
;; :dispatch
|
||||
;;
|
||||
;; `dispatch` one event. Excepts a single vector.
|
||||
;;
|
||||
;; usage:
|
||||
;; {:dispatch [:event-id "param"] }
|
||||
|
||||
(reg-fx
|
||||
:dispatch
|
||||
(fn [value]
|
||||
(if-not (vector? value)
|
||||
(console :error "re-frame: ignoring bad :dispatch value. Expected a vector, but got:" value)
|
||||
(router/dispatch value))))
|
||||
|
||||
|
||||
;; :dispatch-n
|
||||
;;
|
||||
;; `dispatch` more than one event. Expects a list or vector of events. Something for which
|
||||
;; sequential? returns true.
|
||||
;;
|
||||
;; usage:
|
||||
;; {:dispatch-n (list [:do :all] [:three :of] [:these])}
|
||||
;;
|
||||
;; Note: nil events are ignored which means events can be added
|
||||
;; conditionally:
|
||||
;; {:dispatch-n (list (when (> 3 5) [:conditioned-out])
|
||||
;; [:another-one])}
|
||||
;;
|
||||
(reg-fx
|
||||
:dispatch-n
|
||||
(fn [value]
|
||||
(if-not (sequential? value)
|
||||
(console :error "re-frame: ignoring bad :dispatch-n value. Expected a collection, got got:" value)
|
||||
(doseq [event (remove nil? value)] (router/dispatch event)))))
|
||||
|
||||
|
||||
;; :deregister-event-handler
|
||||
;;
|
||||
;; removes a previously registered event handler. Expects either a single id (
|
||||
;; typically a namespaced keyword), or a seq of ids.
|
||||
;;
|
||||
;; usage:
|
||||
;; {:deregister-event-handler :my-id)}
|
||||
;; or:
|
||||
;; {:deregister-event-handler [:one-id :another-id]}
|
||||
;;
|
||||
(reg-fx
|
||||
:deregister-event-handler
|
||||
(fn [value]
|
||||
(let [clear-event (partial clear-handlers events/kind)]
|
||||
(if (sequential? value)
|
||||
(doseq [event value] (clear-event event))
|
||||
(clear-event value)))))
|
||||
|
||||
|
||||
;; :db
|
||||
;;
|
||||
;; reset! app-db with a new value. `value` is expected to be a map.
|
||||
;;
|
||||
;; usage:
|
||||
;; {:db {:key1 value1 key2 value2}}
|
||||
;;
|
||||
(reg-fx
|
||||
:db
|
||||
(fn [value]
|
||||
(if-not (identical? @app-db value)
|
||||
(reset! app-db value))))
|
||||
|
198
src/mranderson047/re_frame/v0v10v2/re_frame/interceptor.cljc
Normal file
198
src/mranderson047/re_frame/v0v10v2/re_frame/interceptor.cljc
Normal file
@ -0,0 +1,198 @@
|
||||
(ns mranderson047.re-frame.v0v10v2.re-frame.interceptor
|
||||
(:require
|
||||
[mranderson047.re-frame.v0v10v2.re-frame.loggers :refer [console]]
|
||||
[mranderson047.re-frame.v0v10v2.re-frame.interop :refer [empty-queue debug-enabled?]]
|
||||
[clojure.set :as set]))
|
||||
|
||||
|
||||
(def mandatory-interceptor-keys #{:id :after :before})
|
||||
|
||||
(defn interceptor?
|
||||
[m]
|
||||
(and (map? m)
|
||||
(= mandatory-interceptor-keys (-> m keys set))))
|
||||
|
||||
|
||||
(defn ->interceptor
|
||||
"Create an interceptor from named arguments"
|
||||
[& {:as m :keys [id before after]}]
|
||||
(when debug-enabled?
|
||||
(if-let [unknown-keys (seq (set/difference
|
||||
(-> m keys set)
|
||||
mandatory-interceptor-keys))]
|
||||
(console :error "re-frame: ->interceptor " m " has unknown keys:" unknown-keys)))
|
||||
{:id (or id :unnamed)
|
||||
:before before
|
||||
:after after })
|
||||
|
||||
;; -- Effect Helpers -----------------------------------------------------------------------------
|
||||
|
||||
(defn get-effect
|
||||
([context]
|
||||
(:effects context))
|
||||
([context key]
|
||||
(get-in context [:effects key]))
|
||||
([context key not-found]
|
||||
(get-in context [:effects key] not-found)))
|
||||
|
||||
|
||||
(defn assoc-effect
|
||||
[context key value]
|
||||
(assoc-in context [:effects key] value))
|
||||
|
||||
;; -- CoEffect Helpers ---------------------------------------------------------------------------
|
||||
|
||||
(defn get-coeffect
|
||||
([context]
|
||||
(:coeffects context))
|
||||
([context key]
|
||||
(get-in context [:coeffects key]))
|
||||
([context key not-found]
|
||||
(get-in context [:coeffects key] not-found)))
|
||||
|
||||
(defn assoc-coeffect
|
||||
[context key value]
|
||||
(assoc-in context [:coeffects key] value))
|
||||
|
||||
(defn update-coeffect
|
||||
[context key f & args]
|
||||
(apply update-in context [:coeffects key] f args))
|
||||
|
||||
;; -- Execute Interceptor Chain ------------------------------------------------------------------
|
||||
|
||||
|
||||
(defn- invoke-interceptor-fn
|
||||
[context interceptor direction]
|
||||
(if-let [f (get interceptor direction)]
|
||||
(f context)
|
||||
context))
|
||||
|
||||
|
||||
(defn- invoke-interceptors
|
||||
"Loop over all interceptors, calling `direction` function on each,
|
||||
threading the value of `context` through every call.
|
||||
|
||||
`direction` is one of `:before` or `:after`.
|
||||
|
||||
Each iteration, the next interceptor to process is obtained from
|
||||
context's `:queue`. After they are processed, interceptors are popped
|
||||
from `:queue` and added to `:stack`.
|
||||
|
||||
After sufficient iteration, `:queue` will be empty, and `:stack` will
|
||||
contain all interceptors processed.
|
||||
|
||||
Returns updated `context`. Ie. the `context` which has been threaded
|
||||
through all interceptor functions.
|
||||
|
||||
Generally speaking, an interceptor's `:before` function will (if present)
|
||||
add to a `context's` `:coeffects`, while it's `:after` function
|
||||
will modify the `context`'s `:effects`. Very approximately.
|
||||
|
||||
But because all interceptor functions are given `context`, and can
|
||||
return a modified version of it, the way is clear for an interceptor
|
||||
to introspect the stack or queue, or even modify the queue
|
||||
(add new interceptors via `enqueue`?). This is a very fluid arrangement."
|
||||
([context direction]
|
||||
(loop [context context]
|
||||
(let [queue (:queue context)] ;; future interceptors
|
||||
(if (empty? queue)
|
||||
context
|
||||
(let [interceptor (peek queue) ;; next interceptor to call
|
||||
stack (:stack context)] ;; already completed interceptors
|
||||
(recur (-> context
|
||||
(assoc :queue (pop queue)
|
||||
:stack (conj stack interceptor))
|
||||
(invoke-interceptor-fn interceptor direction)))))))))
|
||||
|
||||
|
||||
(defn enqueue
|
||||
"Add a collection of `interceptors` to the end of `context's` execution `:queue`.
|
||||
Returns the updated `context`.
|
||||
|
||||
In an advanced case, this function could allow an interceptor to add new
|
||||
interceptors to the `:queue` of a context."
|
||||
[context interceptors]
|
||||
(update context :queue
|
||||
(fnil into empty-queue)
|
||||
interceptors))
|
||||
|
||||
|
||||
(defn- context
|
||||
"Create a fresh context"
|
||||
([event interceptors]
|
||||
(-> {}
|
||||
(assoc-coeffect :event event)
|
||||
(enqueue interceptors)))
|
||||
([event interceptors db] ;; only used in tests, probably a hack, remove ? XXX
|
||||
(-> (context event interceptors)
|
||||
(assoc-coeffect :db db))))
|
||||
|
||||
|
||||
(defn- change-direction
|
||||
"Called on completion of `:before` processing, this function prepares/modifies
|
||||
`context` for the backwards sweep of processing in which an interceptor
|
||||
chain's `:after` fns are called.
|
||||
|
||||
At this point in processing, the `:queue` is empty and `:stack` holds all
|
||||
the previously run interceptors. So this function enables the backwards walk
|
||||
by priming `:queue` with what's currently in `:stack`"
|
||||
[context]
|
||||
(-> context
|
||||
(dissoc :queue)
|
||||
(enqueue (:stack context))))
|
||||
|
||||
|
||||
(defn execute
|
||||
"Executes the given chain (coll) of interceptors.
|
||||
|
||||
Each interceptor has this form:
|
||||
{:before (fn [context] ...) ;; returns possibly modified context
|
||||
:after (fn [context] ...)} ;; `identity` would be a noop
|
||||
|
||||
Walks the queue of iterceptors from beginning to end, calling the
|
||||
`:before` fn on each, then reverse direction and walk backwards,
|
||||
calling the `:after` fn on each.
|
||||
|
||||
The last interceptor in the chain presumably wraps an event
|
||||
handler fn. So the overall goal of the process is to \"handle
|
||||
the given event\".
|
||||
|
||||
Thread a `context` through all calls. `context` has this form:
|
||||
|
||||
{:coeffects {:event [:a-query-id :some-param]
|
||||
:db <original contents of app-db>}
|
||||
:effects {:db <new value for app-db>
|
||||
:dispatch [:an-event-id :param1]}
|
||||
:queue <a collection of further interceptors>
|
||||
:stack <a collection of interceptors already walked>}
|
||||
|
||||
`context` has `:coeffects` and `:effects` which, if this was a web
|
||||
server, would be somewhat anologous to `request` and `response`
|
||||
respectively.
|
||||
|
||||
`coeffects` will contain data like `event` and the initial
|
||||
state of `db` - the inputs required by the event handler
|
||||
(sitting presumably on the end of the chain), while handler-returned
|
||||
side effects are put into `:effects` including, but not limited to,
|
||||
new values for `db`.
|
||||
|
||||
The first few interceptors in a chain will likely have `:before`
|
||||
functions which \"prime\" the `context` by adding the event, and
|
||||
the current state of app-db into `:coeffects`. But interceptors can
|
||||
add whatever they want to `:coeffects` - perhaps the event handler needs
|
||||
some information from localstore, or a random number, or access to
|
||||
a DataScript connection.
|
||||
|
||||
Equally, some interceptors in the chain will have `:after` fn
|
||||
which can process the side effects accumulated into `:effects`
|
||||
including but, not limited to, updates to app-db.
|
||||
|
||||
Through both stages (before and after), `context` contains a `:queue`
|
||||
of interceptors yet to be processed, and a `:stack` of interceptors
|
||||
already done. In advanced cases, these values can be modified by the
|
||||
functions through which the context is threaded."
|
||||
[event-v interceptors]
|
||||
(-> (context event-v interceptors)
|
||||
(invoke-interceptors :before)
|
||||
change-direction
|
||||
(invoke-interceptors :after)))
|
91
src/mranderson047/re_frame/v0v10v2/re_frame/interop.clj
Normal file
91
src/mranderson047/re_frame/v0v10v2/re_frame/interop.clj
Normal file
@ -0,0 +1,91 @@
|
||||
(ns mranderson047.re-frame.v0v10v2.re-frame.interop
|
||||
(:import [java.util.concurrent Executor Executors]))
|
||||
|
||||
|
||||
;; The purpose of this file is to provide JVM-runnable implementations of the
|
||||
;; CLJS equivalents in interop.cljs.
|
||||
;;
|
||||
;; These implementations are to enable you to bring up a mranderson047.re-frame.v0v10v2.re-frame app on the JVM
|
||||
;; in order to run tests, or to develop at a JVM REPL instead of a CLJS one.
|
||||
;;
|
||||
;; Please note, though, that the purpose here *isn't* to fully replicate all of
|
||||
;; re-frame's behaviour in a real CLJS environment. We don't have Reagent or
|
||||
;; React on the JVM, and we don't try to mimic the stateful lifecycles that they
|
||||
;; embody.
|
||||
;;
|
||||
;; In particular, if you're performing side effects in any code that's triggered
|
||||
;; by a change to a Ratom's value, and not via a call to `dispatch`, then you're
|
||||
;; going to have a hard time getting any accurate tests with this code.
|
||||
;; However, if your subscriptions and Reagent render functions are pure, and
|
||||
;; your side-effects are all managed by effect handlers, then hopefully this will
|
||||
;; allow you to write some useful tests that can run on the JVM.
|
||||
|
||||
|
||||
(defonce ^:private executor (Executors/newSingleThreadExecutor))
|
||||
|
||||
(defonce ^:private on-dispose-callbacks (atom {}))
|
||||
|
||||
(defn next-tick [f]
|
||||
(let [bound-f (bound-fn [& args] (apply f args))]
|
||||
(.execute ^Executor executor bound-f))
|
||||
nil)
|
||||
|
||||
(def empty-queue clojure.lang.PersistentQueue/EMPTY)
|
||||
|
||||
(def after-render next-tick)
|
||||
|
||||
(def debug-enabled? true)
|
||||
|
||||
(defn ratom [x]
|
||||
(atom x))
|
||||
|
||||
(defn ratom? [x]
|
||||
(instance? clojure.lang.IAtom x))
|
||||
|
||||
(defn deref? [x]
|
||||
(instance? clojure.lang.IDeref x))
|
||||
|
||||
(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
|
||||
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
|
||||
other than that they do redundant work."
|
||||
[f]
|
||||
(reify clojure.lang.IDeref
|
||||
(deref [_] (f))))
|
||||
|
||||
(defn add-on-dispose!
|
||||
"On JVM Clojure, use an atom to register `f` to be invoked when `dispose!` is
|
||||
invoked with `a-ratom`."
|
||||
[a-ratom f]
|
||||
(do (swap! on-dispose-callbacks update a-ratom (fnil conj []) f)
|
||||
nil))
|
||||
|
||||
(defn dispose!
|
||||
"On JVM Clojure, invoke all callbacks registered with `add-on-dispose!` for
|
||||
`a-ratom`."
|
||||
[a-ratom]
|
||||
;; Try to replicate reagent's behavior, releasing resources first then
|
||||
;; invoking callbacks
|
||||
(let [callbacks (get @on-dispose-callbacks a-ratom)]
|
||||
(swap! on-dispose-callbacks dissoc a-ratom)
|
||||
(doseq [f callbacks] (f))))
|
||||
|
||||
(defn set-timeout!
|
||||
"Note that we ignore the `ms` value and just invoke the function, because
|
||||
there isn't often much point firing a timed event in a test."
|
||||
[f ms]
|
||||
(next-tick f))
|
||||
|
||||
(defn now []
|
||||
;; currentTimeMillis may count backwards in some scenarios, but as this is used for tracing
|
||||
;; it is preferable to the slower but more accurate System.nanoTime.
|
||||
(System/currentTimeMillis))
|
||||
|
||||
(defn reagent-id
|
||||
"Doesn't make sense in a Clojure context currently."
|
||||
[reactive-val]
|
||||
nil)
|
56
src/mranderson047/re_frame/v0v10v2/re_frame/interop.cljs
Normal file
56
src/mranderson047/re_frame/v0v10v2/re_frame/interop.cljs
Normal file
@ -0,0 +1,56 @@
|
||||
(ns mranderson047.re-frame.v0v10v2.re-frame.interop
|
||||
(:require [goog.async.nextTick]
|
||||
[reagent.core]
|
||||
[reagent.ratom]))
|
||||
|
||||
(def next-tick goog.async.nextTick)
|
||||
|
||||
(def empty-queue #queue [])
|
||||
|
||||
(def after-render 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.
|
||||
;; Type hints have been liberally sprinkled.
|
||||
;; https://developers.google.com/closure/compiler/docs/js-for-compiler
|
||||
(def ^boolean debug-enabled? "@define {boolean}" ^boolean js/goog.DEBUG)
|
||||
|
||||
(defn ratom [x]
|
||||
(reagent.core/atom x))
|
||||
|
||||
(defn ratom? [x]
|
||||
(satisfies? reagent.ratom/IReactiveAtom x))
|
||||
|
||||
(defn deref? [x]
|
||||
(satisfies? IDeref x))
|
||||
|
||||
|
||||
(defn make-reaction [f]
|
||||
(reagent.ratom/make-reaction f))
|
||||
|
||||
(defn add-on-dispose! [a-ratom f]
|
||||
(reagent.ratom/add-on-dispose! a-ratom f))
|
||||
|
||||
(defn dispose! [a-ratom]
|
||||
(reagent.ratom/dispose! a-ratom))
|
||||
|
||||
(defn set-timeout! [f ms]
|
||||
(js/setTimeout f ms))
|
||||
|
||||
(defn now []
|
||||
(if (exists? js/performance.now)
|
||||
(js/performance.now)
|
||||
(js/Date.now)))
|
||||
|
||||
(defn reagent-id
|
||||
"Produces an id for reactive Reagent values
|
||||
e.g. reactions, ratoms, cursors."
|
||||
[reactive-val]
|
||||
(when (implements? 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"
|
||||
"other")
|
||||
(hash reactive-val))))
|
51
src/mranderson047/re_frame/v0v10v2/re_frame/loggers.cljc
Normal file
51
src/mranderson047/re_frame/v0v10v2/re_frame/loggers.cljc
Normal file
@ -0,0 +1,51 @@
|
||||
(ns mranderson047.re-frame.v0v10v2.re-frame.loggers
|
||||
(:require
|
||||
[clojure.set :refer [difference]]
|
||||
#?@(:clj [[clojure.string :as str]
|
||||
[clojure.tools.logging :as log]])))
|
||||
|
||||
#?(:clj (defn log [level & args]
|
||||
(log/log level (if (= 1 (count args))
|
||||
(first args)
|
||||
(str/join " " args)))))
|
||||
|
||||
|
||||
;; XXX should loggers be put in the registrar ??
|
||||
(def ^:private loggers
|
||||
"Holds the current set of logging functions.
|
||||
By default, mranderson047.re-frame.v0v10v2.re-frame uses the functions provided by js/console.
|
||||
Use `set-loggers!` to change these defaults
|
||||
"
|
||||
(atom #?(:cljs {:log (js/console.log.bind js/console)
|
||||
:warn (js/console.warn.bind js/console)
|
||||
:error (js/console.error.bind js/console)
|
||||
:group (if (.-group js/console) ;; console.group does not exist < IE 11
|
||||
(js/console.group.bind js/console)
|
||||
(js/console.log.bind js/console))
|
||||
:groupEnd (if (.-groupEnd js/console) ;; console.groupEnd does not exist < IE 11
|
||||
(js/console.groupEnd.bind js/console)
|
||||
#())})
|
||||
;; clojure versions
|
||||
#?(:clj {:log (partial log :info)
|
||||
:warn (partial log :warn)
|
||||
:error (partial log :error)
|
||||
:group (partial log :info)
|
||||
:groupEnd #()})))
|
||||
|
||||
(defn console
|
||||
[level & args]
|
||||
(assert (contains? @loggers level) (str "re-frame: log called with unknown level: " level))
|
||||
(apply (level @loggers) args))
|
||||
|
||||
|
||||
(defn set-loggers!
|
||||
"Change the set (or a subset) of logging functions used by mranderson047.re-frame.v0v10v2.re-frame.
|
||||
`new-loggers` should be a map with the same keys as `loggers` (above)"
|
||||
[new-loggers]
|
||||
(assert (empty? (difference (set (keys new-loggers)) (-> @loggers keys set))) "Unknown keys in new-loggers")
|
||||
(swap! loggers merge new-loggers))
|
||||
|
||||
(defn get-loggers
|
||||
"Get the current logging functions used by mranderson047.re-frame.v0v10v2.re-frame."
|
||||
[]
|
||||
@loggers)
|
56
src/mranderson047/re_frame/v0v10v2/re_frame/registrar.cljc
Normal file
56
src/mranderson047/re_frame/v0v10v2/re_frame/registrar.cljc
Normal file
@ -0,0 +1,56 @@
|
||||
(ns mranderson047.re-frame.v0v10v2.re-frame.registrar
|
||||
"In many places, mranderson047.re-frame.v0v10v2.re-frame asks you to associate an `id` (keyword)
|
||||
with a `handler` (function). This namespace contains the
|
||||
central registry of such associations."
|
||||
(:require [mranderson047.re-frame.v0v10v2.re-frame.interop :refer [debug-enabled?]]
|
||||
[mranderson047.re-frame.v0v10v2.re-frame.loggers :refer [console]]))
|
||||
|
||||
|
||||
;; kinds of handlers
|
||||
(def kinds #{:event :fx :cofx :sub})
|
||||
|
||||
;; This atom contains a register of all handlers.
|
||||
;; Contains a two layer map, keyed first by `kind` (of handler), and then `id` of handler.
|
||||
;; Leaf nodes are handlers.
|
||||
(def kind->id->handler (atom {}))
|
||||
|
||||
|
||||
(defn get-handler
|
||||
|
||||
([kind]
|
||||
(get @kind->id->handler kind))
|
||||
|
||||
([kind id]
|
||||
(-> (get @kind->id->handler kind)
|
||||
(get id)))
|
||||
|
||||
([kind id required?]
|
||||
(let [handler (get-handler kind id)]
|
||||
(when debug-enabled? ;; This is in a separate `when` so Closure DCE can run ...
|
||||
(when (and required? (nil? handler)) ;; ...otherwise you'd need to type-hint the `and` with a ^boolean for DCE.
|
||||
(console :error "re-frame: no " (str kind) " handler registered for: " id)))
|
||||
handler)))
|
||||
|
||||
|
||||
(defn register-handler
|
||||
[kind id handler-fn]
|
||||
(when debug-enabled? ;; This is in a separate when so Closure DCE can run
|
||||
(when (get-handler kind id false)
|
||||
(console :warn "re-frame: overwriting" (str kind) "handler for:" id))) ;; allow it, but warn. Happens on figwheel reloads.
|
||||
(swap! kind->id->handler assoc-in [kind id] handler-fn)
|
||||
handler-fn) ;; note: returns the just registered handler
|
||||
|
||||
|
||||
(defn clear-handlers
|
||||
([] ;; clear all kinds
|
||||
(reset! kind->id->handler {}))
|
||||
|
||||
([kind] ;; clear all handlers for this kind
|
||||
(assert (kinds kind))
|
||||
(swap! kind->id->handler dissoc kind))
|
||||
|
||||
([kind id] ;; clear a single handler for a kind
|
||||
(assert (kinds kind))
|
||||
(if (get-handler kind id)
|
||||
(swap! kind->id->handler update-in [kind] dissoc id)
|
||||
(console :warn "re-frame: can't clear" (str kind) "handler for" (str id ". Handler not found.")))))
|
263
src/mranderson047/re_frame/v0v10v2/re_frame/router.cljc
Normal file
263
src/mranderson047/re_frame/v0v10v2/re_frame/router.cljc
Normal file
@ -0,0 +1,263 @@
|
||||
(ns mranderson047.re-frame.v0v10v2.re-frame.router
|
||||
(:require [mranderson047.re-frame.v0v10v2.re-frame.events :refer [handle]]
|
||||
[mranderson047.re-frame.v0v10v2.re-frame.interop :refer [after-render empty-queue next-tick]]
|
||||
[mranderson047.re-frame.v0v10v2.re-frame.loggers :refer [console]]
|
||||
[mranderson047.re-frame.v0v10v2.re-frame.trace :as trace :include-macros true]))
|
||||
|
||||
|
||||
;; -- Router Loop ------------------------------------------------------------
|
||||
;;
|
||||
;; A call to "re-frame.core/dispatch" places an event on a queue for processing.
|
||||
;; A short time later, the handler registered to handle this event will be run.
|
||||
;; What follows is the implementation of this process.
|
||||
;;
|
||||
;; The task is to process queued events in a perpetual loop, one after
|
||||
;; the other, FIFO, calling the registered event-handler for each, being idle when
|
||||
;; there are no events, and firing up when one arrives.
|
||||
;;
|
||||
;; But browsers only have a single thread of control and we must be
|
||||
;; careful to not hog the CPU. When processing events one after another, we
|
||||
;; must regularly hand back control to the browser, so it can redraw, process
|
||||
;; websockets, etc. But not too regularly! If we are in a de-focused browser
|
||||
;; tab, our app will be CPU throttled. Each time we get back control, we have
|
||||
;; to process all queued events, or else something like a bursty websocket
|
||||
;; (producing events) might overwhelm the queue. So there's a balance.
|
||||
;;
|
||||
;; The processing/handling of an event happens "asynchronously" sometime after
|
||||
;; that event was enqueued via "dispatch". The original implementation of this router loop
|
||||
;; used `core.async`. As a result, it was fairly simple, and it mostly worked,
|
||||
;; but it did not give enough control. So now we hand-roll our own,
|
||||
;; finite-state-machine and all.
|
||||
;;
|
||||
;; In what follows, the strategy is this:
|
||||
;; - maintain a FIFO queue of `dispatched` events.
|
||||
;; - when a new event arrives, "schedule" processing of this queue using
|
||||
;; goog.async.nextTick, which means it will happen "very soon".
|
||||
;; - when processing events, one after the other, do ALL the currently
|
||||
;; queued events. Don't stop. Don't yield to the browser. Hog that CPU.
|
||||
;; - but if any new events are dispatched during this cycle of processing,
|
||||
;; don't do them immediately. Leave them queued. Yield first to the browser,
|
||||
;; and do these new events in the next processing cycle. That way we drain
|
||||
;; the queue up to a point, but we never hog the CPU forever. In
|
||||
;; particular, we handle the case where handling one event will beget
|
||||
;; another event. The freshly begotten event will be handled next cycle,
|
||||
;; with yielding in-between.
|
||||
;; - In some cases, an event should not be handled until after the GUI has been
|
||||
;; updated, i.e., after the next Reagent animation frame. In such a case,
|
||||
;; the event should be dispatched with :flush-dom metadata like this:
|
||||
;; (dispatch ^:flush-dom [:event-id other params])
|
||||
;; Such an event will temporarily block all further processing because
|
||||
;; events are processed sequentially: we handle one event completely
|
||||
;; before we handle the ones behind it.
|
||||
;;
|
||||
;; Implementation notes:
|
||||
;; - queue processing can be in a number of states: scheduled, running, paused
|
||||
;; etc. So it is modeled as a Finite State Machine.
|
||||
;; See "-fsm-trigger" (below) for the states and transitions.
|
||||
;; - the scheduling is done via "goog.async.nextTick" which is pretty quick
|
||||
;; - when the event has :flush-dom metadata we schedule via
|
||||
;; "reagent.core.after-render"
|
||||
;; which will run event processing after the next Reagent animation frame.
|
||||
;;
|
||||
|
||||
;; Events can have metadata which says to pause event processing.
|
||||
;; event metadata -> "run later" functions
|
||||
(def later-fns
|
||||
{:flush-dom (fn [f] (after-render #(next-tick f))) ;; one tick after the end of the next annimation frame
|
||||
:yield next-tick}) ;; almost immediately
|
||||
|
||||
|
||||
;; Event Queue Abstraction
|
||||
(defprotocol IEventQueue
|
||||
|
||||
;; -- API
|
||||
(push [this event])
|
||||
(add-post-event-callback [this id callack])
|
||||
(remove-post-event-callback [this f])
|
||||
|
||||
;; -- Implementation via a Finite State Machine
|
||||
(-fsm-trigger [this trigger arg])
|
||||
|
||||
;; -- Finite State Machine actions
|
||||
(-add-event [this event])
|
||||
(-process-1st-event-in-queue [this])
|
||||
(-run-next-tick [this])
|
||||
(-run-queue [this])
|
||||
(-exception [this ex])
|
||||
(-pause [this later-fn])
|
||||
(-resume [this])
|
||||
(-call-post-event-callbacks [this event]))
|
||||
|
||||
|
||||
;; Concrete implementation of IEventQueue
|
||||
(deftype EventQueue [#?(:cljs ^:mutable fsm-state :clj ^:volatile-mutable fsm-state)
|
||||
#?(:cljs ^:mutable queue :clj ^:volatile-mutable queue)
|
||||
#?(:cljs ^:mutable post-event-callback-fns :clj ^:volatile-mutable post-event-callback-fns)]
|
||||
IEventQueue
|
||||
|
||||
;; -- API ------------------------------------------------------------------
|
||||
|
||||
(push [this event] ;; presumably called by dispatch
|
||||
(-fsm-trigger this :add-event event))
|
||||
|
||||
;; register a callback function which will be called after each event is processed
|
||||
(add-post-event-callback [_ id callback-fn]
|
||||
(if (contains? post-event-callback-fns id)
|
||||
(console :warn "re-frame: overwriting existing post event call back with id:" id))
|
||||
(->> (assoc post-event-callback-fns id callback-fn)
|
||||
(set! post-event-callback-fns)))
|
||||
|
||||
(remove-post-event-callback [_ id]
|
||||
(if-not (contains? post-event-callback-fns id)
|
||||
(console :warn "re-frame: could not remove post event call back with id:" id)
|
||||
(->> (dissoc post-event-callback-fns id)
|
||||
(set! post-event-callback-fns))))
|
||||
|
||||
|
||||
;; -- FSM Implementation ---------------------------------------------------
|
||||
|
||||
(-fsm-trigger
|
||||
[this trigger arg]
|
||||
|
||||
;; The following "case" implements the Finite State Machine.
|
||||
;; Given a "trigger", and the existing FSM state, it computes the
|
||||
;; new FSM state and the transition action (function).
|
||||
|
||||
(trace/with-trace {:op-type ::fsm-trigger}
|
||||
(let [[new-fsm-state action-fn]
|
||||
(case [fsm-state trigger]
|
||||
|
||||
;; You should read the following "case" as:
|
||||
;; [current-FSM-state trigger] -> [new-FSM-state action-fn]
|
||||
;;
|
||||
;; So, for example, the next line should be interpreted as:
|
||||
;; if you are in state ":idle" and a trigger ":add-event"
|
||||
;; happens, then move the FSM to state ":scheduled" and execute
|
||||
;; that two-part "do" function.
|
||||
[:idle :add-event] [:scheduled #(do (-add-event this arg)
|
||||
(-run-next-tick this))]
|
||||
|
||||
;; State: :scheduled (the queue is scheduled to run, soon)
|
||||
[:scheduled :add-event] [:scheduled #(-add-event this arg)]
|
||||
[:scheduled :run-queue] [:running #(-run-queue this)]
|
||||
|
||||
;; State: :running (the queue is being processed one event after another)
|
||||
[:running :add-event] [:running #(-add-event this arg)]
|
||||
[:running :pause] [:paused #(-pause this arg)]
|
||||
[:running :exception] [:idle #(-exception this arg)]
|
||||
[:running :finish-run] (if (empty? queue) ;; FSM guard
|
||||
[:idle]
|
||||
[:scheduled #(-run-next-tick this)])
|
||||
|
||||
;; State: :paused (:flush-dom metadata on an event has caused a temporary pause in processing)
|
||||
[:paused :add-event] [:paused #(-add-event this arg)]
|
||||
[:paused :resume] [:running #(-resume this)]
|
||||
|
||||
(throw (ex-info (str "re-frame: router state transition not found. " fsm-state " " trigger)
|
||||
{:fsm-state fsm-state, :trigger trigger})))]
|
||||
|
||||
;; The "case" above computed both the new FSM state, and the action. Now, make it happen.
|
||||
|
||||
(trace/merge-trace! {:operation [fsm-state trigger]
|
||||
:tags {:current-state fsm-state
|
||||
:new-state new-fsm-state}})
|
||||
(set! fsm-state new-fsm-state)
|
||||
(when action-fn (action-fn)))))
|
||||
|
||||
(-add-event
|
||||
[_ event]
|
||||
(set! queue (conj queue event)))
|
||||
|
||||
(-process-1st-event-in-queue
|
||||
[this]
|
||||
(let [event-v (peek queue)]
|
||||
(try
|
||||
(handle event-v)
|
||||
(set! queue (pop queue))
|
||||
(-call-post-event-callbacks this event-v)
|
||||
(catch #?(:cljs :default :clj Exception) ex
|
||||
(-fsm-trigger this :exception ex)))))
|
||||
|
||||
(-run-next-tick
|
||||
[this]
|
||||
(next-tick #(-fsm-trigger this :run-queue nil)))
|
||||
|
||||
;; Process all the events currently in the queue, but not any new ones.
|
||||
;; Be aware that events might have metadata which will pause processing.
|
||||
(-run-queue
|
||||
[this]
|
||||
(loop [n (count queue)]
|
||||
(if (zero? n)
|
||||
(-fsm-trigger this :finish-run nil)
|
||||
(if-let [later-fn (some later-fns (-> queue peek meta keys))] ;; any metadata which causes pausing?
|
||||
(-fsm-trigger this :pause later-fn)
|
||||
(do (-process-1st-event-in-queue this)
|
||||
(recur (dec n)))))))
|
||||
|
||||
(-exception
|
||||
[_ ex]
|
||||
(set! queue empty-queue) ;; purge the queue
|
||||
(throw ex))
|
||||
|
||||
(-pause
|
||||
[this later-fn]
|
||||
(later-fn #(-fsm-trigger this :resume nil)))
|
||||
|
||||
(-call-post-event-callbacks
|
||||
[_ event-v]
|
||||
(doseq [callback (vals post-event-callback-fns)]
|
||||
(callback event-v queue)))
|
||||
|
||||
(-resume
|
||||
[this]
|
||||
(-process-1st-event-in-queue this) ;; do the event which paused processing
|
||||
(-run-queue this))) ;; do the rest of the queued events
|
||||
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Event Queue
|
||||
;; When "dispatch" is called, the event is added into this event queue. Later,
|
||||
;; the queue will "run" and the event will be "handled" by the registered function.
|
||||
;;
|
||||
(def event-queue (->EventQueue :idle empty-queue {}))
|
||||
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Dispatching
|
||||
;;
|
||||
|
||||
(defn dispatch
|
||||
"Enqueue `event` for processing by event handling machinery.
|
||||
|
||||
`event` is a vector of length >= 1. The 1st element identifies the kind of event.
|
||||
|
||||
Note: the event handler is not run immediately - it is not run
|
||||
synchronously. It will likely be run 'very soon', although it may be
|
||||
added to the end of a FIFO queue which already contain events.
|
||||
|
||||
Usage:
|
||||
(dispatch [:order-pizza {:supreme 2 :meatlovers 1 :veg 1})"
|
||||
[event]
|
||||
(if (nil? event)
|
||||
(throw (ex-info "re-frame: you called \"dispatch\" without an event vector." {}))
|
||||
(push event-queue event))
|
||||
nil) ;; Ensure nil return. See https://github.com/Day8/re-frame/wiki/Beware-Returning-False
|
||||
|
||||
|
||||
(defn dispatch-sync
|
||||
"Synchronously (immediately) process `event`. Do not queue.
|
||||
|
||||
Generally, don't use this. Instead use `dispatch`. It is an error
|
||||
to use `dispatch-sync` within an event handler.
|
||||
|
||||
Useful when any delay in processing is a problem:
|
||||
1. the `:on-change` handler of a text field where we are expecting fast typing.
|
||||
2 when initialising your app - see 'main' in todomvc examples
|
||||
3. in a unit test where we don't want the action 'later'
|
||||
|
||||
Usage:
|
||||
(dispatch-sync [:sing :falsetto 634])"
|
||||
[event-v]
|
||||
(handle event-v)
|
||||
(-call-post-event-callbacks event-queue event-v) ;; slightly ugly hack. Run the registered post event callbacks.
|
||||
nil) ;; Ensure nil return. See https://github.com/Day8/re-frame/wiki/Beware-Returning-False
|
@ -0,0 +1,329 @@
|
||||
(ns mranderson047.re-frame.v0v10v2.re-frame.std-interceptors
|
||||
"contains mranderson047.re-frame.v0v10v2.re-frame supplied, standard interceptors"
|
||||
(:require
|
||||
[mranderson047.re-frame.v0v10v2.re-frame.interceptor :refer [->interceptor get-effect get-coeffect assoc-coeffect assoc-effect]]
|
||||
[mranderson047.re-frame.v0v10v2.re-frame.loggers :refer [console]]
|
||||
[mranderson047.re-frame.v0v10v2.re-frame.registrar :as registrar]
|
||||
[mranderson047.re-frame.v0v10v2.re-frame.db :refer [app-db]]
|
||||
[clojure.data :as data]
|
||||
[mranderson047.re-frame.v0v10v2.re-frame.cofx :as cofx]
|
||||
[mranderson047.re-frame.v0v10v2.re-frame.utils :as utils]))
|
||||
|
||||
|
||||
(def debug
|
||||
"An interceptor which logs/instruments an event handler's actions to
|
||||
`js/console.debug`. See examples/todomvc/src/events.cljs for use.
|
||||
|
||||
Output includes:
|
||||
1. the event vector
|
||||
2. a `clojure.data/diff` of db, before vs after, which shows
|
||||
the changes caused by the event handler. You will absolutely have
|
||||
to understand https://clojuredocs.org/clojure.data/diff to
|
||||
understand the output.
|
||||
|
||||
You'd typically include this interceptor after (to the right of) any
|
||||
path interceptor.
|
||||
|
||||
Warning: calling clojure.data/diff on large, complex data structures
|
||||
can be slow. So, you won't want this interceptor present in production
|
||||
code. So condition it out like this :
|
||||
|
||||
(mranderson047.re-frame.v0v10v2.re-frame.core/reg-event-db
|
||||
:evt-id
|
||||
[(when ^boolean goog.DEBUG mranderson047.re-frame.v0v10v2.re-frame.core/debug)] ;; <-- conditional
|
||||
(fn [db v]
|
||||
...))
|
||||
|
||||
To make this code fragment work, you'll also have to set goog.DEBUG to
|
||||
false in your production builds - look in `project.clj` of /examples/todomvc.
|
||||
"
|
||||
(->interceptor
|
||||
:id :debug
|
||||
:before (fn debug-before
|
||||
[context]
|
||||
(console :log "Handling mranderson047.re-frame.v0v10v2.re-frame event:" (get-coeffect context :event))
|
||||
context)
|
||||
:after (fn debug-after
|
||||
[context]
|
||||
(let [event (get-coeffect context :event)
|
||||
orig-db (get-coeffect context :db)
|
||||
new-db (get-effect context :db ::not-found)]
|
||||
(if (= new-db ::not-found)
|
||||
(console :log "No :db changes caused by:" event)
|
||||
(let [[only-before only-after] (data/diff orig-db new-db)
|
||||
db-changed? (or (some? only-before) (some? only-after))]
|
||||
(if db-changed?
|
||||
(do (console :group "db clojure.data/diff for:" event)
|
||||
(console :log "only before:" only-before)
|
||||
(console :log "only after :" only-after)
|
||||
(console :groupEnd))
|
||||
(console :log "no app-db changes caused by:" event))))
|
||||
context))))
|
||||
|
||||
|
||||
(def trim-v
|
||||
"An interceptor which removes the first element of the event vector,
|
||||
allowing you to write more aesthetically pleasing event handlers. No
|
||||
leading underscore on the event-v!
|
||||
Your event handlers will look like this:
|
||||
|
||||
(defn my-handler
|
||||
[db [x y z]] ;; <-- instead of [_ x y z]
|
||||
....)"
|
||||
(->interceptor
|
||||
:id :trim-v
|
||||
:before (fn trimv-before
|
||||
[context]
|
||||
(-> context
|
||||
(update-in [:coeffects :event] subvec 1)
|
||||
(assoc-in [:coeffects ::untrimmed-event] (get-coeffect context :event))))
|
||||
:after (fn trimv-after
|
||||
[context]
|
||||
(-> context
|
||||
(utils/dissoc-in [:coeffects ::untrimmed-event])
|
||||
(assoc-in [:coeffects :event] (get-coeffect context ::untrimmed-event))))))
|
||||
|
||||
|
||||
;; -- Interceptor Factories - PART 1 ---------------------------------------------------------------
|
||||
;;
|
||||
;; These 3 factories wrap the 3 kinds of event handlers.
|
||||
;;
|
||||
|
||||
(defn db-handler->interceptor
|
||||
"Returns an interceptor which wraps the kind of event handler given to `reg-event-db`.
|
||||
|
||||
These handlers take two arguments; `db` and `event`, and they return `db`.
|
||||
|
||||
(fn [db event]
|
||||
....)
|
||||
|
||||
So, the interceptor wraps the given handler:
|
||||
1. extracts two `:coeffects` keys: db and event
|
||||
2. calls handler-fn
|
||||
3. stores the db result back into context's `:effects`"
|
||||
[handler-fn]
|
||||
(->interceptor
|
||||
:id :db-handler
|
||||
:before (fn db-handler-before
|
||||
[context]
|
||||
(let [{:keys [db event]} (:coeffects context)]
|
||||
(->> (handler-fn db event)
|
||||
(assoc-effect context :db))))))
|
||||
|
||||
|
||||
(defn fx-handler->interceptor
|
||||
"Returns an interceptor which wraps the kind of event handler given to `reg-event-fx`.
|
||||
|
||||
These handlers take two arguments; `coeffects` and `event`, and they return `effects`.
|
||||
|
||||
(fn [coeffects event]
|
||||
{:db ...
|
||||
:dispatch ...})
|
||||
|
||||
Wrap handler in an interceptor so it can be added to (the RHS) of a chain:
|
||||
1. extracts `:coeffects`
|
||||
2. call handler-fn giving coeffects
|
||||
3. stores the result back into the `:effects`"
|
||||
[handler-fn]
|
||||
(->interceptor
|
||||
:id :fx-handler
|
||||
:before (fn fx-handler-before
|
||||
[context]
|
||||
(let [{:keys [event] :as coeffects} (:coeffects context)]
|
||||
(->> (handler-fn coeffects event)
|
||||
(assoc context :effects))))))
|
||||
|
||||
|
||||
(defn ctx-handler->interceptor
|
||||
"Returns an interceptor which wraps the kind of event handler given to `reg-event-ctx`.
|
||||
These advanced handlers take one argument: `context` and they return a modified `context`.
|
||||
Example:
|
||||
(fn [context]
|
||||
(enqueue context [more interceptors]))"
|
||||
[handler-fn]
|
||||
(->interceptor
|
||||
:id :ctx-handler
|
||||
:before handler-fn))
|
||||
|
||||
|
||||
;; -- Interceptors Factories - PART 2 ------------------------------------------------------------
|
||||
|
||||
|
||||
(defn path
|
||||
"returns an interceptor whose `:before` substitutes the coeffects `:db` with
|
||||
a sub-path of `:db`. Within `:after` it grafts the handler's return value
|
||||
back into db, at the right path.
|
||||
|
||||
So, its overall action is to make the event handler behave like the function
|
||||
you might give to clojure's `update-in`.
|
||||
|
||||
Examples:
|
||||
(path :some :path)
|
||||
(path [:some :path])
|
||||
(path [:some :path] :to :here)
|
||||
(path [:some :path] [:to] :here)
|
||||
|
||||
Example Use:
|
||||
|
||||
(reg-event-db
|
||||
:event-id
|
||||
(path [:a :b]) ;; used here, in interceptor chain
|
||||
(fn [b v] ;; 1st arg is now not db. Is the value from path [:a :b] within db
|
||||
... new-b)) ;; returns a new value for that path (not the entire db)
|
||||
|
||||
Notes:
|
||||
1. `path` may appear more than once in an interceptor chain. Progressive narrowing.
|
||||
2. if `:effects` contains no `:db` effect, can't graft a value back in.
|
||||
"
|
||||
[& args]
|
||||
(let [path (flatten args)
|
||||
db-store-key :re-frame-path/db-store] ;; this is where, within `context`, we store the original dbs
|
||||
(when (empty? path)
|
||||
(console :error "re-frame: \"path\" interceptor given no params"))
|
||||
(->interceptor
|
||||
:id :path
|
||||
:before (fn
|
||||
[context]
|
||||
(let [original-db (get-coeffect context :db)]
|
||||
(-> context
|
||||
(update db-store-key conj original-db)
|
||||
(assoc-coeffect :db (get-in original-db path)))))
|
||||
:after (fn [context]
|
||||
(let [db-store (db-store-key context)
|
||||
original-db (peek db-store)
|
||||
new-db-store (pop db-store)
|
||||
context' (-> (assoc context db-store-key new-db-store)
|
||||
(assoc-coeffect :db original-db)) ;; put the original db back so that things like debug work later on
|
||||
db (get-effect context :db ::not-found)]
|
||||
(if (= db ::not-found)
|
||||
context'
|
||||
(->> (assoc-in original-db path db)
|
||||
(assoc-effect context' :db))))))))
|
||||
|
||||
|
||||
|
||||
|
||||
(defn enrich
|
||||
"Interceptor factory which runs the given function `f` in the `after handler`
|
||||
position. `f` is called with two arguments: `db` and `v`, and is expected to
|
||||
return a modified `db`.
|
||||
|
||||
Unlike the `after` interceptor which is only about side effects, `enrich`
|
||||
expects `f` to process and alter the given `db` coeffect in some useful way,
|
||||
contributing to the derived data, flowing vibe.
|
||||
|
||||
Example Use:
|
||||
------------
|
||||
|
||||
Imagine that todomvc needed to do duplicate detection - if any two todos had
|
||||
the same text, then highlight their background, and report them via a warning
|
||||
at the bottom of the panel.
|
||||
|
||||
Almost any user action (edit text, add new todo, remove a todo) requires a
|
||||
complete reassessment of duplication errors and warnings. Eg: that edit
|
||||
just made might have introduced a new duplicate, or removed one. Same with
|
||||
any todo removal. So we need to re-calculate warnings after any CRUD events
|
||||
associated with the todos list.
|
||||
|
||||
Unless we are careful, we might end up coding subtly different checks
|
||||
for each kind of CRUD operation. The duplicates check made after
|
||||
'delete todo' event might be subtly different to that done after an
|
||||
editing operation. Nice and efficient, but fiddly. A bug generator
|
||||
approach.
|
||||
|
||||
So, instead, we create an `f` which recalculates ALL warnings from scratch
|
||||
every time there is ANY change. It will inspect all the todos, and
|
||||
reset ALL FLAGS every time (overwriting what was there previously)
|
||||
and fully recalculate the list of duplicates (displayed at the bottom?).
|
||||
|
||||
https://twitter.com/nathanmarz/status/879722740776939520
|
||||
|
||||
By applying `f` in an `:enrich` interceptor, after every CRUD event,
|
||||
we keep the handlers simple and yet we ensure this important step
|
||||
(of getting warnings right) is not missed on any change.
|
||||
|
||||
We can test `f` easily - it is a pure function - independently of
|
||||
any CRUD operation.
|
||||
|
||||
This brings huge simplicity at the expense of some re-computation
|
||||
each time. This may be a very satisfactory trade-off in many cases."
|
||||
[f]
|
||||
(->interceptor
|
||||
:id :enrich
|
||||
:after (fn enrich-after
|
||||
[context]
|
||||
(let [event (get-coeffect context :event)
|
||||
db (or (get-effect context :db)
|
||||
;; If no db effect is returned, we provide the original coeffect.
|
||||
(get-coeffect context :db))]
|
||||
(->> (f db event)
|
||||
(assoc-effect context :db))))))
|
||||
|
||||
|
||||
|
||||
(defn after
|
||||
"returns an interceptor which runs a given function `f` in the `:after`
|
||||
position, presumably for side effects.
|
||||
|
||||
`f` is called with two arguments: the `:effects` value for `:db`
|
||||
(or the `coeffect` value of db if no db effect is returned) and the event.
|
||||
Its return value is ignored, so `f` can only side-effect.
|
||||
|
||||
Examples use can be seen in the /examples/todomvc:
|
||||
- `f` runs schema validation (reporting any errors found).
|
||||
- `f` writes to localstorage."
|
||||
[f]
|
||||
(->interceptor
|
||||
:id :after
|
||||
:after (fn after-after
|
||||
[context]
|
||||
(let [db (or (get-effect context :db)
|
||||
;; If no db effect is returned, we provide the original coeffect.
|
||||
(get-coeffect context :db))
|
||||
event (get-coeffect context :event)]
|
||||
(f db event) ;; call f for side effects
|
||||
context)))) ;; context is unchanged
|
||||
|
||||
|
||||
(defn on-changes
|
||||
"Interceptor factory which acts a bit like `reaction` (but it flows into
|
||||
`db`, rather than out). It observes N paths within `db` and if any of them
|
||||
test not identical? to their previous value (as a result of a event handler
|
||||
being run) then it runs `f` to compute a new value, which is then assoc-ed
|
||||
into the given `out-path` within `db`.
|
||||
|
||||
Usage:
|
||||
|
||||
(defn my-f
|
||||
[a-val b-val]
|
||||
... some computation on a and b in here)
|
||||
|
||||
(on-changes my-f [:c] [:a] [:b])
|
||||
|
||||
Put this Interceptor on the right handlers (ones which might change :a or :b).
|
||||
It will:
|
||||
- call `f` each time the value at path [:a] or [:b] changes
|
||||
- call `f` with the values extracted from [:a] [:b]
|
||||
- assoc the return value from `f` into the path [:c]
|
||||
"
|
||||
[f out-path & in-paths]
|
||||
(->interceptor
|
||||
:id :on-changes
|
||||
:after (fn on-change-after
|
||||
[context]
|
||||
(let [new-db (get-effect context :db)
|
||||
old-db (get-coeffect context :db)
|
||||
|
||||
;; work out if any "inputs" have changed
|
||||
new-ins (map #(get-in new-db %) in-paths)
|
||||
old-ins (map #(get-in old-db %) in-paths)
|
||||
;; make sure the db is actually set in the effect
|
||||
changed-ins? (and (contains? (get-effect context) :db)
|
||||
(some false? (map identical? new-ins old-ins)))]
|
||||
|
||||
;; if one of the inputs has changed, then run 'f'
|
||||
(if changed-ins?
|
||||
(->> (apply f new-ins)
|
||||
(assoc-in new-db out-path)
|
||||
(assoc-effect context :db))
|
||||
context)))))
|
330
src/mranderson047/re_frame/v0v10v2/re_frame/subs.cljc
Normal file
330
src/mranderson047/re_frame/v0v10v2/re_frame/subs.cljc
Normal file
@ -0,0 +1,330 @@
|
||||
(ns mranderson047.re-frame.v0v10v2.re-frame.subs
|
||||
(:require
|
||||
[mranderson047.re-frame.v0v10v2.re-frame.db :refer [app-db]]
|
||||
[mranderson047.re-frame.v0v10v2.re-frame.interop :refer [add-on-dispose! debug-enabled? make-reaction ratom? deref? dispose! reagent-id]]
|
||||
[mranderson047.re-frame.v0v10v2.re-frame.loggers :refer [console]]
|
||||
[mranderson047.re-frame.v0v10v2.re-frame.utils :refer [first-in-vector]]
|
||||
[mranderson047.re-frame.v0v10v2.re-frame.registrar :refer [get-handler clear-handlers register-handler]]
|
||||
[mranderson047.re-frame.v0v10v2.re-frame.trace :as trace :include-macros true]))
|
||||
|
||||
(def kind :sub)
|
||||
(assert (mranderson047.re-frame.v0v10v2.re-frame.registrar/kinds kind))
|
||||
|
||||
;; -- cache -------------------------------------------------------------------
|
||||
;;
|
||||
;; De-duplicate subscriptions. If two or more equal subscriptions
|
||||
;; are concurrently active, we want only one handler running.
|
||||
;; Two subscriptions are "equal" if their query vectors test "=".
|
||||
(def query->reaction (atom {}))
|
||||
|
||||
(defn clear-subscription-cache!
|
||||
"Causes all subscriptions to be removed from the cache.
|
||||
Does this by:
|
||||
1. running on-dispose on all cached subscriptions
|
||||
2. These on-dispose will then do the removal of themselves.
|
||||
|
||||
This is a development time tool. Useful when reloading Figwheel code
|
||||
after a React exception, because React components won't have been
|
||||
cleaned up properly. And this, in turn, means the subscriptions within those
|
||||
components won't have been cleaned up correctly. So this forces the issue."
|
||||
[]
|
||||
(doseq [[k rxn] @query->reaction]
|
||||
(dispose! rxn))
|
||||
(if (not-empty @query->reaction)
|
||||
(console :warn "Subscription cache should be empty after clearing it.")))
|
||||
|
||||
(defn clear-all-handlers!
|
||||
"Unregisters all existing subscription handlers"
|
||||
[]
|
||||
(clear-handlers kind)
|
||||
(clear-subscription-cache!))
|
||||
|
||||
(defn cache-and-return
|
||||
"cache the reaction r"
|
||||
[query-v dynv r]
|
||||
(let [cache-key [query-v dynv]]
|
||||
;; when this reaction is no longer being used, remove it from the cache
|
||||
(add-on-dispose! r #(do (swap! query->reaction dissoc cache-key)
|
||||
(trace/with-trace {:operation (first-in-vector query-v)
|
||||
:op-type :sub/dispose
|
||||
:tags {:query-v query-v
|
||||
:reaction (reagent-id r)}}
|
||||
nil)))
|
||||
;; cache this reaction, so it can be used to deduplicate other, later "=" subscriptions
|
||||
(swap! query->reaction assoc cache-key r)
|
||||
(trace/merge-trace! {:tags {:reaction (reagent-id r)}})
|
||||
r)) ;; return the actual reaction
|
||||
|
||||
(defn cache-lookup
|
||||
([query-v]
|
||||
(cache-lookup query-v []))
|
||||
([query-v dyn-v]
|
||||
(get @query->reaction [query-v dyn-v])))
|
||||
|
||||
|
||||
;; -- subscribe ---------------------------------------------------------------
|
||||
|
||||
(defn subscribe
|
||||
"Given a `query`, returns a Reagent `reaction` which, over
|
||||
time, reactively delivers a stream of values. So in FRP-ish terms,
|
||||
it returns a Signal.
|
||||
|
||||
To obtain the returned Signal/Stream's current value, it must be `deref`ed.
|
||||
|
||||
`query` is a vector of at least one element. The first element is the
|
||||
`query-id`, typically a namespaced keyword. The rest of the vector's
|
||||
elements are optional, additional values which parameterise the query
|
||||
performed.
|
||||
|
||||
`dynv` is an optional 3rd argument, `which is a vector of further input
|
||||
signals (atoms, reactions, etc), NOT values. This argument exists for
|
||||
historical reasons and is borderline deprecated these days.
|
||||
|
||||
Example Usage:
|
||||
--------------
|
||||
|
||||
(subscribe [:items])
|
||||
(subscribe [:items \"blue\" :small])
|
||||
(subscribe [:items {:colour \"blue\" :size :small}])
|
||||
|
||||
Note: for any given call to `subscribe` there must have been a previous call
|
||||
to `reg-sub`, registering the query handler (function) for the `query-id` given.
|
||||
|
||||
Hint
|
||||
----
|
||||
|
||||
When used in a view function BE SURE to `deref` the returned value.
|
||||
In fact, to avoid any mistakes, some prefer to define:
|
||||
|
||||
(def <sub (comp deref mranderson047.re-frame.v0v10v2.re-frame.core/subscribe))
|
||||
|
||||
And then, within their views, they call `(<sub [:items :small])` rather
|
||||
than using `subscribe` directly.
|
||||
|
||||
De-duplication
|
||||
--------------
|
||||
|
||||
XXX
|
||||
"
|
||||
|
||||
([query]
|
||||
(trace/with-trace {:operation (first-in-vector query)
|
||||
:op-type :sub/create
|
||||
:tags {:query-v query}}
|
||||
(if-let [cached (cache-lookup query)]
|
||||
(do
|
||||
(trace/merge-trace! {:tags {:cached? true
|
||||
:reaction (reagent-id cached)}})
|
||||
cached)
|
||||
|
||||
(let [query-id (first-in-vector query)
|
||||
handler-fn (get-handler kind query-id)]
|
||||
(trace/merge-trace! {:tags {:cached? false}})
|
||||
(if (nil? handler-fn)
|
||||
(do (trace/merge-trace! {:error true})
|
||||
(console :error (str "re-frame: no subscription handler registered for: \"" query-id "\". Returning a nil subscription.")))
|
||||
(cache-and-return query [] (handler-fn app-db query)))))))
|
||||
|
||||
([query dynv]
|
||||
(trace/with-trace {:operation (first-in-vector query)
|
||||
:op-type :sub/create
|
||||
:tags {:query-v query
|
||||
:dyn-v dynv}}
|
||||
(if-let [cached (cache-lookup query dynv)]
|
||||
(do
|
||||
(trace/merge-trace! {:tags {:cached? true
|
||||
:reaction (reagent-id cached)}})
|
||||
cached)
|
||||
(let [query-id (first-in-vector query)
|
||||
handler-fn (get-handler kind query-id)]
|
||||
(trace/merge-trace! {:tags {:cached? false}})
|
||||
(when debug-enabled?
|
||||
(when-let [not-reactive (not-empty (remove ratom? dynv))]
|
||||
(console :warn "re-frame: your subscription's dynamic parameters that don't implement IReactiveAtom:" not-reactive)))
|
||||
(if (nil? handler-fn)
|
||||
(do (trace/merge-trace! {:error true})
|
||||
(console :error (str "re-frame: no subscription handler registered for: \"" query-id "\". Returning a nil subscription.")))
|
||||
(let [dyn-vals (make-reaction (fn [] (mapv deref dynv)))
|
||||
sub (make-reaction (fn [] (handler-fn app-db query @dyn-vals)))]
|
||||
;; handler-fn returns a reaction which is then wrapped in the sub reaction
|
||||
;; need to double deref it to get to the actual value.
|
||||
;(console :log "Subscription created: " v dynv)
|
||||
(cache-and-return query dynv (make-reaction (fn [] @@sub))))))))))
|
||||
|
||||
;; -- reg-sub -----------------------------------------------------------------
|
||||
|
||||
(defn- map-vals
|
||||
"Returns a new version of 'm' in which 'f' has been applied to each value.
|
||||
(map-vals inc {:a 4, :b 2}) => {:a 5, :b 3}"
|
||||
[f m]
|
||||
(into (empty m)
|
||||
(map (fn [[k v]] [k (f v)]))
|
||||
m))
|
||||
|
||||
|
||||
(defn- deref-input-signals
|
||||
[signals query-id]
|
||||
(let [signals (cond
|
||||
(sequential? signals) (map deref signals)
|
||||
(map? signals) (map-vals deref signals)
|
||||
(deref? signals) @signals
|
||||
:else (console :error "re-frame: in the reg-sub for " query-id ", the input-signals function returns: " signals))]
|
||||
(trace/merge-trace! {:tags {:input-signals (map reagent-id signals)}})
|
||||
signals))
|
||||
|
||||
|
||||
(defn reg-sub
|
||||
"For a given `query-id`, register a `computation` function and input `signals`.
|
||||
|
||||
At an abstract level, a call to this function allows you to register 'the mechanism'
|
||||
to later fulfil a call to `(subscribe [query-id ...])`.
|
||||
|
||||
To say that another way, reg-sub allows you to create a template for a node
|
||||
in the signal graph. But note: reg-sub does not cause a node to be created.
|
||||
It simply allows you to register the template from which such a
|
||||
node could be created, if it were needed, sometime later, when the call
|
||||
to `subscribe` is made.
|
||||
|
||||
reg-sub needs three things:
|
||||
- a `query-id`
|
||||
- the required inputs for this node
|
||||
- a computation function for this node
|
||||
|
||||
The `query-id` is always the 1st argument to reg-sub and it is typically
|
||||
a namespaced keyword.
|
||||
|
||||
A computation function is always the last argument and it has this general form:
|
||||
`(input-signals, query-vector) -> a-value`
|
||||
|
||||
What goes in between the 1st and last args can vary, but whatever is there will
|
||||
define the input signals part of the template, and, as a result, it will control
|
||||
what values the computation functions gets as a first argument.
|
||||
|
||||
There's 3 ways this function can be called - 3 ways to supply input signals:
|
||||
|
||||
1. No input signals given:
|
||||
|
||||
(reg-sub
|
||||
:query-id
|
||||
a-computation-fn) ;; (fn [db v] ... a-value)
|
||||
|
||||
The node's input signal defaults to `app-db`, and the value within `app-db` is
|
||||
is given as the 1st argument to the computation function.
|
||||
|
||||
2. A signal function is supplied:
|
||||
|
||||
(reg-sub
|
||||
:query-id
|
||||
signal-fn ;; <-- here
|
||||
computation-fn)
|
||||
|
||||
When a node is created from the template, the `signal-fn` will be called and it
|
||||
is expected to return the input signal(s) as either a singleton, if there is only
|
||||
one, or a sequence if there are many, or a map with the signals as the values.
|
||||
|
||||
The values from the nominated signals will be supplied as the 1st argument to the
|
||||
computation function - either a singleton, sequence or map of them, paralleling
|
||||
the structure returned by the signal function.
|
||||
|
||||
Here, is an example signal-fn, which returns a vector of input signals.
|
||||
|
||||
(fn [query-vec dynamic-vec]
|
||||
[(subscribe [:a-sub])
|
||||
(subscribe [:b-sub])])
|
||||
|
||||
For that signal function, the computation function must be written
|
||||
to expect a vector of values for its first argument.
|
||||
(fn [[a b] _] ....)
|
||||
|
||||
If the signal function was simpler and returned a singleton, like this:
|
||||
(fn [query-vec dynamic-vec]
|
||||
(subscribe [:a-sub]))
|
||||
|
||||
then the computation function must be written to expect a single value
|
||||
as the 1st argument:
|
||||
|
||||
(fn [a _] ...)
|
||||
|
||||
3. Syntax Sugar
|
||||
|
||||
(reg-sub
|
||||
:a-b-sub
|
||||
:<- [:a-sub]
|
||||
:<- [:b-sub]
|
||||
(fn [[a b] [_]] {:a a :b b}))
|
||||
|
||||
This 3rd variation is syntactic sugar for the 2nd. Pairs are supplied instead
|
||||
of an `input signals` functions. Each pair starts with a `:<-` and a subscription
|
||||
vector follows.
|
||||
|
||||
For further understanding, read `/docs`, and look at the detailed comments in
|
||||
/examples/todomvc/src/subs.cljs
|
||||
"
|
||||
[query-id & args]
|
||||
(let [computation-fn (last args)
|
||||
input-args (butlast args) ;; may be empty, or one signal fn, or pairs of :<- / vector
|
||||
err-header (str "re-frame: reg-sub for " query-id ", ")
|
||||
inputs-fn (case (count input-args)
|
||||
;; no `inputs` function provided - give the default
|
||||
0 (fn
|
||||
([_] app-db)
|
||||
([_ _] app-db))
|
||||
|
||||
;; a single `inputs` fn
|
||||
1 (let [f (first input-args)]
|
||||
(when-not (fn? f)
|
||||
(console :error err-header "2nd argument expected to be an inputs function, got:" f))
|
||||
f)
|
||||
|
||||
;; one sugar pair
|
||||
2 (let [[marker vec] input-args]
|
||||
(when-not (= :<- marker)
|
||||
(console :error err-header "expected :<-, got:" marker))
|
||||
(fn inp-fn
|
||||
([_] (subscribe vec))
|
||||
([_ _] (subscribe vec))))
|
||||
|
||||
;; multiple sugar pairs
|
||||
(let [pairs (partition 2 input-args)
|
||||
markers (map first pairs)
|
||||
vecs (map last pairs)]
|
||||
(when-not (and (every? #{:<-} markers) (every? vector? vecs))
|
||||
(console :error err-header "expected pairs of :<- and vectors, got:" pairs))
|
||||
(fn inp-fn
|
||||
([_] (map subscribe vecs))
|
||||
([_ _] (map subscribe vecs)))))]
|
||||
(register-handler
|
||||
kind
|
||||
query-id
|
||||
(fn subs-handler-fn
|
||||
([db query-vec]
|
||||
(let [subscriptions (inputs-fn query-vec)
|
||||
reaction-id (atom nil)
|
||||
reaction (make-reaction
|
||||
(fn []
|
||||
(trace/with-trace {:operation (first-in-vector query-vec)
|
||||
:op-type :sub/run
|
||||
:tags {:query-v query-vec
|
||||
:reaction @reaction-id}}
|
||||
(let [subscription (computation-fn (deref-input-signals subscriptions query-id) query-vec)]
|
||||
(trace/merge-trace! {:tags {:value subscription}})
|
||||
subscription))))]
|
||||
|
||||
(reset! reaction-id (reagent-id reaction))
|
||||
reaction))
|
||||
([db query-vec dyn-vec]
|
||||
(let [subscriptions (inputs-fn query-vec dyn-vec)
|
||||
reaction-id (atom nil)
|
||||
reaction (make-reaction
|
||||
(fn []
|
||||
(trace/with-trace {:operation (first-in-vector query-vec)
|
||||
:op-type :sub/run
|
||||
:tags {:query-v query-vec
|
||||
:dyn-v dyn-vec
|
||||
:reaction @reaction-id}}
|
||||
(let [subscription (computation-fn (deref-input-signals subscriptions query-id) query-vec dyn-vec)]
|
||||
(trace/merge-trace! {:tags {:value subscription}})
|
||||
subscription))))]
|
||||
|
||||
(reset! reaction-id (reagent-id reaction))
|
||||
reaction))))))
|
82
src/mranderson047/re_frame/v0v10v2/re_frame/trace.cljc
Normal file
82
src/mranderson047/re_frame/v0v10v2/re_frame/trace.cljc
Normal file
@ -0,0 +1,82 @@
|
||||
(ns mranderson047.re-frame.v0v10v2.re-frame.trace
|
||||
"Tracing for mranderson047.re-frame.v0v10v2.re-frame.
|
||||
Alpha quality, subject to change/break at any time."
|
||||
#?(:cljs (:require-macros [net.cgrand.macrovich :as macros]
|
||||
[mranderson047.re-frame.v0v10v2.re-frame.trace :refer [finish-trace with-trace merge-trace!]]))
|
||||
(:require [mranderson047.re-frame.v0v10v2.re-frame.interop :as interop]
|
||||
#?(:clj [net.cgrand.macrovich :as macros])
|
||||
[mranderson047.re-frame.v0v10v2.re-frame.loggers :refer [console]]))
|
||||
|
||||
(def id (atom 0))
|
||||
(def ^:dynamic *current-trace* nil)
|
||||
|
||||
(defn reset-tracing! []
|
||||
(reset! id 0))
|
||||
|
||||
#?(:cljs (goog-define trace-enabled? false)
|
||||
:clj (def ^boolean trace-enabled? false))
|
||||
|
||||
(defn ^boolean is-trace-enabled?
|
||||
"See https://groups.google.com/d/msg/clojurescript/jk43kmYiMhA/IHglVr_TPdgJ for more details"
|
||||
[]
|
||||
trace-enabled?)
|
||||
|
||||
(def trace-cbs (atom {}))
|
||||
|
||||
(defn register-trace-cb
|
||||
"Registers a tracing callback function which will receive a collection of one or more traces.
|
||||
Will replace an existing callback function if it shares the same key."
|
||||
[key f]
|
||||
(if trace-enabled?
|
||||
(swap! trace-cbs assoc key f)
|
||||
(console :warn "Tracing is not enabled. Please set {\"re_frame.trace.trace_enabled_QMARK_\" true} in :closure-defines. See: https://github.com/Day8/re-frame-trace#installation.")))
|
||||
|
||||
(defn remove-trace-cb [key]
|
||||
(swap! trace-cbs dissoc key)
|
||||
nil)
|
||||
|
||||
(defn next-id [] (swap! id inc))
|
||||
|
||||
(defn start-trace [{:keys [operation op-type tags child-of]}]
|
||||
{:id (next-id)
|
||||
:operation operation
|
||||
:op-type op-type
|
||||
:tags tags
|
||||
:child-of (or child-of (:id *current-trace*))
|
||||
:start (interop/now)})
|
||||
|
||||
(macros/deftime
|
||||
(defmacro finish-trace [trace]
|
||||
`(when (is-trace-enabled?)
|
||||
(let [end# (interop/now)
|
||||
duration# (- end# (:start ~trace))]
|
||||
(doseq [[k# cb#] @trace-cbs]
|
||||
(try (cb# [(assoc ~trace
|
||||
:duration duration#
|
||||
:end (interop/now))])
|
||||
#?(:clj (catch Exception e#
|
||||
(console :error "Error thrown from trace cb" k# "while storing" ~trace e#)))
|
||||
#?(:cljs (catch :default e#
|
||||
(console :error "Error thrown from trace cb" k# "while storing" ~trace e#))))))))
|
||||
|
||||
(defmacro with-trace
|
||||
"Create a trace inside the scope of the with-trace macro
|
||||
|
||||
Common keys for trace-opts
|
||||
:op-type - what kind of operation is this? e.g. :sub/create, :render.
|
||||
:operation - identifier for the operation, for an subscription it would be the subscription keyword
|
||||
tags - a map of arbitrary kv pairs"
|
||||
[{:keys [operation op-type tags child-of] :as trace-opts} & body]
|
||||
`(if (is-trace-enabled?)
|
||||
(binding [*current-trace* (start-trace ~trace-opts)]
|
||||
(try ~@body
|
||||
(finally (finish-trace *current-trace*))))
|
||||
(do ~@body)))
|
||||
|
||||
(defmacro merge-trace! [m]
|
||||
;; Overwrite keys in tags, and all top level keys.
|
||||
`(when (is-trace-enabled?)
|
||||
(let [new-trace# (-> (update *current-trace* :tags merge (:tags ~m))
|
||||
(merge (dissoc ~m :tags)))]
|
||||
(set! *current-trace* new-trace#))
|
||||
nil)))
|
24
src/mranderson047/re_frame/v0v10v2/re_frame/utils.cljc
Normal file
24
src/mranderson047/re_frame/v0v10v2/re_frame/utils.cljc
Normal file
@ -0,0 +1,24 @@
|
||||
(ns mranderson047.re-frame.v0v10v2.re-frame.utils
|
||||
(:require
|
||||
[mranderson047.re-frame.v0v10v2.re-frame.loggers :refer [console]]))
|
||||
|
||||
(defn dissoc-in
|
||||
"Dissociates an entry from a nested associative structure returning a new
|
||||
nested structure. keys is a sequence of keys. Any empty maps that result
|
||||
will not be present in the new structure.
|
||||
The key thing is that 'm' remains identical? to istelf if the path was never present"
|
||||
[m [k & ks :as keys]]
|
||||
(if ks
|
||||
(if-let [nextmap (get m k)]
|
||||
(let [newmap (dissoc-in nextmap ks)]
|
||||
(if (seq newmap)
|
||||
(assoc m k newmap)
|
||||
(dissoc m k)))
|
||||
m)
|
||||
(dissoc m k)))
|
||||
|
||||
(defn first-in-vector
|
||||
[v]
|
||||
(if (vector? v)
|
||||
(first v)
|
||||
(console :error "re-frame: expected a vector, but got:" v)))
|
Loading…
x
Reference in New Issue
Block a user