From 420e42aacccbac2d81fedc5ff861442a4ce70c1d Mon Sep 17 00:00:00 2001
From: mike-thompson-day8 <mike.thompson@day8.com.au>
Date: Mon, 2 Nov 2015 22:37:46 +1100
Subject: [PATCH] Introduce a router loop, not based on core-async

---
 src/re_frame/router.cljs | 234 ++++++++++++++++++++++++++++-----------
 1 file changed, 168 insertions(+), 66 deletions(-)

diff --git a/src/re_frame/router.cljs b/src/re_frame/router.cljs
index 0ebb35d..1d6f654 100644
--- a/src/re_frame/router.cljs
+++ b/src/re_frame/router.cljs
@@ -1,81 +1,184 @@
 (ns re-frame.router
   (:refer-clojure :exclude [flush])
-  (:require-macros [cljs.core.async.macros :refer [go-loop go]])
-  (:require [reagent.core        :refer [flush]]
-            [re-frame.handlers   :refer [handle]]
-            [re-frame.utils      :refer [warn error]]
-            [cljs.core.async     :refer [chan put! <! timeout close!]]
+  (:require [reagent.core :refer [flush]]
+            [reagent.impl.batching :refer [do-later]]
+            [re-frame.handlers :refer [handle]]
+            [re-frame.utils :refer [warn error]]
             [goog.async.nextTick]))
 
-;; -- The Event Conveyor Belt  --------------------------------------------------------------------
-;;
-;; Moves events from "dispatch" to the router loop.
-;; Using core.async means we can have the aysnc handling of events.
-;;
-(def ^:private event-chan (chan))    ;; TODO: set buffer size?
 
-(defn purge-chan
-  "read all pending events from the channel and drop them on the floor"
-  []
-  #_(loop []                          ;; TODO commented out until poll! is a part of the core.asyc API
-    (when (go (poll! event-chan))     ;; progress: https://github.com/clojure/core.async/commit/d8047c0b0ec13788c1092f579f03733ee635c493
-      (recur))))
-
-;; -- router loop ---------------------------------------------------------------------------------
+;; -- Router Loop ------------------------------------------------------------
 ;;
-;; In a perpetual loop, read events from "event-chan", and call the right handler.
+;; Conceptually, the task is to process events in a perpetual loop, one after
+;; the other, FIFO, calling the right event-handler for each. Being idle when
+;; ther are no events, and firing up when one arrived. Etc. The processing
+;; of events happens "asynchronously" sometime after an event is dispatched.
 ;;
-;; Because handlers occupy the CPU, before each event is handled, hand
-;; back control to the browser, via a (<! (yield)) call.
+;; In practice, 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 hand back control to
+;; the browser regularly, so it can redraw, process websockets, etc. But not
+;; too regularly!  If we are in a de-focused tab of the browser, then the 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.
 ;;
-;; In some cases, we need to pause for an entire animationFrame, to ensure that
-;; 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 (notice the ":flush-dom" metadata):
-;;   (dispatch ^:flush-dom  [:event-id other params])
+;; The original implementation of this router loop used core.async. It
+;; was fairly simple, and it mostly worked, but it did not give enough
+;; control. So now we hand-roll our own, mini finite-state-machine and all.
+;;
+;; The strategy is this:
+;;   - maintain a queue of `dispatched` events.
+;;   - when a new event arrives, "schedule" processing of this queue.
+;;   - when given a chance to process events, do ALL the
+;;     ones currently queued. Don't stop. Hog the CPU. Don't give control
+;;     back to the browser.
+;;   - but if any new events arrive during this processing run, don't do
+;;     them immediately. Yield first to the browser, and do these new events
+;;     in the next processing run.  That way we drain the queue, but we
+;;     never hog the CPU forever.  In particular, we handle the case
+;;     where handling one event will begat another event.
+;;   - In some cases, an event should not be run until after the GUI has been
+;;     updated. Ie. 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 block all further processing, because events are
+;;     processed sequentially. We must do one event before we can handle the
+;;     ones behind it.
+;;
+;; Implementation
+;;   - this queue can be in a few different states. So it is modeled explicitly
+;;     as a FSM. 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 :dom-flush we schedule via "reagent.impl.batching.doLater"
+;;     which will run after event processing after the next reagent animation frame.
 ;;
 
-(defn yield
-  "Yields control to the browser. Faster than (timeout 0).
-  See http://dev.clojure.org/jira/browse/ASYNC-137"
-  []
-  (let [ch (chan)]
-    (goog.async.nextTick #(close! ch))
-    ch))
+
+(defprotocol IEventQueue
+  (enqueue [this event])
+
+  ;; Finite State Machine transitions
+  (-fsm-trigger [this trigger arg])
+
+  ;; Finite State Machine (FSM) actions
+  (-add-event [this event])
+  (-process-1st-event [this])
+  (-run-next-tick [this])
+  (-run-queue [this])
+  (-pause-run [this])
+  (-exception [this ex])
+  (-resume-run [this]))
 
 
-(defn router-loop
-  []
-  (go-loop []
-           (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.
-                            (<! (yield)))]              ;; just in case we are handling one dispatch after an other, give the browser back control to do its stuff
-             (try
-               (handle event-v)
+(deftype EventQueue [^:mutable fsm-state ^:mutable queue]
+  IEventQueue
 
-               ;; If the handler throws:
-               ;;   - allow the exception to bubble up because the app, in production,
-               ;;     may have hooked window.onerror and perform special processing.
-               ;;   - But an exception which bubbles up will break the enclosing go-loop.
-               ;;     So we'll need to start another one.
-               ;;   - purge any pending events, because they are probably related to the
-               ;;     event which just fell in a screaming heap. Not sane to handle further
-               ;;     events if the prior event failed.
-               (catch js/Object e
-                 (do
-                   ;; try to recover from this (probably uncaught) error as best we can
-                   (purge-chan)        ;; get rid of any pending events
-                   (router-loop)       ;; Exception throw will cause termination of go-loop. So, start another.
+  (enqueue [this event]
+    (-fsm-trigger this :add-event event))
 
-                   (throw e)))))        ;; re-throw so the rest of the app's infrastructure (window.onerror?) gets told
-           (recur)))
+  ;; Finite State Machine "Actions"
+  (-add-event
+    [this event]
+    (set! queue (conj queue event)))
 
-;; start event processing
-(router-loop)
+  (-process-1st-event
+    [this]
+    (let [event-v (peek queue)]
+      (try
+        (handle event-v)
+        (catch :default ex
+          (-fsm-trigger this :exception ex)))
+      (set! queue (pop queue))))
+
+  (-run-next-tick
+    [this]
+    (goog.async.nextTick #(-fsm-trigger this :begin-run nil)))
+
+  (-exception
+    [_ ex]
+    (set! queue #queue [])     ;; purge the queue
+    (throw ex))
+
+  ;; 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]
+    (let [queue-length (count queue)]
+      (loop [n queue-length]
+        (if (zero? n)
+          (-fsm-trigger this :finish-run nil)
+          (let [event-v (peek queue)]
+            (if (some #{:flush-dom :yield} (keys (meta event-v)))
+              (-fsm-trigger this :pause-run nil)
+              (do (-process-1st-event this)
+                  (recur (dec n)))))))))
+
+  (-pause-run
+    [this]
+    (let [event-v (peek queue)
+          m       (meta event-v)
+          later   (cond
+                    (:flush-dom m) do-later                ;; after next annimation frame
+                    (:yield m)     goog.async.nextTick)]   ;; almost immediately
+      (later #(-fsm-trigger this :resume-run nil))))
+
+  (-resume-run
+    [this]
+    (-process-1st-event this)               ;; do the event which paused processing
+    (-fsm-trigger this :done-paused nil))   ;; do the rest of the queued events
+
+  (-fsm-trigger
+    [this trigger arg1]
+
+    ;; work out new FSM state and action function for the transition
+    (let [[new-state action-fn]
+          (condp = [fsm-state trigger]
+
+            ; Here is the FSM
+            ;[current-state :trigger]  [:new-state  action-fn]
+
+            [:quiescent :add-event] [:scheduled #(do (-add-event this arg1) (-run-next-tick this))]
+
+            ;; processing has been already been scheduled to run in the future
+            [:scheduled :add-event] [:scheduled #(-add-event this arg1)]
+            [:scheduled :begin-run] [:running   #(-run-queue this)]
+
+            ;; processing one event after another
+            [:running :add-event ]  [:running   #(-add-event this arg1)]
+            [:running :pause-run ]  [:paused    #(-pause-run this)]
+            [:running :exception ]  [:quiescent #(-exception this arg1)]
+            [:running :finish-run]  (if (empty? queue)       ;; FSM guard
+                                      [:quiescent]
+                                      [:scheduled  #(-run-next-tick this)])
+
+            ;; event processing is paused - probably by :flush-dom metadata
+            [:paused :add-event  ]  [:paused    #(-add-event this arg1)]
+            [:paused :resume-run ]  [:do-paused #(-resume-run this)]
+
+            ;; processing an event which previously caused the queue to be paused
+            [:do-paused :add-event  ] [:paused     #(-add-event this arg1)]
+            [:do-paused :exception  ] [:quiescent  #(-exception this arg1)]
+            [:do-paused :done-paused] [:running    #(-run-queue this)]
+
+            (throw (str "re-frame: state transition not found. " fsm-state " " trigger)))]
+
+      ;;  change state and run the action fucntion
+      (set! fsm-state new-state)
+      (when action-fn (action-fn)))))
+
+;; ---------------------------------------------------------------------------
+;; This is the global queue for events
+;; When an event is dispatched, it is put into this queue.  Later the queue
+;; will "run" and the event will be "handled" by the registered event handler.
+;;
+
+(def event-queue (->EventQueue :quiescent #queue []))
 
 
-;; -- dispatch ------------------------------------------------------------------------------------
+;; ---------------------------------------------------------------------------
+;; Dispatching
+;;
 
 (defn dispatch
   "Send an event to be processed by the registered handler.
@@ -85,9 +188,9 @@
   "
   [event-v]
   (if (nil? event-v)
-    (error "re-frame: \"dispatch\" is ignoring a nil event.")     ;; nil would close the channel
-    (put! event-chan event-v))
-  nil)   ;; Ensure nil return. See https://github.com/Day8/re-frame/wiki/Beware-Returning-False
+    (error "re-frame: \"dispatch\" is ignoring a nil event.") ;; nil would close the channel
+    (enqueue event-queue event-v))
+  nil)                                                      ;; Ensure nil return. See https://github.com/Day8/re-frame/wiki/Beware-Returning-False
 
 
 (defn dispatch-sync
@@ -98,6 +201,5 @@
      (dispatch-sync [:delete-item 42])"
   [event-v]
   (handle event-v)
-  nil)    ;; Ensure nil return. See https://github.com/Day8/re-frame/wiki/Beware-Returning-False
-
+  nil)                                                      ;; Ensure nil return. See https://github.com/Day8/re-frame/wiki/Beware-Returning-False