Introduce new middleware DO NOT USE YET. THIS PUSH DOES NOT EVEN COMPILE

This commit is contained in:
mike-thompson-day8 2015-02-25 08:58:55 +11:00
parent 9335a71bc0
commit ab7e613cbb
2 changed files with 99 additions and 40 deletions

View File

@ -1,13 +1,15 @@
(ns re-frame.handlers (ns re-frame.handlers
(:refer-clojure :exclude [flush]) (:refer-clojure :exclude [flush])
(:require-macros [cljs.core.async.macros :refer [go-loop go]]) (:require-macros [cljs.core.async.macros :refer [go-loop go]])
(:require [reagent.core :refer [flush]] (:require [reagent.core :refer [flush]]
[re-frame.db :refer [app-db]] [reagent.ratom :refer [IReactiveAtom]]
[re-frame.utils :refer [first-in-vector warn]] [re-frame.db :refer [app-db]]
[cljs.core.async :refer [chan put! <! timeout]])) [re-frame.history :refer [store-now!]]
[re-frame.utils :refer [first-in-vector warn]]
[cljs.core.async :refer [chan put! <! timeout]]))
;; -- register of event handlers ------------------------------------------------------------------------ ;; -- the register of event handlers --------------------------------------------------------------
(def ^:private id->fn (atom {})) (def ^:private id->fn (atom {}))
@ -15,14 +17,15 @@
"register a handler for an event" "register a handler for an event"
[event-id handler-fn] [event-id handler-fn]
(when (contains? @id->fn event-id) (when (contains? @id->fn event-id)
(warn "re-frame: overwriting an event-handler" event-id)) ;; allow it, but warn. (warn "re-frame: overwriting an event-handler for: " event-id)) ;; allow it, but warn.
(swap! id->fn assoc event-id handler-fn)) (swap! id->fn assoc event-id handler-fn))
;; -- The Event Conveyor Belt -------------------------------------------------------------------- ;; -- The Event Conveyor Belt --------------------------------------------------------------------
;; ;;
;; Moves events from "dispatch" to the router loop. ;; Moves events from "dispatch" to the router loop.
;; Key architecutal purpose is to cause aysnc handling of events. ;; This alows for aysnc handling of events.
;;
(def ^:private event-chan (chan)) ;; TODO: how big should we make the buffer? (def ^:private event-chan (chan)) ;; TODO: how big should we make the buffer?
@ -47,19 +50,19 @@
;; back control to the browser, via a (<! (timeout 0)) call. ;; back control to the browser, via a (<! (timeout 0)) call.
;; ;;
;; In odd cases, we need to pause for an entire annimationFrame, to ensure that ;; In odd cases, we need to pause for an entire annimationFrame, to ensure that
;; the DOM is fully flushed, before thencalling a handler known to hog the CPU ;; the DOM is fully flushed, before then calling a handler known to hog the CPU
;; for an extended period. In such a case, the event should have metadata ;; for an extended period. In such a case, the event should be laballed with metadata
;; Example usage: ;; Example usage:
;; (dispatch ^:flush-dom [:event-id other params]) ;; (dispatch ^:flush-dom [:event-id other params])
;; ;;
;; router loop ;; router loop
(go-loop [] (go-loop []
(let [event-v (<! event-chan) ;; wait for an event (let [event-v (<! event-chan) ;; wait for an event
_ (if (:flush-dom (meta event-v)) _ (if (:flush-dom (meta event-v)) ;; check the event for metadata
(do (flush) (<! (timeout 20))) ;; wait just over one annimation frame (16ms), to rensure all pending GUI work is done. (do (flush) (<! (timeout 20))) ;; wait just over one annimation frame (16ms), to rensure all pending GUI work is flushed to the DOM.
(<! (timeout 0)))] ;; just in case we are handling one dispatch after an other, give the GUI a chance to do its stuff. (<! (timeout 0)))] ;; just in case we are handling one dispatch after an other, give the browser back control to do its stuff
(handle event-v) (handle event-v)
(recur))) (recur)))
;; -- dispatch ------------------------------------------------------------------------------------ ;; -- dispatch ------------------------------------------------------------------------------------
@ -81,25 +84,83 @@
(handle event-v)) (handle event-v))
;; -- helper --------------------------------------------------------------------------------------
;; TODO: Yuck. this has to go. ;; -- Middleware Factories -------------------------------------------------------------------------
(defn transaction! ;;
"A helper fucntion to be used when writting event handlers. ;; Middleware wraps handlers, providing a composable pipeline.
Allows a handler to perform an atomic modification of the atom. ;;
Modification consist of one or more mutations, wrapped by a function, ;; Read this (go to "Handlers and Middleware"):
followed by a call to a validation fucntion which may also annotate the ;; http://www.flyingmachinestudios.com/programming/boot-clj/
data structures with further information. ;;
;; Use "comp" to compose middelware, like this:
;;
;; (def midware (comp undoable make-pure (validate some-fn))) ;; midware is a function
;;
;; then imagine that we have a pure handler:
;;
;; (defn my-handler
;; [db v]
;; (assoc db :some-key 42))
;;
;; then apply the composed middleare to my-handler:
;;
;; (def h (midware my-handler)) ;; h is "my-handler" wrapped in middleware
;;
;; now call h:
;; (h app-db [:delete-it]) <---- h is a handler, just pass in 'db' and 'v'
;;
;; Which means, you could just register 'h'
;;
;; (register
;; :some-id
;; h)
;;
XXX This feels a bit too nested."
([db description mutation-fn] (defn undoable
(transaction! db description mutation-fn identity)) "Middleware which stores an undo checkpoint"
[next-handler]
(fn handler
[app-db event-vec]
(store-now!)
(next-handler app-db event-vec)))
([db description mutation-fn validation-fn]
(reset! db (defn make-pure
(-> @db "Middleware for wrapping a pure handler.
(assoc :undo-description description) 1. on the way through it extracts the value in the atom
mutation-fn 2. resets the atom with the returned value after calling the handler"
validation-fn)))) [next-handler]
(fn handler
[app-db event-vec]
(assert (satisfies? IReactiveAtom app-db) "re-frame: make-pure not given a Ratom")
(reset! app-db (next-handler @app-db event-vec))))
;; example of applying
#_(defn check-schema
"Middleware for checking that a handlers mutations leave the state in a schema-matching way"
[a-prismatic-schema]
(fn middlewear
[next-handler]
(fn handler
[db v]
(let [val (next-handler db v)
valid? true] ;; XXXXX replace true by code which checks the schema using original parameter
(if (not valid?)
(warn "re-frame: schema not valid after:" ))
val))))
(defn validate
"Middleware that applies a validation function to the db after the handler is finished.
The validation function f, might assoc warnings and errors to the new state, created by the handler.
By validation, I mean validation of what the user has entered, or the state they have taken the app too"
[f]
(fn middlewear
[next-handler]
(fn handler
[db v]
(f (next-handler db v)))))

View File

@ -1,7 +1,7 @@
(ns re-frame.history (ns re-frame.history
(:require-macros [reagent.ratom :refer [reaction]]) (:require-macros [reagent.ratom :refer [reaction]])
(:require (:require
[reagent.core :as r] [reagent.core :as reagent]
[re-frame.db :refer [app-db]] [re-frame.db :refer [app-db]]
[re-frame.handlers :as handlers ] [re-frame.handlers :as handlers ]
[re-frame.subs :as subs ])) [re-frame.subs :as subs ]))
@ -16,8 +16,8 @@
(reset! max-undos n)) (reset! max-undos n))
;; ;;
(def ^:private undo-list (r/atom [])) ;; a list of history states (def ^:private undo-list (reagent/atom [])) ;; a list of history states
(def ^:private redo-list (r/atom [])) ;; a list of future states, caused by undoing (def ^:private redo-list (reagent/atom [])) ;; a list of future states, caused by undoing
(defn clear-history! (defn clear-history!
@ -27,12 +27,12 @@
(defn store-now! (defn store-now!
"stores the current state" "stores the value currently in app-db, so the user can later undo"
[state] []
(reset! redo-list []) ;; clear and redo state created by previous undos (reset! redo-list []) ;; clear and redo state created by previous undos
(reset! undo-list (vec (take (reset! undo-list (vec (take
@max-undos @max-undos
(conj @undo-list state))))) (conj @undo-list @app-db)))))
;; -- subscriptions ----------------------------------------------------------------------------- ;; -- subscriptions -----------------------------------------------------------------------------
@ -54,8 +54,6 @@
;; -- event handlers ---------------------------------------------------------------------------- ;; -- event handlers ----------------------------------------------------------------------------
;; XXX get these right
(handlers/register ;; not pure (handlers/register ;; not pure
:undo ;; usage: (dispatch [:undo]) :undo ;; usage: (dispatch [:undo])
(fn handler (fn handler