From ab7e613cbb707823b12daa750486df4729dd1087 Mon Sep 17 00:00:00 2001
From: mike-thompson-day8 <mike.thompson@day8.com.au>
Date: Wed, 25 Feb 2015 08:58:55 +1100
Subject: [PATCH] Introduce new middleware   DO NOT USE YET.  THIS PUSH DOES
 NOT EVEN COMPILE

---
 src/re_frame/handlers.cljs | 125 +++++++++++++++++++++++++++----------
 src/re_frame/history.cljs  |  14 ++---
 2 files changed, 99 insertions(+), 40 deletions(-)

diff --git a/src/re_frame/handlers.cljs b/src/re_frame/handlers.cljs
index f32a759..de32681 100644
--- a/src/re_frame/handlers.cljs
+++ b/src/re_frame/handlers.cljs
@@ -1,13 +1,15 @@
 (ns re-frame.handlers
   (:refer-clojure :exclude [flush])
   (:require-macros [cljs.core.async.macros :refer [go-loop go]])
-  (:require [reagent.core :refer [flush]]
-            [re-frame.db :refer [app-db]]
-            [re-frame.utils :refer [first-in-vector warn]]
-            [cljs.core.async :refer [chan put! <! timeout]]))
+  (:require [reagent.core     :refer [flush]]
+            [reagent.ratom    :refer [IReactiveAtom]]
+            [re-frame.db      :refer [app-db]]
+            [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 {}))
 
@@ -15,14 +17,15 @@
   "register a handler for an event"
   [event-id handler-fn]
   (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))
 
 
 ;; -- The Event Conveyor Belt  --------------------------------------------------------------------
 ;;
 ;; 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?
 
 
@@ -47,19 +50,19 @@
 ;; back control to the browser, via a (<! (timeout 0)) call.
 ;;
 ;; 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
-;; for an extended period.  In such a case, the event should have metadata
+;; 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 be laballed with metadata
 ;; Example usage:
 ;;   (dispatch ^:flush-dom  [:event-id other params])
 ;;
 ;; router loop
 (go-loop []
-   (let [event-v  (<! event-chan)                   ;; wait for an event
-         _        (if (:flush-dom (meta event-v))
-                    (do (flush) (<! (timeout 20)))  ;; wait just over one annimation frame (16ms), to rensure all pending GUI work is done.
-                    (<! (timeout 0)))]              ;; just in case we are handling one dispatch after an other, give the GUI a chance to do its stuff.
-     (handle event-v)
-     (recur)))
+         (let [event-v  (<! event-chan)                   ;; wait for an event
+               _        (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 flushed to the DOM.
+                          (<! (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)
+           (recur)))
 
 
 ;; -- dispatch ------------------------------------------------------------------------------------
@@ -81,25 +84,83 @@
   (handle event-v))
 
 
-;; -- helper --------------------------------------------------------------------------------------
 
-;; TODO: Yuck. this has to go.
-(defn transaction!
-  "A helper fucntion to be used when writting event handlers.
-  Allows a handler to perform an atomic modification of the atom.
-  Modification consist of one or more mutations, wrapped by a function,
-  followed by a call to a validation fucntion which may also annotate the
-  data structures with further information.
+;; -- Middleware Factories -------------------------------------------------------------------------
+;;
+;;  Middleware wraps handlers, providing a composable pipeline.
+;;
+;;  Read this (go to "Handlers and Middleware"):
+;;     http://www.flyingmachinestudios.com/programming/boot-clj/
+;;
+;;  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]
-    (transaction! db description mutation-fn identity))
+(defn undoable
+  "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
-            (-> @db
-                (assoc :undo-description description)
-                mutation-fn
-                validation-fn))))
+
+(defn make-pure
+  "Middleware for wrapping a pure handler.
+  1. on the way through it extracts the value in the atom
+  2. resets the atom with the returned value after calling the handler"
+  [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)))))
 
diff --git a/src/re_frame/history.cljs b/src/re_frame/history.cljs
index c0b9ecb..5de89dc 100644
--- a/src/re_frame/history.cljs
+++ b/src/re_frame/history.cljs
@@ -1,7 +1,7 @@
 (ns re-frame.history
   (:require-macros [reagent.ratom  :refer [reaction]])
   (:require
-    [reagent.core      :as     r]
+    [reagent.core      :as     reagent]
     [re-frame.db       :refer  [app-db]]
     [re-frame.handlers :as     handlers ]
     [re-frame.subs     :as     subs ]))
@@ -16,8 +16,8 @@
   (reset! max-undos n))
 
 ;;
-(def ^:private undo-list (r/atom []))   ;; a list of history states
-(def ^:private redo-list (r/atom []))   ;; a list of future states, caused by undoing
+(def ^:private undo-list (reagent/atom []))   ;; a list of history states
+(def ^:private redo-list (reagent/atom []))   ;; a list of future states, caused by undoing
 
 
 (defn clear-history!
@@ -27,12 +27,12 @@
 
 
 (defn store-now!
-  "stores the current state"
-  [state]
+  "stores the value currently in app-db, so the user can later undo"
+  []
   (reset! redo-list [])           ;; clear and redo state created by previous undos
   (reset! undo-list (vec (take
                            @max-undos
-                           (conj @undo-list state)))))
+                           (conj @undo-list @app-db)))))
 
 
 ;; -- subscriptions  -----------------------------------------------------------------------------
@@ -54,8 +54,6 @@
 
 ;; -- event handlers  ----------------------------------------------------------------------------
 
-;; XXX get these right
-
 (handlers/register     ;; not pure
   :undo                ;; usage:  (dispatch [:undo])
   (fn handler