Fix performance of auto-scrolling epoch navigation with debounce

CHANGELOG.md

@@ -1,6 +1,10 @@
 # Change Log
 All notable changes to this project will be documented in this file. This change log follows the conventions of [keepachangelog.com](http://keepachangelog.com/).
 
+#### Fixed
+
+- Fix performance of auto-scrolling epoch navigation by using debounce.
+
 #### Changed
 
 - Upgrade re-highlight to 1.0.0. Includes [highlight.js 11.0.1](https://github.com/highlightjs/highlight.js/blob/main/CHANGES.md#version-1100).

src/day8/re_frame_10x/fx/debounce.cljs

@@ -0,0 +1,26 @@
+(ns day8.re-frame-10x.fx.debounce
+  (:require
+    [day8.re-frame-10x.inlined-deps.re-frame.v1v1v2.re-frame.core :as rf]))
+
+(defn now [] (.getTime (js/Date.)))
+
+(def registered-keys (atom nil))
+
+(defn dispatch-if-not-superceded [{:keys [key delay event time-received]}]
+  (when (= time-received (get @registered-keys key))
+    ;; no new events on this key!
+    (rf/dispatch event)))
+
+(defn dispatch-later [{:keys [delay] :as debounce}]
+  (js/setTimeout
+    (fn [] (dispatch-if-not-superceded debounce))
+    delay))
+
+(rf/reg-fx
+  ::dispatch
+  (fn dispatch-debounce [{:keys [key event delay] :as debounce}]
+    (when (not (and (keyword? key) (vector? event) (integer? delay)))
+      (rf/console :error "re-frame-10x ::debounce/dispatch invalid argument"))
+    (let [ts (now)]
+      (swap! registered-keys assoc (:key debounce) ts)
+      (dispatch-later (assoc debounce :time-received ts)))))

src/day8/re_frame_10x/fx/scroll.cljs

@@ -0,0 +1,9 @@
+(ns day8.re-frame-10x.fx.scroll
+  (:require
+    [day8.re-frame-10x.inlined-deps.re-frame.v1v1v2.re-frame.core :as rf]))
+
+(rf/reg-fx
+  ::into-view
+  (fn [{:keys [js-dom]}]
+    (when (instance? js/Element js-dom)
+      (.scrollIntoView js-dom))))

src/day8/re_frame_10x/navigation/epochs/events.cljs

@@ -5,13 +5,29 @@
     [re-frame.db]
     [re-frame.trace]
     [day8.re-frame-10x.inlined-deps.re-frame.v1v1v2.re-frame.core :as rf]
+    [day8.re-frame-10x.fx.debounce                                :as debounce]
+    [day8.re-frame-10x.fx.scroll                                  :as scroll]
     [day8.re-frame-10x.tools.metamorphic                          :as metam]
     [day8.re-frame-10x.tools.coll                                 :as tools.coll]))
 
 (defn first-match-id
   [m]
   (-> m :match-info first :id))
 
+(rf/reg-event-fx
+  ::scroll-into-view-debounced
+  [rf/trim-v]
+  (fn [_ [js-dom]]
+    {:fx [[::debounce/dispatch {:key   ::scroll-into-view
+                                :event [::scroll-into-view js-dom]
+                                :delay 128}]]}))
+
+(rf/reg-event-fx
+  ::scroll-into-view
+  [rf/trim-v]
+  (fn [_ [js-dom]]
+    {:fx [[::scroll/into-view {:js-dom js-dom}]]}))
+
 (rf/reg-event-fx
   ::receive-new-traces
   [rf/trim-v]

src/day8/re_frame_10x/navigation/epochs/views.cljs

@@ -41,12 +41,12 @@
       {:component-did-mount
        (fn [this]
          (when @active?
-           (.scrollIntoView (rdom/dom-node this))))
+           (rf/dispatch [::epochs.events/scroll-into-view-debounced (rdom/dom-node this)])))
 
        :component-did-update
        (fn [this]
          (when @active?
-           (.scrollIntoView (rdom/dom-node this))))
+           (rf/dispatch [::epochs.events/scroll-into-view-debounced (rdom/dom-node this)])))
 
        :reagent-render
        (fn [event id]