(ns day8.re-frame.trace (:require [day8.re-frame.trace.subvis :as subvis] [day8.re-frame.trace.styles :as styles] [day8.re-frame.trace.components :as components] [day8.re-frame.trace.localstorage :as localstorage] [re-frame.trace :as trace :include-macros true] [cljs.pprint :as pprint] [clojure.string :as str] [reagent.core :as r] [reagent.interop :refer-macros [$ $!]] [reagent.impl.util :as util] [reagent.impl.component :as component] [reagent.impl.batching :as batch] [reagent.ratom :as ratom] [goog.object :as gob] [re-frame.interop :as interop] [devtools.formatters.core :as devtools])) (defn comp-name [c] (let [n (or (component/component-path c) (some-> c .-constructor util/fun-name))] (if-not (empty? n) n ""))) (def static-fns {:render (fn render [] (this-as c (trace/with-trace {:op-type :render :tags {:component-path (reagent.impl.component/component-path c)} :operation (last (str/split (reagent.impl.component/component-path c) #" > "))} (if util/*non-reactive* (reagent.impl.component/do-render c) (let [rat ($ c :cljsRatom) _ (batch/mark-rendered c) res (if (nil? rat) (ratom/run-in-reaction #(reagent.impl.component/do-render c) c "cljsRatom" batch/queue-render reagent.impl.component/rat-opts) (._run rat false)) cljs-ratom ($ c :cljsRatom)] ;; actually a reaction (trace/merge-trace! {:tags {:reaction (interop/reagent-id cljs-ratom) :input-signals (when cljs-ratom (map interop/reagent-id (gob/get cljs-ratom "watching" :none)))}}) res)))))}) (defn monkey-patch-reagent [] (let [#_#_real-renderer reagent.impl.component/do-render real-custom-wrapper reagent.impl.component/custom-wrapper real-next-tick reagent.impl.batching/next-tick real-schedule reagent.impl.batching/schedule] #_(set! reagent.impl.component/do-render (fn [c] (let [name (comp-name c)] (js/console.log c) (trace/with-trace {:op-type :render :tags {:component-path (reagent.impl.component/component-path c)} :operation (last (str/split name #" > "))} (real-renderer c))))) (set! reagent.impl.component/static-fns static-fns) (set! reagent.impl.component/custom-wrapper (fn [key f] (case key :componentWillUnmount (fn [] (this-as c (trace/with-trace {:op-type key :operation (last (str/split (comp-name c) #" > ")) :tags {:component-path (reagent.impl.component/component-path c) :reaction (interop/reagent-id ($ c :cljsRatom))}}) (.call (real-custom-wrapper key f) c c))) (real-custom-wrapper key f)))) #_(set! reagent.impl.batching/next-tick (fn [f] (real-next-tick (fn [] (trace/with-trace {:op-type :raf} (f)))))) #_(set! reagent.impl.batching/schedule schedule #_(fn [] (reagent.impl.batching/do-after-render (fn [] (trace/with-trace {:op-type :raf-end}))) (real-schedule))))) (def traces (interop/ratom [])) (defn log-trace? [trace] (let [rendering? (= (:op-type trace) :render)] (if-not rendering? true (not (str/includes? (or (get-in trace [:tags :component-path]) "") "day8.re_frame.trace"))) #_(if-let [comp-p (get-in trace [:tags :component-path])] (println comp-p)))) (defn disable-tracing! [] (re-frame.trace/remove-trace-cb ::cb)) (defn enable-tracing! [] (re-frame.trace/register-trace-cb ::cb (fn [new-traces] (let [new-traces (filter log-trace? new-traces)] (swap! traces #(reduce conj % new-traces)))))) (defn init-tracing! "Sets up any initial state that needs to be there for tracing. Does not enable tracing." [] (monkey-patch-reagent)) (defn search-input [{:keys [title on-save on-change on-stop]}] (let [val (r/atom title) save #(let [v (-> @val str str/trim)] (when (pos? (count v)) (on-save v)))] (fn [] [:input {:style {:margin-left 7} :type "text" :value @val :auto-focus true :on-change #(do (reset! val (-> % .-target .-value)) (on-change %)) :on-key-down #(case (.-which %) 13 (do (save) (reset! val "")) nil)}]))) (defn query->fn [query] (if (= :contains (:filter-type query)) (fn [trace] (str/includes? (str/lower-case (str (:operation trace) " " (:op-type trace))) (:query query))) (fn [trace] (< (:query query) (:duration trace))))) (defn render-traces [showing-traces trace-detail-expansions] (doall (for [{:keys [op-type id operation tags duration] :as trace} showing-traces] (let [padding {:padding "0px 5px 0px 5px"} row-style (merge padding {:border-top (case op-type :event "1px solid lightgrey" nil)}) show-row? (get-in @trace-detail-expansions [:overrides id] (:show-all? @trace-detail-expansions)) #_#__ (js/console.log (devtools/header-api-call tags))] (list [:tr {:key id :on-click (fn [ev] (swap! trace-detail-expansions update-in [:overrides id] #(if show-row? false (not %)))) :style {:color (case op-type :sub/create "green" :sub/run "#fd701e" :event "blue" :render "purple" :re-frame.router/fsm-trigger "#fd701e" nil)}} [:td {:style row-style} [:button (if show-row? "▼" "▶")]] [:td {:style row-style} (str op-type)] [:td {:style row-style} (if (= PersistentVector (type (js->clj operation))) (second operation) operation)] [:td {:style (merge row-style { ; :font-weight (if (< slower-than-bold-int duration) ; "bold" ; "") :white-space "nowrap"})} (.toFixed duration 1) " ms"]] (when show-row? [:tr {:key (str id "-details")} [:td {:col-span 3} (let [tag-str (with-out-str (pprint/pprint tags)) string-size-limit 400] (if (< string-size-limit (count tag-str)) (str (subs tag-str 0 string-size-limit) " ...") tag-str))]])))))) (defn render-trace-panel [] (let [filter-input (r/atom "") filter-items (r/atom (localstorage/get "filter-items" [])) filter-type (r/atom :contains) input-error (r/atom false) trace-detail-expansions (r/atom {:show-all? false :overrides {}})] (add-watch filter-items :update-localstorage (fn [_ _ _ new-state] (localstorage/save! "filter-items" new-state))) (fn [] (let [showing-traces (if (= @filter-items []) @traces (filter (apply every-pred (map query->fn @filter-items)) @traces)) save-query (fn [_] (if (and (= @filter-type :slower-than) (js/isNaN (js/parseFloat @filter-input))) (reset! input-error true) (do (reset! input-error false) (swap! filter-items conj {:id (random-uuid) :query (if (= @filter-type :contains) (str/lower-case @filter-input) (js/parseFloat @filter-input)) :filter-type @filter-type}))))] [:div {:style {:flex "1 0 auto" :width "100%" :height "100%" :display "flex" :flex-direction "column"}} [:div.filter-control [:div.filter-control-input [:select {:value @filter-type :on-change #(reset! filter-type (keyword (.. % -target -value)))} [:option {:value "contains"} "contains"] [:option {:value "slower-than"} "slower than"]] [search-input {:on-save save-query :on-change #(reset! filter-input (.. % -target -value))}] [:button.button.icon-button {:on-click save-query :style {:margin 0}} [components/icon-add]] (if @input-error [:div.input-error {:style {:color "red" :margin-top 5}} "Please enter a valid number."])] [:ul.filter-items (map (fn [item] ^{:key (:id item)} [:li.filter-item [:button.button {:style {:margin 0} :on-click (fn [event] (swap! filter-items #(remove (comp (partial = (:query item)) :query) %)))} (:filter-type item) ": " [:span.filter-item-string (:query item)] [:span.icon-button [components/icon-remove]]]]) @filter-items)]] [components/autoscroll-list {:class "panel-content-scrollable" :scroll? true} [:table {:style {:margin-bottom 10} :cell-spacing "0" :width "100%"} [:thead>tr [:th [:button.text-button {:style {:cursor "pointer"} :on-click (fn [ev] ;; Always reset expansions (swap! trace-detail-expansions assoc :overrides {}) ;; Then toggle :show-all? (swap! trace-detail-expansions update :show-all? not))} (if (:show-all? @trace-detail-expansions) "-" "+")]] [:th "operations"] [:th (when (pos? (count @filter-items)) (str (count showing-traces) " of ")) (when (pos? (count @traces)) (str (count @traces))) " events " (when (pos? (count @traces)) [:span "(" [:button.text-button {:on-click #(do (trace/reset-tracing!) (reset! traces []))} "clear"] ")"])] [:th "meta"]] [:tbody (render-traces showing-traces trace-detail-expansions)]]]])))) (defn resizer-style [draggable-area] {:position "absolute" :z-index 2 :opacity 0 :left (str (- (/ draggable-area 2)) "px") :width "10px" :top "0px" :height "100%" :cursor "col-resize"}) (def ease-transition "left 0.2s ease-out, top 0.2s ease-out, width 0.2s ease-out, height 0.2s ease-out") (defn toggle-traces [showing?] (if @showing? (enable-tracing!) (disable-tracing!))) (defn devtools [] ;; Add clear button ;; Filter out different trace types (let [position (r/atom :right) panel-width-ratio (r/atom (localstorage/get "panel-width-ratio" 0.35)) showing? (r/atom (localstorage/get "show-panel" false)) dragging? (r/atom false) pin-to-bottom? (r/atom true) selected-tab (r/atom :traces) window-width js/window.innerWidth handle-keys (fn [e] (let [combo-key? (or (.-ctrlKey e) (.-metaKey e) (.-altKey e)) tag-name (.-tagName (.-target e)) key (.-key e) entering-input? (contains? #{"INPUT" "SELECT" "TEXTAREA"} tag-name)] (when (and (not entering-input?) combo-key?) (cond (and (= key "h") (.-ctrlKey e)) (do (swap! showing? not) (toggle-traces showing?) (.preventDefault e)))))) handle-mousemove (fn [e] (when @dragging? (let [x (.-clientX e) y (.-clientY e)] (.preventDefault e) (reset! panel-width-ratio (/ (- window-width x) window-width)))))] (add-watch panel-width-ratio :update-panel-width-ratio (fn [_ _ _ new-state] (localstorage/save! "panel-width-ratio" new-state))) (add-watch showing? :update-show-panel (fn [_ _ _ new-state] (localstorage/save! "show-panel" new-state))) (r/create-class {:component-will-mount (fn [] (toggle-traces showing?) (js/window.addEventListener "keydown" handle-keys) (js/window.addEventListener "mousemove" handle-mousemove)) :component-will-unmount (fn [] (js/window.removeEventListener "keydown" handle-keys) (js/window.removeEventListener "mousemove" handle-mousemove)) :display-name "devtools outer" :reagent-render (fn [] (let [draggable-area 10 left (if @showing? (str (* 100 (- 1 @panel-width-ratio)) "%") (str window-width "px")) transition (if @dragging? "" ease-transition)] [:div.panel-wrapper {:style {:position "fixed" :width "0px" :height "0px" :top "0px" :left "0px" :z-index 99999999}} [:div.panel {:style {:position "fixed" :z-index 1 :box-shadow "rgba(0, 0, 0, 0.3) 0px 0px 4px" :background "white" :left left :top "0px" :width (str (inc (int (* 100 @panel-width-ratio))) "%") :height "100%" :transition transition}} [:div.panel-resizer {:style (resizer-style draggable-area) :on-mouse-down #(reset! dragging? true) :on-mouse-up #(reset! dragging? false)}] [:div.panel-content {:style {:width "100%" :height "100%" :display "flex" :flex-direction "column"}} [:div.panel-content-top [:div.nav [:button {:class (str "tab button " (when (= @selected-tab :traces) "active")) :on-click #(reset! selected-tab :traces)} "Traces"] [:button {:class (str "tab button " (when (= @selected-tab :subvis) "active")) :on-click #(reset! selected-tab :subvis)} "SubVis"]]] (case @selected-tab :traces [render-trace-panel] :subvis [subvis/render-subvis traces [:div.panel-content-scrollable]])]]]))}))) (defn panel-div [] (let [id "--re-frame-trace--" panel (.getElementById js/document id)] (if panel panel (let [new-panel (.createElement js/document "div")] (.setAttribute new-panel "id" id) (.appendChild (.-body js/document) new-panel) (js/window.focus new-panel) new-panel)))) (defn inject-styles [] (let [id "--re-frame-trace-styles--" styles-el (.getElementById js/document id) new-styles-el (.createElement js/document "style") new-styles styles/panel-styles] (.setAttribute new-styles-el "id" id) (-> new-styles-el (.-innerHTML) (set! new-styles)) (if styles-el (-> styles-el (.-parentNode) (.replaceChild new-styles-el styles-el)) (let [] (.appendChild (.-head js/document) new-styles-el) new-styles-el)))) (defn inject-devtools! [] (inject-styles) (r/render [devtools] (panel-div)))