From 50e87fd5a6d4c734ff70fec8ab1a0cd5c91d04c2 Mon Sep 17 00:00:00 2001
From: Daniel Compton <desk@danielcompton.net>
Date: Thu, 24 Nov 2016 17:04:29 +1300
Subject: [PATCH] Trace re-frame event lifecycle

Trace subs, FSM, events
Add tests for basic behaviour
---
 .idea/codeStyleSettings.xml    |  2 +
 src/re_frame/events.cljc       |  8 +++-
 src/re_frame/router.cljc       | 66 ++++++++++++++-------------
 src/re_frame/subs.cljc         | 82 +++++++++++++++++++++++++---------
 src/re_frame/trace.cljc        | 20 +++++----
 src/re_frame/utils.cljc        | 15 ++++++-
 test/re-frame/test_runner.cljs |  9 ++--
 test/re-frame/trace_test.cljs  | 33 ++++++++++++++
 8 files changed, 168 insertions(+), 67 deletions(-)
 create mode 100644 test/re-frame/trace_test.cljs

diff --git a/.idea/codeStyleSettings.xml b/.idea/codeStyleSettings.xml
index 6661aef..3654bba 100644
--- a/.idea/codeStyleSettings.xml
+++ b/.idea/codeStyleSettings.xml
@@ -6,6 +6,8 @@
         <ClojureCodeStyleSettings>{
   :cljs.core/with-redefs 1
   :cursive.formatting/align-binding-forms true
+  :re-frame.trace/register-trace-cb :only-indent
+  :re-frame.trace/with-trace 1
 }</ClojureCodeStyleSettings>
         <XML>
           <option name="XML_LEGACY_SETTINGS_IMPORTED" value="true" />
diff --git a/src/re_frame/events.cljc b/src/re_frame/events.cljc
index 1b3ee45..1808914 100644
--- a/src/re_frame/events.cljc
+++ b/src/re_frame/events.cljc
@@ -4,7 +4,8 @@
             [re-frame.interop     :refer [empty-queue debug-enabled?]]
             [re-frame.registrar   :refer [get-handler register-handler]]
             [re-frame.loggers     :refer [console]]
-            [re-frame.interceptor :as  interceptor]))
+            [re-frame.interceptor :as  interceptor]
+            [re-frame.trace       :as trace :include-macros true]))
 
 
 (def kind :event)
@@ -56,6 +57,9 @@
       (if *handling*
         (console :error (str "re-frame: while handling \"" *handling* "\", dispatch-sync was called for \"" event-v "\". You can't call dispatch-sync within an event handler."))
         (binding [*handling*  event-v]
-          (interceptor/execute event-v interceptors))))))
+          (trace/with-trace {:operation event-id
+                             :op-type   kind
+                             :tags      {:event event-v}}
+            (interceptor/execute event-v interceptors)))))))
 
 
diff --git a/src/re_frame/router.cljc b/src/re_frame/router.cljc
index b9a691e..f56b641 100644
--- a/src/re_frame/router.cljc
+++ b/src/re_frame/router.cljc
@@ -1,7 +1,8 @@
 (ns re-frame.router
   (:require [re-frame.events  :refer [handle]]
             [re-frame.interop :refer [after-render empty-queue next-tick]]
-            [re-frame.loggers :refer [console]]))
+            [re-frame.loggers :refer [console]]
+            [re-frame.trace   :as trace :include-macros true]))
 
 
 ;; -- Router Loop ------------------------------------------------------------
@@ -122,41 +123,46 @@
     ;; Given a "trigger", and the existing FSM state, it computes the
     ;; new FSM state and the transition action (function).
 
-    (let [[new-fsm-state action-fn]
-          (case [fsm-state trigger]
+    (trace/with-trace {:op-type ::fsm-trigger}
+      (let [[new-fsm-state action-fn]
+            (case [fsm-state trigger]
 
-            ;; You should read the following "case" as:
-            ;; [current-FSM-state trigger] -> [new-FSM-state action-fn]
-            ;;
-            ;; So, for example, the next line should be interpreted as:
-            ;; if you are in state ":idle" and a trigger ":add-event"
-            ;; happens, then move the FSM to state ":scheduled" and execute
-            ;; that two-part "do" function.
-            [:idle :add-event] [:scheduled #(do (-add-event this arg)
-                                                (-run-next-tick this))]
+              ;; You should read the following "case" as:
+              ;; [current-FSM-state trigger] -> [new-FSM-state action-fn]
+              ;;
+              ;; So, for example, the next line should be interpreted as:
+              ;; if you are in state ":idle" and a trigger ":add-event"
+              ;; happens, then move the FSM to state ":scheduled" and execute
+              ;; that two-part "do" function.
+              [:idle :add-event] [:scheduled #(do (-add-event this arg)
+                                                  (-run-next-tick this))]
 
-            ;; State: :scheduled  (the queue is scheduled to run, soon)
-            [:scheduled :add-event] [:scheduled #(-add-event this arg)]
-            [:scheduled :run-queue] [:running   #(-run-queue this)]
+              ;; State: :scheduled  (the queue is scheduled to run, soon)
+              [:scheduled :add-event] [:scheduled #(-add-event this arg)]
+              [:scheduled :run-queue] [:running #(-run-queue this)]
 
-            ;; State: :running (the queue is being processed one event after another)
-            [:running :add-event ] [:running  #(-add-event this arg)]
-            [:running :pause     ] [:paused   #(-pause this arg)]
-            [:running :exception ] [:idle     #(-exception this arg)]
-            [:running :finish-run] (if (empty? queue)       ;; FSM guard
-                                     [:idle]
-                                     [:scheduled #(-run-next-tick this)])
+              ;; State: :running (the queue is being processed one event after another)
+              [:running :add-event] [:running #(-add-event this arg)]
+              [:running :pause] [:paused #(-pause this arg)]
+              [:running :exception] [:idle #(-exception this arg)]
+              [:running :finish-run] (if (empty? queue)     ;; FSM guard
+                                       [:idle]
+                                       [:scheduled #(-run-next-tick this)])
 
-            ;; State: :paused (:flush-dom metadata on an event has caused a temporary pause in processing)
-            [:paused :add-event] [:paused  #(-add-event this arg)]
-            [:paused :resume   ] [:running #(-resume this)]
+              ;; State: :paused (:flush-dom metadata on an event has caused a temporary pause in processing)
+              [:paused :add-event] [:paused #(-add-event this arg)]
+              [:paused :resume] [:running #(-resume this)]
 
-            (throw (ex-info (str "re-frame: router state transition not found. " fsm-state " " trigger)
-                            {:fsm-state fsm-state, :trigger trigger})))]
+              (throw (ex-info (str "re-frame: router state transition not found. " fsm-state " " trigger)
+                              {:fsm-state fsm-state, :trigger trigger})))]
 
-      ;; The "case" above computed both the new FSM state, and the action. Now, make it happen.
-      (set! fsm-state new-fsm-state)
-      (when action-fn (action-fn))))
+        ;; The "case" above computed both the new FSM state, and the action. Now, make it happen.
+
+        (trace/merge-trace! {:operation [fsm-state trigger]
+                             :tags      {:current-state fsm-state
+                                         :new-state     new-fsm-state}})
+        (set! fsm-state new-fsm-state)
+        (when action-fn (action-fn)))))
 
   (-add-event
     [_ event]
diff --git a/src/re_frame/subs.cljc b/src/re_frame/subs.cljc
index 76ed474..352e4be 100644
--- a/src/re_frame/subs.cljc
+++ b/src/re_frame/subs.cljc
@@ -3,9 +3,9 @@
    [re-frame.db        :refer [app-db]]
    [re-frame.interop   :refer [add-on-dispose! debug-enabled? make-reaction ratom? deref? dispose!]]
    [re-frame.loggers   :refer [console]]
-   [re-frame.utils     :refer [first-in-vector]]
-   [re-frame.registrar :refer [get-handler clear-handlers register-handler]]))
-
+   [re-frame.utils     :refer [first-in-vector reagent-id]]
+   [re-frame.registrar :refer [get-handler clear-handlers register-handler]]
+   [re-frame.trace     :as trace :include-macros true]))
 
 (def kind :sub)
 (assert (re-frame.registrar/kinds kind))
@@ -47,9 +47,14 @@
   (let [cache-key [query-v dynv]]
     ;; when this reaction is no longer being used, remove it from the cache
     (add-on-dispose! r #(do (swap! query->reaction dissoc cache-key)
-                            #_(console :log "Removing subscription:" cache-key)))
+                            (trace/with-trace {:operation (first-in-vector query-v)
+                                               :op-type   :sub/dispose
+                                               :tags      {:query-v  query-v
+                                                           :reaction (reagent-id r)}}
+                              nil)))
     ;; cache this reaction, so it can be used to deduplicate other, later "=" subscriptions
     (swap! query->reaction assoc cache-key r)
+    (trace/merge-trace! {:tags {:reaction (reagent-id r)}})
     r))  ;; return the actual reaction
 
 (defn cache-lookup
@@ -64,33 +69,48 @@
 (defn subscribe
   "Returns a Reagent/reaction which contains a computation"
   ([query-v]
+   (trace/with-trace {:operation (first-in-vector query-v)
+                      :op-type   :sub/create
+                      :tags      {:query-v query-v}}
    (if-let [cached (cache-lookup query-v)]
-     (do ;(console :log "Using cached subscription: " query-v)
+       (do
+         (trace/merge-trace! {:tags {:cached?  true
+                                     :reaction (reagent-id cached)}})
          cached)
+
      (let [query-id   (first-in-vector query-v)
            handler-fn (get-handler kind query-id)]
-       ;(console :log "Subscription created: " query-v)
+       (trace/merge-trace! {:tags {:cached? false}})
        (if (nil? handler-fn)
-         (console :error (str "re-frame: no subscription handler registered for: \"" query-id "\". Returning a nil subscription."))
-         (cache-and-return query-v [] (handler-fn app-db query-v))))))
+         (do (trace/merge-trace! {:error true})
+             (console :error (str "re-frame: no subscription handler registered for: \"" query-id "\". Returning a nil subscription.")))
+         (cache-and-return query-v [] (handler-fn app-db query-v)))))))
 
   ([v dynv]
+   (trace/with-trace {:operation (first-in-vector v)
+                      :op-type   :sub/create
+                      :tags      {:query-v v
+                                  :dyn-v   dynv}}
    (if-let [cached (cache-lookup v dynv)]
-     (do ;(console :log "Using cached subscription: " v " and " dynv)
+       (do
+         (trace/merge-trace! {:tags {:cached?  true
+                                     :reaction (reagent-id cached)}})
          cached)
      (let [query-id   (first-in-vector v)
            handler-fn (get-handler kind query-id)]
+         (trace/merge-trace! {:tags {:cached? false}})
        (when debug-enabled?
          (when-let [not-reactive (not-empty (remove ratom? dynv))]
            (console :warn "re-frame: your subscription's dynamic parameters that don't implement IReactiveAtom:" not-reactive)))
-       (if (nil? handler-fn)
+         (when-not handler-fn
+           (trace/merge-trace! {:error true})
          (console :error (str "re-frame: no subscription handler registered for: \"" query-id "\". Returning a nil subscription."))
          (let [dyn-vals (make-reaction (fn [] (mapv deref dynv)))
-               sub (make-reaction (fn [] (handler-fn app-db v @dyn-vals)))]
+                 sub      (make-reaction (fn [] (handler-fn app-db v @dyn-vals)))]
            ;; handler-fn returns a reaction which is then wrapped in the sub reaction
            ;; need to double deref it to get to the actual value.
            ;(console :log "Subscription created: " v dynv)
-           (cache-and-return v dynv (make-reaction (fn [] @@sub)))))))))
+             (cache-and-return v dynv (make-reaction (fn [] @@sub))))))))))
 
 ;; -- reg-sub -----------------------------------------------------------------
 
@@ -105,11 +125,13 @@
 
 (defn- deref-input-signals
   [signals query-id]
-  (cond
+  (let [signals (cond
     (sequential? signals) (map deref signals)
-    (map? signals)        (map-vals deref signals)
-    (deref? signals)      @signals
-    :else (console :error "re-frame: in the reg-sub for " query-id ", the input-signals function returns: " signals)))
+                  (map? signals) (map-vals deref signals)
+                  (deref? signals) @signals
+                  :else (console :error "re-frame: in the reg-sub for " query-id ", the input-signals function returns: " signals))]
+    (trace/merge-trace! {:tags {:input-signals (map reagent-id signals)}})
+    signals))
 
 
 (defn reg-sub
@@ -178,10 +200,26 @@
       query-id
       (fn subs-handler-fn
         ([db query-vec]
-         (let [subscriptions (inputs-fn query-vec)]
-           (make-reaction
-             (fn [] (computation-fn (deref-input-signals subscriptions query-id) query-vec)))))
+         (let [subscriptions (inputs-fn query-vec)
+               reaction-id   (atom nil)
+               reaction      (make-reaction
+                               (fn [] (trace/with-trace {:operation (first-in-vector query-vec)
+                                                         :op-type   :sub/run
+                                                         :tags      {:query-v  query-vec
+                                                                     :reaction @reaction-id}}
+                                        (computation-fn (deref-input-signals subscriptions query-id) query-vec))))]
+           (reset! reaction-id (reagent-id reaction))
+           reaction))
         ([db query-vec dyn-vec]
-         (let [subscriptions (inputs-fn query-vec dyn-vec)]
-           (make-reaction
-             (fn [] (computation-fn (deref-input-signals subscriptions query-id) query-vec dyn-vec)))))))))
+         (let [subscriptions (inputs-fn query-vec dyn-vec)
+               reaction-id   (atom nil)
+               reaction      (make-reaction
+                               (fn []
+                                 (trace/with-trace {:operation (first-in-vector query-vec)
+                                                    :op-type   :sub/run
+                                                    :tags      {:query-v  query-vec
+                                                                :dyn-v    dyn-vec
+                                                                :reaction @reaction-id}}
+                                   (computation-fn (deref-input-signals subscriptions query-id) query-vec dyn-vec))))]
+           (reset! reaction-id (reagent-id reaction))
+           reaction))))))
diff --git a/src/re_frame/trace.cljc b/src/re_frame/trace.cljc
index 0e31da3..bab71e8 100644
--- a/src/re_frame/trace.cljc
+++ b/src/re_frame/trace.cljc
@@ -1,6 +1,8 @@
 (ns re-frame.trace
-  "Tracing for re-frame."
+  "Tracing for re-frame.
+  Alpha quality, subject to change/break at any time."
   (:require [re-frame.interop :as interop]
+            [re-frame.loggers :refer [console]]
             [clojure.string :as str]))
 
 
@@ -25,20 +27,20 @@
 (defn start-trace [{:keys [operation op-type tags child-of]}]
   {:id        (next-id)
    :operation operation
-   :type      op-type
+   :op-type   op-type
    :tags      tags
    :child-of  (or child-of (:id *current-trace*))
    :start     (interop/now)})
 
 (defn finish-trace [trace]
   (let [end        (interop/now)
-        duration   (- end (:start trace))
-        add-trace? (not (str/includes? (or (get-in trace [:tags :component-path]) "") "todomvc.views.devtools"))]
-    (when add-trace?
-      (doseq [cb (vals @trace-cbs)]
-        (cb [(assoc trace
-               :duration duration
-               :end (interop/now))])))))
+        duration   (- end (:start trace))]
+    (doseq [[k cb] @trace-cbs]
+      (try (cb [(assoc trace
+                  :duration duration
+                  :end (interop/now))])
+           (catch #?(:cljs :default :clj Exception) e
+             (console :error "Error thrown from trace cb" k "while storing" trace e))))))
 
 #?(:clj (defmacro with-trace
           "Create a trace inside the scope of the with-trace macro
diff --git a/src/re_frame/utils.cljc b/src/re_frame/utils.cljc
index 0ab6473..b5ef137 100644
--- a/src/re_frame/utils.cljc
+++ b/src/re_frame/utils.cljc
@@ -1,6 +1,7 @@
 (ns re-frame.utils
   (:require
-    [re-frame.loggers :refer [console]]))
+    [re-frame.loggers :refer [console]]
+    [reagent.ratom :as ratom]))
 
 
 (defn first-in-vector
@@ -9,3 +10,15 @@
     (first v)
     (console :error "re-frame: expected a vector, but got:" v)))
 
+(defn reagent-id
+  "Produces an id for reactive Reagent values
+  e.g. reactions, ratoms, cursors."
+  [reactive-val]
+  #?(:cljs (when (implements? ratom/IReactiveAtom reactive-val)
+             (str (condp instance? reactive-val
+                    ratom/RAtom "ra"
+                    ratom/RCursor "rc"
+                    ratom/Reaction "rx"
+                    ratom/Track "tr"
+                    "other")
+                  (hash reactive-val)))))
diff --git a/test/re-frame/test_runner.cljs b/test/re-frame/test_runner.cljs
index 74e6c66..7083d34 100644
--- a/test/re-frame/test_runner.cljs
+++ b/test/re-frame/test_runner.cljs
@@ -6,7 +6,8 @@
     ;; Test Namespaces -------------------------------
     [re-frame.interceptor-test]
     [re-frame.subs-test]
-    [re-frame.fx-test]))
+    [re-frame.fx-test]
+    [re-frame.trace-test]))
 
 (enable-console-print!)
 
@@ -19,7 +20,8 @@
   (cljs-test/run-tests
     're-frame.interceptor-test
     're-frame.subs-test
-    're-frame.fx-test))
+    're-frame.fx-test
+    're-frame.trace-test))
 
 ;; ---- KARMA  -----------------------------------------------------------------
 
@@ -28,4 +30,5 @@
     karma
     're-frame.interceptor-test
     're-frame.subs-test
-    're-frame.fx-test))
+    're-frame.fx-test
+    're-frame.trace-test))
diff --git a/test/re-frame/trace_test.cljs b/test/re-frame/trace_test.cljs
new file mode 100644
index 0000000..72037d5
--- /dev/null
+++ b/test/re-frame/trace_test.cljs
@@ -0,0 +1,33 @@
+(ns re-frame.trace-test
+  (:require [cljs.test :as test :refer-macros [is deftest]]
+            [re-frame.trace :as trace :include-macros true]
+            [re-frame.core :as rf]))
+
+(def test-traces (atom []))
+
+(test/use-fixtures :once {:before (fn []
+                                    (trace/register-trace-cb :test
+                                      (fn [traces]
+                                        (doseq [trace traces]
+                                          (swap! test-traces conj trace)))))
+                          :after  (fn []
+                                    (trace/remove-trace-cb :test))})
+
+(test/use-fixtures :each {:before (fn []
+                                    (reset! test-traces [])
+                                    (trace/reset-tracing!))})
+
+(deftest trace-cb-test
+  (trace/with-trace {:operation :test1
+                     :op-type   :test})
+  (is (= 1 (count @test-traces)))
+  (is (= (select-keys (first @test-traces) [:id :operation :op-type :tags])
+         {:id 1 :operation :test1 :op-type :test :tags nil})))
+
+(enable-console-print!)
+
+(deftest sub-trace-test
+  (rf/subscribe [:non-existence])
+  (is (= 1 (count @test-traces)))
+  (is (= (select-keys (first @test-traces) [:id :operation :op-type :error])
+         {:id 1 :op-type :sub/create :operation :non-existence :error true})))