enhance: improve long page loading performance

src/main/frontend/components/block.cljs

@@ -88,7 +88,6 @@
 (def *move-to (atom nil))
 
 ;; TODO: dynamic
-(defonce max-blocks-per-page 200)
 (defonce max-depth-of-links 5)
 (defonce *blocks-container-id (atom 0))
 
@@ -2886,37 +2885,58 @@
         (str (:block/uuid item))))))
 
 (defonce ignore-scroll? (atom false))
+
+(defn- custom-query-or-ref?
+  [config]
+  (let [ref? (:ref? config)
+        custom-query? (:custom-query? config)]
+    (or custom-query? ref?)))
+
+
+;; TODO: virtual tree for better UX and memory usage reduce
+(def initial-blocks-length 200)
+(def step-loading-blocks 50)
+
+(defn- flat-blocks-tree
+  [vec-tree]
+  (->> (mapcat (fn [x] (tree-seq map? :block/children x)) vec-tree)
+       (map #(dissoc % :block/children))))
+
+(defn- get-segment
+  [config flat-blocks idx blocks->vec-tree]
+  (let [new-idx (if-not (zero? idx)
+                  (+ idx step-loading-blocks)
+                  initial-blocks-length)
+        max-idx (count flat-blocks)
+        idx (min max-idx new-idx)
+        blocks (util/safe-subvec flat-blocks 0 idx)]
+    [(blocks->vec-tree blocks)
+     idx]))
+
 (rum/defcs lazy-blocks <
-  (rum/local 1 ::page)
-  [state config blocks]
-  (let [*page (get state ::page)
-        segment (->> blocks
-                     (drop (* (dec @*page) max-blocks-per-page))
-                     (take max-blocks-per-page))
+  {:did-remount (fn [old-state new-state]
+                  ;; Loading more when pressing Enter or paste
+                  (let [args (:rum/args new-state)]
+                    ;; FIXME: what if users paste too many blocks?
+                    ;; or, a template with a lot of blocks?
+                    (swap! (::last-idx new-state) + 100))
+                  new-state)}
+  (rum/local 0 ::last-idx)
+  [state config flat-blocks blocks->vec-tree]
+  (let [*last-idx (::last-idx state)
+        [segment idx] (get-segment config
+                                   flat-blocks
+                                   @*last-idx
+                                   blocks->vec-tree)
         bottom-reached (fn []
-                         (when (and (= (count segment) max-blocks-per-page)
-                                    (> (count blocks) (* @*page max-blocks-per-page))
-                                    (not @ignore-scroll?))
-                           (swap! *page inc)
-                           (util/scroll-to-top))
-                         (reset! ignore-scroll? false))
-        top-reached (fn []
-                      (when (> @*page 1)
-                        (swap! *page dec)
-                        (reset! ignore-scroll? true)
-                        (js/setTimeout #(util/scroll-to
-                                         (.-scrollHeight (js/document.getElementById "lazy-blocks"))) 100)))]
+                         (reset! *last-idx idx)
+                         (reset! ignore-scroll? false))]
     [:div#lazy-blocks
-     (when (> @*page 1)
-       [:div.ml-4.mb-4 [:a#prev.opacity-60.opacity-100.text-sm.font-medium {:on-click top-reached}
-                        "Prev"]])
      (ui/infinite-list
       "main-container"
       (block-list config segment)
-      {:on-load bottom-reached})
-     (when (> (count blocks) (* @*page max-blocks-per-page))
-       [:div.ml-4.mt-4 [:a#more.opacity-60.opacity-100.text-sm.font-medium {:on-click bottom-reached}
-                        "More"]])]))
+      {:on-load bottom-reached
+       :threhold 400})]))
 
 (rum/defcs blocks-container <
   {:init (fn [state]
@@ -2928,20 +2948,19 @@
                               (let [id' (swap! *blocks-container-id inc)]
                                 (reset! *init-blocks-container-id id')
                                 id'))
-        sidebar? (:sidebar? config)
-        ref? (:ref? config)
-        custom-query? (:custom-query? config)
-        blocks->vec-tree #(if (or custom-query? ref?) % (tree/blocks->vec-tree % (:id config)))
-        blocks' (blocks->vec-tree blocks)
-        blocks (if (seq blocks') blocks' blocks)
         config (assoc config :blocks-container-id blocks-container-id)
         doc-mode? (:document/mode? config)]
     (when (seq blocks)
-      [:div.blocks-container.flex-1
-       {:class (when doc-mode? "document-mode")
-        ;; :style {:margin-left (if sidebar? 0 -10)}
-        }
-       (lazy-blocks config blocks)])))
+      (let [blocks->vec-tree #(if (custom-query-or-ref? config) % (tree/blocks->vec-tree % (:id config)))
+            blocks-tree (blocks->vec-tree blocks)
+            blocks-tree (if (seq blocks-tree) blocks-tree blocks)
+            flat-blocks (if (custom-query-or-ref? config)
+                          blocks-tree
+                          (flat-blocks-tree blocks-tree))
+            flat-blocks (vec flat-blocks)]
+        [:div.blocks-container.flex-1
+         {:class (when doc-mode? "document-mode")}
+         (lazy-blocks config flat-blocks blocks->vec-tree)]))))
 
 ;; headers to hiccup
 (defn ->hiccup

src/main/frontend/components/page.cljs

@@ -47,9 +47,9 @@
     (get-in route-match [:parameters :path :name])))
 
 (defn- get-blocks
-  [repo page-name page-original-name block? block-id]
+  [repo page-name block-id]
   (when page-name
-    (if block?
+    (if block-id
       (db/get-block-and-children repo block-id)
       (db/get-page-blocks repo page-name))))
 
@@ -130,7 +130,7 @@
           page-e (if (and page-e (:db/id page-e))
                    {:db/id (:db/id page-e)}
                    page-e)
-          page-blocks (get-blocks repo page-name page-original-name block? block-id)]
+          page-blocks (get-blocks repo page-name block-id)]
       (if (empty? page-blocks)
         (dummy-block page-name)
         (let [document-mode? (state/sub :document/mode?)

src/main/frontend/modules/outliner/tree.cljs

@@ -22,29 +22,24 @@
   [node]
   (satisfies? INode node))
 
-(defn- get-children
-  [blocks parent]
-  (let [children (doall
-                  (-> (filter #(= (:block/parent %) {:db/id (:db/id parent)}) @blocks)
-                      (db/sort-by-left parent)))]
-    (reset! blocks (remove (set children) @blocks))
-    children))
-
-(defn- with-children
-  [block children]
-  (assoc block :block/children children))
-
 (defn- blocks->vec-tree-aux
-  ([blocks root]
-   (blocks->vec-tree-aux blocks root 1))
-  ([blocks root level]
-   (let [root {:db/id (:db/id root)}]
-     (some->>
-      (get-children blocks root)
-      (map (fn [block]
-             (let [block (assoc block :block/level level)
-                   children (blocks->vec-tree-aux blocks block (inc level))]
-               (with-children block children))))))))
+  [blocks root page?]
+  (let [*idx (atom (if page? 0 -1))
+        id-map (fn [m] {:db/id (:db/id m)})
+        root (id-map root)
+        parent-blocks (group-by :block/parent blocks)
+        sort-fn (fn [parent]
+                  (db/sort-by-left (get parent-blocks parent) parent))
+        block-children (fn block-children [parent level]
+                         (map (fn [m]
+                                (let [parent (id-map m)
+                                      children (-> (block-children parent (inc level))
+                                                   (db/sort-by-left parent))]
+                                  (assoc m
+                                         :block/level level
+                                         :block/children children)))
+                           (sort-fn parent)))]
+    (block-children root 1)))
 
 (defn- get-root-and-page
   [root-id]
@@ -57,21 +52,16 @@
 
 (defn blocks->vec-tree
   [blocks root-id]
-  (let [original-blocks blocks
-        blocks (atom blocks)
-        [page? root] (get-root-and-page (str root-id))
-        result (blocks->vec-tree-aux blocks root)]
-    (cond
-      (not root)                        ; custom query
-      original-blocks
-
-      page?
-      result
-
-      :else                             ; include root block
-      (let [root-block (some #(when (= (:db/id %) (:db/id root)) %) @blocks)
-            root-block (with-children root-block result)]
-        [root-block]))))
+  (let [[page? root] (get-root-and-page (str root-id))]
+    (if-not root ; custom query
+      blocks
+      (let [result (blocks->vec-tree-aux blocks root page?)]
+        (if page?
+          result
+          ;; include root block
+          (let [root-block (some #(when (= (:db/id %) (:db/id root)) %) blocks)
+                root-block (assoc root-block :block/children result)]
+            [root-block]))))))
 
 (defn- sort-blocks-aux
   [parents parent-groups]

src/main/frontend/ui.cljs

@@ -374,11 +374,12 @@
       down?)))
 
 (defn on-scroll
-  [node on-load on-top-reached]
+  [node {:keys [on-load on-top-reached threhold]
+         :or {threhold 100}}]
   (let [full-height (gobj/get node "scrollHeight")
         scroll-top (gobj/get node "scrollTop")
         client-height (gobj/get node "clientHeight")
-        bottom-reached? (<= (- full-height scroll-top client-height) 100)
+        bottom-reached? (<= (- full-height scroll-top client-height) threhold)
         top-reached? (= scroll-top 0)
         down? (scroll-down?)]
     (when (and down? bottom-reached? on-load)
@@ -389,20 +390,16 @@
 (defn attach-listeners
   "Attach scroll and resize listeners."
   [state]
-
   (let [list-element-id (first (:rum/args state))
         opts (-> state :rum/args (nth 2))
         node (js/document.getElementById list-element-id)
-        debounced-on-scroll (util/debounce 500 #(on-scroll
-                                                 node
-                                                 (:on-load opts) ; bottom reached
-                                                 (:on-top-reached opts)))]
+        debounced-on-scroll (util/debounce 500 #(on-scroll node opts))]
     (mixins/listen state node :scroll debounced-on-scroll)))
 
 (rum/defcs infinite-list <
   (mixins/event-mixin attach-listeners)
   "Render an infinite list."
-  [state list-element-id body {:keys [on-load has-more on-top-reached]}]
+  [state list-element-id body {:keys [on-load has-more on-top-reached threhold]}]
   (rum/with-context [[t] i18n/*tongue-context*]
     [:div
      body