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:
Daniel Compton 2017-10-30 17:07:41 +13:00
parent 6bd14f1799
commit 900bb414e9
17 changed files with 2093 additions and 3 deletions

View File

@ -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
```

View File

@ -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]]]}})

View 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))

View 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))

View 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 {}))

View 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)))))))

View 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))))

View 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)))

View 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)

View 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))))

View 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)

View 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.")))))

View 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

View File

@ -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)))))

View 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))))))

View 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)))

View 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)))