From cf525ea2aa3d84cebe06788a3d5bd5a9c4e0cd3f Mon Sep 17 00:00:00 2001 From: Igor Mandrigin Date: Tue, 20 Feb 2018 13:01:35 +0100 Subject: [PATCH] Add performance metrics. (#1) * Add performance metrics. * Tweak version of ClosureScript `(now)` to be compatible with Status. * Add enable/disable switch for debugging. --- project.clj | 2 +- src/re_frame/interop.cljs | 4 +- src/re_frame/router.cljc | 124 +++++++++++++++++++++++++++++++------- 3 files changed, 105 insertions(+), 25 deletions(-) diff --git a/project.clj b/project.clj index 031df4b..d673610 100644 --- 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"} diff --git a/src/re_frame/interop.cljs b/src/re_frame/interop.cljs index d01cf72..08a0537 100644 --- 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 diff --git a/src/re_frame/router.cljc b/src/re_frame/router.cljc index 4af3b5c..fc53c9a 100644 --- 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)) ;; ---------------------------------------------------------------------------