status-im
/
re-frame-10x
mirror of https://github.com/status-im/re-frame-10x.git
2
0
Fork 0
Code Issues Projects Releases Wiki Activity

Parse the event stream

This commit is contained in:
Daniel Compton 2018-01-11 16:26:55 +13:00
parent 6f16a7cd61
commit 3c80acd9db
9 changed files with 245 additions and 178 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitignore vendored
View File

@ -19,4 +19,3 @@ misc/
.flooignore
node_modules/
examples/todomvc/.idea/
test-resources/*.edn

29
src/day8/re_frame/trace.cljs
View File

@ -77,7 +77,7 @@
(defonce real-custom-wrapper reagent.impl.component/custom-wrapper)
(defonce real-next-tick reagent.impl.batching/next-tick)
(defonce real-schedule reagent.impl.batching/schedule)
(defonce schedule-fn-scheduled? (atom false))
(defonce do-after-render-trace-scheduled? (atom false))
(defn monkey-patch-reagent []
(let [#_#_real-renderer reagent.impl.component/do-render
@ -112,18 +112,39 @@
(set! reagent.impl.batching/next-tick
(fn [f]
;; Schedule a trace to be emitted after a render if there is nothing else scheduled after that render.
;; This signals the end of the epoch.
#_ (swap! do-after-render-trace-scheduled?
(fn [scheduled?]
(js/console.log "Setting up scheduled after" scheduled?)
(if scheduled?
scheduled?
(do (reagent.impl.batching/do-after-render ;; a do-after-flush would probably be a better spot to put this if it existed.
(fn []
(js/console.log "Do after render" reagent.impl.batching/render-queue)
(reset! do-after-render-trace-scheduled? false)
(when (false? (.-scheduled? reagent.impl.batching/render-queue))
(trace/with-trace {:op-type :reagent/quiescent}))))
true))))
(real-next-tick (fn []
(trace/with-trace {:op-type :raf}
(f)
(trace/with-trace {:op-type :raf-end}))))))
(trace/with-trace {:op-type :raf-end})
(js/console.log "Do after render" reagent.impl.batching/render-queue)
(js/console.log "Component queue" (.-componentQueue reagent.impl.batching/render-queue) "after render" (.-afterRender reagent.impl.batching/render-queue))
(when (false? (.-scheduled? reagent.impl.batching/render-queue))
(trace/with-trace {:op-type :reagent/quiescent}))
)))))
#_(set! reagent.impl.batching/schedule
(fn []
(reagent.impl.batching/do-after-render
(fn []
(when @schedule-fn-scheduled?
(when @do-after-render-trace-scheduled?
(trace/with-trace {:op-type :do-after-render})
(reset! schedule-fn-scheduled? false))))
(reset! do-after-render-trace-scheduled? false))))
(real-schedule)))))

273
src/day8/re_frame/trace/metamorphic.cljc
View File

@ -1,121 +1,194 @@
(ns day8.re-frame.trace.metamorphic
(:require [metamorphic.api :as m]
[metamorphic.runtime :as rt]
#?(:clj
#?(:clj
[metamorphic.viz :as v])))
;; Next, we define predicate functions that take exactly 4 arguments.
;; These predicates are obviously incredibly boring, but they help
;; save your brain power for the real concepts.
;; What starts an epoch?
;; Each predicate will receive each event as it arrives, a history (which we'll discuss later),
;; the entire pattern sequence, and the particular pattern that this predicate
;; is being used in. This is helpful for parameterizing a predicate.
;;; idle -> dispatch -> running
;;; running -> dispatch -> handling new event
(defn a? [event history pattern-sequence pattern]
(= event "a"))
;; What ends an epoch?
(defn b? [event history pattern-sequence pattern]
(= event "b"))
;;; the start of a new epoch
;;; a Reagent animation frame ending AND nothing else being scheduled
(defn c? [event history pattern-sequence pattern]
(= event "c"))
;; Now let's create a pattern sequence. We're looking for "a", "b", then "c".
;; This pattern says: find "a", then immediately look for "b". After you find "b",
;; look for "c", but if there's something that doesn't match in the middle, that's
;; okay. The relaxation of looking for "c" is called a contiguity constraint, denoted
;; by "followed-by" instead of "next".
(defn run-test []
(let [runtime (-> (m/new-pattern-sequence "a b c")
(m/begin "a" a?)
(m/next "b" b?)
(m/followed-by "c" c?)
(rt/initialize-runtime))
events ["a" "b" "q" "c" "z" "a" "b" "d" "x" "c"]]
(:matches (reduce rt/evaluate-event runtime events))))
;; Slight wrinkles
;;; Any renders that run between epochs deserve their own epoch really.
;;; Dispatch-sync's
;;;
(defn new-epoch-started? [event history pattern-sequence pattern]
(and (= :re-frame.router/fsm-trigger (:op-type event))
;
;(defn add-event-from-idle? [event history pattern-sequence pattern]
; #_(println @history event)
;
; (and (= :re-frame.router/fsm-trigger (:op-type event))
; (= (:operation event)
; [:idle :add-event])))
;
;(defn event-run? [event history pattern-sequence pattern]
; (= :event (:op-type event)))
;
;(defn epoch-started? [event history pattern-sequence pattern]
; (or (add-event-from-idle? event history pattern-sequence pattern)
; (and (event-run? event history pattern-sequence pattern)
; (empty? @history))))
;
(defn fsm-trigger? [event]
(= :re-frame.router/fsm-trigger (:op-type event)))
;
;(defn redispatched-event? [event history pattern-sequence pattern]
; (and (fsm-trigger? event)
; (= (:operation event)
; [:running :add-event])))
;
;(defn router-scheduled? [event history pattern-sequence pattern]
; (and (fsm-trigger? event)
; (= (:operation event)
; [:running :finish-run])
; (= :running (get-in event [:tags :current-state]))
; (= :scheduled (get-in event [:tags :new-state]))))
;
;(defn router-finished? [event history pattern-sequence pattern]
; (and (fsm-trigger? event)
; (= (:operation event)
; [:running :finish-run])
; (= :running (get-in event [:tags :current-state]))
; (= :idle (get-in event [:tags :new-state]))))
;
;(defn quiescent? [event _ _ _]
; (= :reagent/quiescent (:op-type event)))
;
;(defn epoch-ended? [event history pattern-sequence pattern]
; (or (quiescent? event history pattern-sequence pattern)
; (epoch-started? event history pattern-sequence pattern)))
;
(defn run-queue? [event]
(and (fsm-trigger? event)
(= (:operation event)
[:idle :add-event])))
(defn event-run? [event history pattern-sequence pattern]
(= :event (:op-type event)))
(defn redispatched-event? [event history pattern-sequence pattern]
(and (= :re-frame.router/fsm-trigger (:op-type event))
(= (:operation event)
[:running :add-event])))
(defn router-scheduled? [event history pattern-sequence pattern]
(and (= :re-frame.router/fsm-trigger (:op-type event))
(= (:operation event)
[:running :finish-run])
(= :running (get-in event [:tags :current-state]))
(= :scheduled (get-in event [:tags :new-state]))))
(defn router-finished? [event history pattern-sequence pattern]
(and (= :re-frame.router/fsm-trigger (:op-type event))
(= (:operation event)
[:running :finish-run])
(= :running (get-in event [:tags :current-state]))
(= :idle (get-in event [:tags :new-state]))))
(defn request-animation-frame? [event history pattern-sequence pattern]
(= :raf (:op-type event)))
(defn request-animation-frame-end? [event history pattern-sequence pattern]
(= :raf-end (:op-type event)))
#?(:clj (defn trace-events [] (->> (slurp "test-resources/events2.edn")
(clojure.edn/read-string {:readers {'utc identity
'object (fn [x] "<object>")}})
(sort-by :id))))
[:scheduled :run-queue])))
;
;(defn request-animation-frame? [event history pattern-sequence pattern]
; (= :raf (:op-type event)))
;
;(defn request-animation-frame-end? [event history pattern-sequence pattern]
; (= :raf-end (:op-type event)))
;
(defn summarise-event [ev]
(dissoc ev :start :duration :end :child-of))
(defn summarise-match [match]
(map summarise-event match))
;
(defn beginning-id [match]
(:id (first match)))
#?(:clj
(defn parse-events []
#_ (let [runtime (-> (m/new-pattern-sequence "simple traces")
(m/begin "new-epoch-started" new-epoch-started?)
#_(m/followed-by "redispatched-event" redispatched-event? {:optional? true})
#_(m/followed-by "router-scheduled" router-scheduled? {:optional? true})
(m/followed-by "event-run" event-run?)
(m/followed-by "router-finished" router-finished?)
(m/followed-by "raf" request-animation-frame?)
(m/followed-by "raf-end" request-animation-frame-end?)
(rt/initialize-runtime))
events (trace-events)
rt (reduce rt/evaluate-event runtime events)]
#_(println "Count"
(count (:matches rt))
(map count (:matches rt)))
(map summarise-match (:matches rt)))))
(defn ending-id [match]
(:id (last match)))
;
;(defn parse-traces-metam
; "Returns a metamorphic runtime"
; [traces]
; (let [runtime (-> (m/new-pattern-sequence "simple traces")
; (m/begin "new-epoch-started" epoch-started?)
; #_(m/followed-by "run-queue" run-queue? {:optional? true})
; ;(m/followed-by "event-run" event-run?)
; #_(m/followed-by "router-finished" router-finished?)
; ;(m/followed-by "raf" request-animation-frame?)
; ;(m/followed-by "raf-end" request-animation-frame-end?)
; (m/followed-by "epoch-ended" epoch-ended?)
; (rt/initialize-runtime))
; rt (reduce rt/evaluate-event runtime traces)]
; #_(println "Count"
; (count (:matches rt))
; (map count (:matches rt)))
; #_(map summarise-match (:matches rt))
; rt))
(defn parse-traces
"Returns a metamorphic runtime"
[traces]
(let [runtime (-> (m/new-pattern-sequence "simple traces")
(m/begin "new-epoch-started" new-epoch-started?)
(m/followed-by "event-run" event-run?)
(m/followed-by "router-finished" router-finished?)
(m/followed-by "raf" request-animation-frame?)
(m/followed-by "raf-end" request-animation-frame-end?)
(rt/initialize-runtime))
rt (reduce rt/evaluate-event runtime traces)]
#_(println "Count"
(count (:matches rt))
(map count (:matches rt)))
#_(map summarise-match (:matches rt))
rt))
;;;;;;
;; TODO: this needs to be included too as a starting point.
(defn add-event-from-idle? [event]
(and (= :re-frame.router/fsm-trigger (:op-type event))
(= (:operation event)
[:idle :add-event])))
(defn event-run? [event]
(= :event (:op-type event)))
(defn start-of-epoch?
"Detects the start of a re-frame epoch
Normally an epoch would always start with the queue being run, but with a dispatch-sync, the event is run directly."
[event]
(or (run-queue? event)
(event-run? event)))
(defn start-of-epoch-and-prev-end?
"Detects that a new epoch has started and that the previous one ended on the previous event.
If multiple events are dispatched while processing the first event, each one is considered its
own epoch."
[event state]
(or (run-queue? event)
;; An event ran, and the previous event was not
;; a run-queue.
(and (event-run? event)
(not (run-queue? (:previous-event state))))))
(defn quiescent? [event]
(= :reagent/quiescent (:op-type event)))
(defn parse-traces [traces]
(let [partitions (reduce
(fn [state event]
(let [current-match (:current-match state)
previous-event (:previous-event state)
no-match? (nil? current-match)]
(-> (cond
;; No current match yet, check if this is the start of an epoch
no-match?
(if (start-of-epoch? event)
(assoc state :current-match [event])
state)
;; We are in an epoch match, and reagent has gone to a quiescent state
(quiescent? event)
(-> state
(update :partitions conj (conj current-match event))
(assoc :current-match nil))
;; We are in an epoch match, and we have started a new epoch
;; The previously seen event was the last event of the old epoch,
;; and we need to start a new one from this event.
(start-of-epoch-and-prev-end? event state)
(-> state
(update :partitions conj (conj current-match previous-event))
(assoc :current-match [event]))
(event-run? event)
(update state :current-match conj event)
:else
state
;; Add a timeout/warning if a match goes on for more than a second?
)
(assoc :previous-event event))))
{:current-match nil
:previous-event nil
:partitions []}
traces)
matches (:partitions partitions)]
#?(:cljs (js/console.log "Partitions:" partitions))
{:matches matches}))
(defn matched-event [match]
(->> match
(filter event-run?)
(first)))

4
src/day8/re_frame/trace/styles.cljs
View File

@ -308,7 +308,9 @@
[:span.event-header {:color common/text-color
:background-color common/standard-background-color
:padding (px 5)
:font-weight "600"}]
:font-weight "600"
;; TODO: figure out how to hide long events
:text-overflow "ellipsis"}]
]
[(s/& :.external-window) {:display "flex"
:height (percent 100)

1
src/day8/re_frame/trace/view/debug.cljs
View File

@ -14,6 +14,7 @@
[rc/label :label "Matches"]
(for [match (:matches @(rf/subscribe [:epochs/epoch-root]))]
^{:key (:id (first match))}
[rc/v-box
:style {:border "1px solid black"}
:children (doall (map (fn [event] [rc/label :label (prn-str event)]) (metam/summarise-match match)))

14
src/day8/re_frame/trace/view/traces.cljs
View File

@ -88,12 +88,12 @@
input-error (r/atom false)
categories (rf/subscribe [:traces/categories])
trace-detail-expansions (rf/subscribe [:traces/expansions])
beginning (rf/subscribe [:epochs/beginning-trace-id])
end (rf/subscribe [:epochs/ending-trace-id])
traces (rf/subscribe [:traces/current-event-traces])]
beginning (rf/subscribe [:epochs/beginning-trace-id])
end (rf/subscribe [:epochs/ending-trace-id])
current-traces (rf/subscribe [:traces/current-event-traces])]
(fn []
(let [toggle-category-fn #(rf/dispatch [:traces/toggle-categories %])
visible-traces (cond->> @traces
visible-traces (cond->> #_@current-traces @traces
;; Remove cached subscriptions. Could add this back in as a setting later
;; but it's pretty low signal/noise 99% of the time.
true (remove (fn [trace] (and (= :sub/create (:op-type trace))
@ -161,10 +161,10 @@
:on-click #(rf/dispatch [:traces/reset-filter-items])}
(when (pos? (count @filter-items))
(str (count visible-traces) " of "))
(str (count @traces))]
(str (count @current-traces))]
" traces "
(when (pos? (count @traces))
[:span "(" [:button.text-button {:on-click #(do (trace/reset-tracing!) (reset! traces []))} "clear"] ")"])]
(when (pos? (count @current-traces))
[:span "(" [:button.text-button {:on-click #(do (trace/reset-tracing!) (reset! current-traces []))} "clear"] ")"])]
[:th {:style {:text-align "right"}} "meta"]]
[:tbody (render-traces visible-traces filter-items filter-input trace-detail-expansions)]]]]))))

1
test-resources/app-trace1.edn Normal file
View File

File diff suppressed because one or more lines are too long

53
test/day8/re_frame/trace/graph_test.clj
View File

@ -1,53 +0,0 @@
(ns day8.re-frame.trace.graph-test
(:require [day8.re-frame.trace.graph :as graph]
[clojure.test :refer :all]))
(def t1
'({:id 1, :operation :initialise-db, :type :event, :tags {:event [:initialise-db]}, :child-of nil}
{:id 2, :operation "todomvc.core.wrapper", :type :render, :tags {:component-path "todomvc.core.wrapper", :reaction "rx2", :input-signals ("ra18")}, :child-of nil}
{:id 5, :operation :sorted-todos, :type :sub/create, :tags {:query-v [:sorted-todos], :cached? false, :reaction "rx3"}, :child-of 4}
{:id 4, :operation :todos, :type :sub/create, :tags {:query-v [:todos], :cached? false, :reaction "rx4"}, :child-of 3}
{:id 7, :operation :sorted-todos, :type :sub/run, :tags {:query-v [:sorted-todos], :reaction "rx3", :input-signals ["ra5"]}, :child-of 6}
{:id 6, :operation :todos, :type :sub/run, :tags {:query-v [:todos], :reaction "rx4", :input-signals ["rx3"]}, :child-of 3}
{:id 3, :operation "todomvc.views.todo_app", :type :render, :tags {:component-path "todomvc.core.wrapper > todomvc.views.todo_app", :reaction "rx6", :input-signals ("rx4")}, :child-of nil}
{:id 8, :operation "todomvc.views.task_entry", :type :render, :tags {:component-path "todomvc.core.wrapper > todomvc.views.todo_app > todomvc.views.task_entry", :reaction nil, :input-signals nil}, :child-of nil}
{:id 9, :operation "todomvc.views.todo_input", :type :render, :tags {:component-path "todomvc.core.wrapper > todomvc.views.todo_app > todomvc.views.task_entry > todomvc.views.todo_input", :reaction "rx7", :input-signals ("ra19")}, :child-of nil}
{:id 10, :operation "ReagentInput", :type :render, :tags {:component-path "todomvc.core.wrapper > todomvc.views.todo_app > todomvc.views.task_entry > todomvc.views.todo_input > ReagentInput", :reaction nil, :input-signals nil}, :child-of nil}
{:id 13, :operation :todos, :type :sub/create, :tags {:query-v [:todos], :cached? true, :reaction "rx4"}, :child-of 12}
{:id 14, :operation :showing, :type :sub/create, :tags {:query-v [:showing], :cached? false, :reaction "rx8"}, :child-of 12}
{:id 12, :operation :visible-todos, :type :sub/create, :tags {:query-v [:visible-todos], :cached? false, :reaction "rx9"}, :child-of 11}
{:id 16, :operation :todos, :type :sub/create, :tags {:query-v [:todos], :cached? true, :reaction "rx4"}, :child-of 15}
{:id 15, :operation :all-complete?, :type :sub/create, :tags {:query-v [:all-complete?], :cached? false, :reaction "rx10"}, :child-of 11}
{:id 17, :operation :all-complete?, :type :sub/run, :tags {:query-v [:all-complete?], :reaction "rx10", :input-signals ["rx4"]}, :child-of 11}
{:id 19, :operation :showing, :type :sub/run, :tags {:query-v [:showing], :reaction "rx8", :input-signals ["ra5"]}, :child-of 18}
{:id 18, :operation :visible-todos, :type :sub/run, :tags {:query-v [:visible-todos], :reaction "rx9", :input-signals ("rx4" "rx8")}, :child-of 11}
{:id 11, :operation "todomvc.views.task_list", :type :render, :tags {:component-path "todomvc.core.wrapper > todomvc.views.todo_app > todomvc.views.task_list", :reaction "rx11", :input-signals ("rx10" "rx9")}, :child-of nil}
{:id 20, :operation "ReagentInput", :type :render, :tags {:component-path "todomvc.core.wrapper > todomvc.views.todo_app > todomvc.views.task_list > ReagentInput", :reaction nil, :input-signals nil}, :child-of nil}
{:id 21, :operation "todomvc.views.todo_item", :type :render, :tags {:component-path "todomvc.core.wrapper > todomvc.views.todo_app > todomvc.views.task_list > todomvc.views.todo_item", :reaction "rx12", :input-signals ("ra20" "ra20")}, :child-of nil}
{:id 22, :operation "ReagentInput", :type :render, :tags {:component-path "todomvc.core.wrapper > todomvc.views.todo_app > todomvc.views.task_list > todomvc.views.todo_item > ReagentInput", :reaction nil, :input-signals nil}, :child-of nil}
{:id 24, :operation :footer-counts, :type :sub/create, :tags {:query-v [:footer-counts], :cached? false, :reaction "rx13"}, :child-of 23}
{:id 25, :operation :showing, :type :sub/create, :tags {:query-v [:showing], :cached? true, :reaction "rx8"}, :child-of 23}
{:id 27, :operation :todos, :type :sub/create, :tags {:query-v [:todos], :cached? true, :reaction "rx4"}, :child-of 26}
{:id 29, :operation :todos, :type :sub/create, :tags {:query-v [:todos], :cached? true, :reaction "rx4"}, :child-of 28}
{:id 28, :operation :completed-count, :type :sub/create, :tags {:query-v [:completed-count], :cached? false, :reaction "rx14"}, :child-of 26}
{:id 30, :operation :completed-count, :type :sub/run, :tags {:query-v [:completed-count], :reaction "rx14", :input-signals ["rx4"]}, :child-of 26}
{:id 26, :operation :footer-counts, :type :sub/run, :tags {:query-v [:footer-counts], :reaction "rx13", :input-signals ("rx4" "rx14")}, :child-of 23}
{:id 23, :operation "todomvc.views.footer_controls", :type :render, :tags {:component-path "todomvc.core.wrapper > todomvc.views.todo_app > todomvc.views.footer_controls", :reaction "rx15", :input-signals ("rx13" "rx8" "rx8" "rx8")}, :child-of nil}))
(deftest sub-graph-test
(is (= {:links []
:nodes [{:id "rx4"
:r 10
:title ""
:group 2
:data {:id 1
:tags {:cached? false
:reaction "rx4"}
:type :sub/create}}]}
(graph/trace->sub-graph [{:id 1 :type :sub/create :tags {:cached? false :reaction "rx4"}}] []))))
(deftest dispose-view-test
(is (= {:links []
:nodes []}
(graph/trace->sub-graph [{:id 1 :type :render :tags {:cached? false :reaction "rx4"}}
{:id 2 :type :componentWillUnmount :tags {:reaction "rx4"}}] []))))

47
test/day8/re_frame/trace/metamorphic_test.clj
View File

@ -2,15 +2,38 @@
(:require [clojure.test :refer :all])
(:require [day8.re-frame.trace.metamorphic :as m]))
(deftest parse-events-test
(= (m/parse-events)
'(({:id 327,
:operation [:idle :add-event],
:op-type :re-frame.router/fsm-trigger,
:tags {:current-state :idle, :new-state :scheduled}}
{:id 329, :operation :estimate/new, :op-type :event, :tags {:event [:estimate/new]}}
{:id 330,
:operation [:running :finish-run],
:op-type :re-frame.router/fsm-trigger,
:tags {:current-state :running, :new-state :idle}}))
))
(defn trace-events [file]
(->> (slurp (str "test-resources/" file))
(clojure.edn/read-string {:readers {'utc identity
'object (fn [x] "<object>")}})
(sort-by :id)))
(deftest parse-app-trace1-test
(let [rt (m/parse-traces (trace-events "app-trace1.edn"))
matches (:matches rt)
[m1 m2 m3 m4 m5 m6] matches]
(is (= (count matches) 6))
(is (= (m/beginning-id m1) 1))
(is (= (m/ending-id m1) 34))
(is (= (:operation (m/matched-event m1)) :bootstrap))
(is (= (m/beginning-id m2) 35))
(is (= (m/ending-id m2) 38))
(is (= (:operation (m/matched-event m2)) :acme.myapp.events/boot-flow))
(is (= (m/beginning-id m3) 39))
(is (= (m/ending-id m3) 42))
(is (= (:operation (m/matched-event m3)) :acme.myapp.events/init-db))
(is (= (m/beginning-id m4) 43))
(is (= (m/ending-id m4) 47))
(is (= (:operation (m/matched-event m4)) :acme.myapp.events/boot-flow))
(is (= (m/beginning-id m5) 48))
(is (= (m/ending-id m5) 49))
(is (= (:operation (m/matched-event m5)) :acme.myapp.events/start-intercom))
(is (= (m/beginning-id m6) 50))
(is (= (m/ending-id m6) 181))
(is (= (:operation (m/matched-event m6)) :acme.myapp.events/success-bootstrap))))