Add performance metrics. (#1)

* Add performance metrics. * Tweak version of ClosureScript `(now)` to be compatible with Status. * Add enable/disable switch for debugging.
2018-02-20 13:01:35 +01:00 · 2018-02-20 13:01:35 +01:00 · cf525ea2aa
parent bf0c2d6984
commit cf525ea2aa
3 changed files with 105 additions and 25 deletions
--- a/project.clj
+++ b/project.clj
@ -1,4 +1,4 @@
-(defproject dmitryn/re-frame-fork "0.10.2-1"
+(defproject dmitryn/re-frame-fork "0.10.2-2"
  :description  "A Clojurescript MVC-like Framework For Writing SPAs Using Reagent."
  :url          "https://github.com/Day8/re-frame.git"
  :license      {:name "MIT"}
--- a/src/re_frame/interop.cljs
+++ b/src/re_frame/interop.cljs
@ -38,9 +38,7 @@
  (js/setTimeout f ms))

 (defn now []
-  (if (exists? js/performance.now)
-    (js/performance.now)
-    (js/Date.now)))
+  (js/Date.now))

 (defn reagent-id
  "Produces an id for reactive Reagent values
--- a/src/re_frame/router.cljc
+++ b/src/re_frame/router.cljc
@ -1,6 +1,6 @@
 (ns re-frame.router
  (:require [re-frame.events  :refer [handle]]
-            [re-frame.interop :refer [after-render empty-queue next-tick]]
+            [re-frame.interop :refer [after-render empty-queue next-tick now]]
            [re-frame.loggers :refer [console]]
            [re-frame.trace   :as trace :include-macros true]))

@ -86,19 +86,30 @@
  (-exception [this ex])
  (-pause [this later-fn])
  (-resume [this])
-  (-call-post-event-callbacks [this event]))
+  (-call-post-event-callbacks [this event])
+
+  ;; -- Perf Metrics
+  (set-debug-enabled! [this val])
+  (-print-perf-queue-size-if-needed [this queue event-v])
+  (-print-tick-timings-if-needed [this before-tick-t])
+  (-print-perf-timings-if-needed [this before-exec-t scheduled-t after-exec-t event-v])
+  (-store-to-history [this event-name execution-t])
+  (-clear-history [this])
+  (-get-history [this]))


 ;; 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)]
+                     #?(:cljs ^:mutable history                 :clj ^:volatile-mutable history)
+                     #?(:cljs ^:mutable post-event-callback-fns :clj ^:volatile-mutable post-event-callback-fns)
+                     #?(:cljs ^:mutable is-debug-enabled        :clj ^:volatile-mutable is-debug-enabled)]
  IEventQueue

  ;; -- API ------------------------------------------------------------------

  (push [this event]         ;; presumably called by dispatch
-    (-fsm-trigger this :add-event event))
+    (-fsm-trigger this :add-event [event (now)]))

  ;; register a callback function which will be called after each event is processed
  (add-post-event-callback [_ id callback-fn]
@ -165,18 +176,23 @@
        (when action-fn (action-fn)))))

  (-add-event
-    [_ event]
-    (set! queue (conj queue event)))
+    [this event]
+    (set! queue (conj queue event))
+    (-print-perf-queue-size-if-needed this 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)
+    (let [event-time (peek queue)]
+      (let [event-v (first event-time) scheduled-t (last event-time)]
+        (try
+          (let [before-exec-t (now)]
+            (handle event-v)
+            (-print-perf-timings-if-needed this before-exec-t scheduled-t (now) event-v)
+
+            (set! queue (pop queue))
+            (-call-post-event-callbacks this event-v))
        (catch #?(:cljs :default :clj Exception) ex
-          (-fsm-trigger this :exception ex)))))
+          (-fsm-trigger this :exception ex))))))

  (-run-next-tick
    [this]
@ -186,13 +202,17 @@
  ;; 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)))))))
+
+    (let [before-tick-t (now)]
+      (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))))))
+      (-print-tick-timings-if-needed this before-tick-t))
+    (-store-to-history this "===NEW-TICK===" 0))

  (-exception
    [_ ex]
@ -211,7 +231,69 @@
  (-resume
    [this]
    (-process-1st-event-in-queue this)  ;; do the event which paused processing
-    (-run-queue this)))                 ;; do the rest of the queued events
+    (-run-queue this))                 ;; do the rest of the queued events
+
+
+  ;; Throughput measuring methods
+  ;; Should be used for debugging
+  (set-debug-enabled!
+    [this val]
+    (set! is-debug-enabled val))
+
+
+  (-print-tick-timings-if-needed
+    [this before-tick-t]
+    (if (and is-debug-enabled (> (- (now) before-tick-t) 300))
+      (println "[DEBUG / RE-FRAME-PERF]"
+               "TICK TOOK TOO LONG:"  (- (now) before-tick-t) "ms."
+               "TICK HISTORY (newest at the top)***\n"
+               (-get-history this)
+               "\n***TICK HISTORY")))
+
+  (-print-perf-timings-if-needed
+    [this before-exec-t scheduled-t after-exec-t event-v]
+    (if is-debug-enabled
+      (let [execution-t (- after-exec-t before-exec-t)
+            throughput-t (- after-exec-t scheduled-t)
+            event-name (first event-v)]
+        (-store-to-history this event-name execution-t)
+        (if (> execution-t 100)
+          (println "[DEBUG / RE-FRAME-PERF]"
+                   "QUEUE ITEM EXECUTION TIME IS > 100ms:" execution-t "ms."
+                   "EVENT" event-name))
+        (if (> throughput-t 300)
+          (println "[DEBUG / RE-FRAME-PERF]"
+                   "QUEUE THROUGHPUT TIME IS > 300ms:" throughput-t "ms."
+                   "EVENT" event-name
+                   "TICK HISTORY (newest at the top)***\n"
+                   (-get-history this)
+                   "\n***TICK HISTORY")))))
+
+  (-print-perf-queue-size-if-needed
+    [this queue event-v]
+    (if is-debug-enabled
+      (let [qcount (count queue)]
+        (if (> qcount 10)
+          (println "[DEBUG / RE-FRAME-PERF]"
+                   "QUEUE HAS GROWN TOO MUCH:" qcount
+                   "CURRENT EVENT:" (first event-v))))))
+
+  (-store-to-history
+    [this event-name execution-t]
+    (if is-debug-enabled
+      (do
+        (set! history (conj history [event-name execution-t]))
+        (if (> (count history) 100)
+          (set! history (pop history))))))
+
+  (-clear-history
+    [this]
+    (set! history empty-queue))
+
+  ;; Stringified, newest to oldest
+  (-get-history
+    [this]
+    (clojure.string/join "\n" (reverse history))))


 ;; ---------------------------------------------------------------------------
@ -219,7 +301,7 @@
 ;; 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 {}))
+(def event-queue (->EventQueue :idle empty-queue empty-queue {} false))


 ;; ---------------------------------------------------------------------------