From 08c5cc18d0defec2be9f4381eb718314aa58724b Mon Sep 17 00:00:00 2001 From: Tienson Qin Date: Fri, 19 Apr 2024 02:16:16 +0800 Subject: [PATCH] refactor: simplify outliner move blocks The new implementation doesn't rely on insert-blocks, instead, it will move the blocks one by one, but using batch tx. --- deps/outliner/src/logseq/outliner/core.cljs | 151 ++++++++++-------- src/main/frontend/worker/db/fix.cljs | 7 +- .../frontend/modules/outliner/core_test.cljs | 75 ++++++--- src/test/frontend/worker/fixtures.cljs | 4 +- 4 files changed, 144 insertions(+), 93 deletions(-) diff --git a/deps/outliner/src/logseq/outliner/core.cljs b/deps/outliner/src/logseq/outliner/core.cljs index 9f1cc08e4..2a3699b83 100644 --- a/deps/outliner/src/logseq/outliner/core.cljs +++ b/deps/outliner/src/logseq/outliner/core.cljs @@ -20,7 +20,8 @@ [cljs.pprint :as pprint] [logseq.common.marker :as common-marker] [logseq.db.frontend.content :as db-content] - [logseq.db.sqlite.create-graph :as sqlite-create-graph])) + [logseq.db.sqlite.create-graph :as sqlite-create-graph] + [frontend.worker.batch-tx :include-macros true :as batch-tx])) (def ^:private ^:dynamic *transaction-data* "Stores transaction-data that are generated by one or more write-operations, @@ -94,6 +95,12 @@ (let [updated-at (common-util/time-ms)] (assoc block :block/updated-at updated-at))) +(defn filter-top-level-blocks + [blocks] + (let [parent-ids (set/intersection (set (map (comp :db/id :block/parent) blocks)) + (set (map :db/id blocks)))] + (remove (fn [e] (contains? parent-ids (:db/id (:block/parent e)))) blocks))) + (defn- remove-orphaned-page-refs! [db {db-id :db/id :as block-entity} txs-state *old-refs new-refs {:keys [db-graph?]}] (let [old-refs (if db-graph? @@ -678,10 +685,12 @@ result []] (if-let [block (first blocks)] (if (= 1 (:block/level block)) - (let [block' (assoc block - :block/left {:db/id (:db/id last-top-level-block)} - :block/parent (:block/parent last-top-level-block))] - (recur (rest blocks) block (conj result block'))) + (do + (assert (:db/id last-top-level-block) (str "last-top-level-block :block/left not exists: " last-top-level-block)) + (let [block' (assoc block + :block/left {:db/id (:db/id last-top-level-block)} + :block/parent (:block/parent last-top-level-block))] + (recur (rest blocks) block (conj result block')))) (recur (rest blocks) last-top-level-block (conj result block))) result))))) @@ -726,6 +735,7 @@ left-exists-in-blocks? (contains? ids (:db/id (:block/left block))) parent (compute-block-parent block parent target-block prev-hop top-level? sibling? get-new-id outliner-op replace-empty-target? idx) left (compute-block-left blocks block left target-block prev-hop idx replace-empty-target? left-exists-in-blocks? get-new-id) + _ (assert (and parent left) (str "Parent or left is nil: " {:parent parent :left left})) m {:db/id (:db/id block) :block/uuid uuid :block/page target-page @@ -873,26 +883,25 @@ (otree/-get-down target-node conn)) next-tx (when (and next (if move? (not (contains? (set (map :db/id blocks)) (:db/id (:data next)))) true)) - (when-let [left (last (filter (fn [b] (= 1 (:block/level b))) tx))] + (if-let [left (last (filter (fn [b] (= 1 (:block/level b))) tx))] [{:block/uuid (otree/-get-id next conn) - :block/left (:db/id left)}])) + :block/left (:db/id left)}] + (prn :debug :insert-blocks :tx tx))) full-tx (common-util/concat-without-nil (if (and keep-uuid? replace-empty-target?) (rest uuids-tx) uuids-tx) tx next-tx)] {:tx-data full-tx :blocks tx})))) -(defn- build-move-blocks-next-tx - [db blocks] - (let [top-level-blocks blocks - top-level-blocks-ids (set (map :db/id top-level-blocks)) - right-block (get-right-sibling db (:db/id (last top-level-blocks)))] - (when (and right-block - (not (contains? top-level-blocks-ids (:db/id right-block)))) - (when-let [left (loop [block (:block/left right-block)] - (if (contains? top-level-blocks-ids (:db/id block)) - (recur (:block/left (d/entity db (:db/id block)))) - (:db/id block)))] - {:db/id (:db/id right-block) - :block/left left})))) +(defn- build-move-block-next-tx + [db block target-block sibling?] + (let [target-id (:db/id target-block)] + [(when-let [right-block (get-right-sibling db (:db/id block))] + {:db/id (:db/id right-block) + :block/left (:db/id (:block/left block))}) + (when-let [target-next-block (if sibling? + (get-right-sibling db (:db/id target-block)) + (ldb/get-by-parent-&-left db target-id target-id))] + {:db/id (:db/id target-next-block) + :block/left (:db/id block)})])) (defn- find-new-left [db block moved-ids target-block current-block {:keys [sibling? delete-blocks?] :as opts}] @@ -911,6 +920,13 @@ (find-new-left db left moved-ids target-block current-block opts) left)))) +(defn- sort-non-consecutive-blocks + [db blocks] + (let [page-blocks (group-by :block/page blocks)] + (mapcat (fn [[_page blocks]] + (ldb/sort-page-random-blocks db blocks)) + page-blocks))) + (defn- fix-non-consecutive-blocks [db blocks target-block sibling? delete-blocks?] (when (> (count blocks) 1) @@ -933,10 +949,11 @@ {:db/id (:db/id right) :block/left (:db/id (last blocks))} :else - (when-let [new-left (find-new-left db right (distinct (map :db/id blocks)) target-block block - {:sibling? sibling? - :delete-blocks? delete-blocks? - :idx idx})] + (let [new-left (find-new-left db right (distinct (map :db/id blocks)) target-block block + {:sibling? sibling? + :delete-blocks? delete-blocks? + :idx idx})] + (assert new-left (str "Can't find new left, :delete-blocks? " delete-blocks?)) {:db/id (:db/id right) :block/left (:db/id new-left)})))) non-consecutive-blocks)))) page-blocks) @@ -957,9 +974,7 @@ `blocks` need to be sorted by left&parent(from top to bottom)" [repo conn date-formatter blocks delete-opts] [:pre [(seq blocks)]] - (let [parent-ids (set/intersection (set (map (comp :db/id :block/parent) blocks)) - (set (map :db/id blocks))) - top-level-blocks (remove (fn [e] (contains? parent-ids (:db/id (:block/parent e)))) blocks) + (let [top-level-blocks (filter-top-level-blocks blocks) txs-state (ds/new-outliner-txs-state) block-ids (map (fn [b] [:block/uuid (:block/uuid b)]) top-level-blocks) start-block (first top-level-blocks) @@ -998,9 +1013,8 @@ :end (d/entity @conn [:block/uuid (otree/-get-id end-node conn)]) :right-node (d/entity @conn [:block/uuid (otree/-get-id right-node conn)]) :blocks top-level-blocks})))) - (when left-node-id - (let [new-right-node (otree/-set-left-id right-node left-node-id conn)] - (otree/-save new-right-node txs-state conn repo date-formatter {}))))))) + (let [new-right-node (otree/-set-left-id right-node left-node-id conn)] + (otree/-save new-right-node txs-state conn repo date-formatter {})))))) (doseq [id block-ids] (let [node (block @conn (d/entity @conn id))] (otree/-del node txs-state conn))) @@ -1017,15 +1031,39 @@ (:db/id target-block)) sibling?))) +(defn- move-block + [db block target-block sibling?] + (let [target-block (d/entity db (:db/id target-block)) + first-block-page (:db/id (:block/page block)) + target-page (or (:db/id (:block/page target-block)) + (:db/id target-block)) + tx-data [{:db/id (:db/id block) + :block/left (:db/id target-block) + :block/parent (if sibling? (:db/id (:block/parent target-block)) (:db/id target-block))}] + not-same-page? (not= first-block-page target-page) + move-blocks-next-tx (build-move-block-next-tx db block target-block sibling?) + children-page-tx (when not-same-page? + (let [children-ids (ldb/get-block-children-ids db (:block/uuid block))] + (map (fn [id] {:block/uuid id + :block/page target-page}) children-ids)))] + (common-util/concat-without-nil tx-data move-blocks-next-tx children-page-tx))) + (defn- move-blocks "Move `blocks` to `target-block` as siblings or children." - [repo conn blocks target-block {:keys [_sibling? _up? outliner-op _indent?] - :as opts}] + [_repo conn blocks target-block {:keys [_sibling? _up? outliner-op _indent?] + :as opts}] {:pre [(seq blocks) (m/validate block-map-or-entity target-block)]} + (assert (every? (fn [block] (and (:db/id (:block/parent block)) (:db/id (:block/left block)))) blocks) + (str "Invalid blocks (without either parent or left): " + (remove (fn [block] (and (:db/id (:block/parent block)) (:db/id (:block/left block)))) blocks))) (let [db @conn + blocks (filter-top-level-blocks blocks) [target-block sibling?] (get-target-block db blocks target-block opts) non-consecutive-blocks? (seq (ldb/get-non-consecutive-blocks db blocks)) + blocks (if non-consecutive-blocks? + (sort-non-consecutive-blocks db blocks) + blocks) original-position? (move-to-original-position? blocks target-block sibling? non-consecutive-blocks?)] (when (and (not (contains? (set (map :db/id blocks)) (:db/id target-block))) (not original-position?)) @@ -1034,42 +1072,28 @@ (set)) move-parents-to-child? (some parents (map :db/id blocks))] (when-not move-parents-to-child? - (let [first-block (first blocks) - {:keys [tx-data]} (insert-blocks repo conn blocks target-block {:sibling? sibling? - :outliner-op (or outliner-op :move-blocks) - :update-timestamps? false})] - (when (seq tx-data) - (let [first-block-page (:db/id (:block/page first-block)) - target-page (or (:db/id (:block/page target-block)) - (:db/id target-block)) - not-same-page? (not= first-block-page target-page) - move-blocks-next-tx (when-not non-consecutive-blocks? - [(build-move-blocks-next-tx db blocks)]) - children-page-tx (when not-same-page? - (let [children-ids (mapcat #(ldb/get-block-children-ids db (:block/uuid %)) - blocks)] - (map (fn [id] {:block/uuid id - :block/page target-page}) children-ids))) - fix-non-consecutive-tx (when non-consecutive-blocks? - (->> (fix-non-consecutive-blocks db blocks target-block sibling? false) - (remove (fn [b] - (contains? (set (map :db/id move-blocks-next-tx)) (:db/id b)))))) - full-tx (common-util/concat-without-nil tx-data move-blocks-next-tx children-page-tx fix-non-consecutive-tx) - tx-meta (cond-> {:move-blocks (mapv :db/id blocks) - :move-op outliner-op - :target (:db/id target-block)} - not-same-page? - (assoc :from-page first-block-page - :target-page target-page))] - {:tx-data full-tx - :tx-meta tx-meta})))))))) + (batch-tx/with-batch-tx-mode conn + (doseq [[idx block] (map vector (range (count blocks)) blocks)] + (let [first-block? (zero? idx) + sibling? (if first-block? sibling? true) + target-block (if first-block? target-block + (d/entity @conn (:db/id (nth blocks (dec idx))))) + block (d/entity @conn (:db/id block))] + (when-not (and (= (:db/id (:block/left block)) (:db/id target-block)) + (if sibling? + (= (:db/id (:block/parent block)) (:db/id (:block/parent target-block))) + (= (:db/id (:block/parent block)) (:db/id target-block)))) + (let [tx-data (move-block @conn block target-block sibling?)] + (ldb/transact! conn tx-data {:sibling? sibling? + :outliner-op (or outliner-op :move-blocks)})))))) + nil))))) (defn- move-blocks-up-down "Move blocks up/down." [repo conn blocks up?] {:pre [(seq blocks) (boolean? up?)]} (let [db @conn - top-level-blocks blocks + top-level-blocks (filter-top-level-blocks blocks) opts {:outliner-op :move-blocks-up-down}] (if up? (let [first-block (d/entity db (:db/id (first top-level-blocks))) @@ -1103,7 +1127,8 @@ [repo conn blocks indent? & {:keys [parent-original logical-outdenting?]}] {:pre [(seq blocks) (boolean? indent?)]} (let [db @conn - top-level-blocks (map (fn [b] (d/entity db (:db/id b))) blocks) + top-level-blocks (->> (map (fn [b] (d/entity db (:db/id b))) blocks) + filter-top-level-blocks) non-consecutive-blocks (ldb/get-non-consecutive-blocks db top-level-blocks)] (when (empty? non-consecutive-blocks) (let [first-block (d/entity db (:db/id (first top-level-blocks))) diff --git a/src/main/frontend/worker/db/fix.cljs b/src/main/frontend/worker/db/fix.cljs index 5df8c9bad..9e40bf531 100644 --- a/src/main/frontend/worker/db/fix.cljs +++ b/src/main/frontend/worker/db/fix.cljs @@ -21,9 +21,10 @@ invalid-left? (not (every? (fn [b] (contains? valid-left-ids (:db/id (:block/left b)))) blocks)) broken-chain? (or (not= (count sorted) (count blocks)) invalid-left?)] (when (and (not from-fix-test?) (exists? js/process) broken-chain?) - (throw (ex-info "outliner broken chain" {:tx-meta (:tx-meta tx-report) + (throw (ex-info "outliner broken chain" {:type (if invalid-left? :invalid-left :broken-chain) + :tx-meta (:tx-meta tx-report) :tx-data (:tx-data tx-report) - :db-before (:db-before tx-report)}))) + :db-before (ldb/write-transit-str (:db-before tx-report))}))) (when broken-chain? (let [parent-data {:db/id parent-id :block/uuid (:block/uuid parent) @@ -157,7 +158,7 @@ conflicts (get-conflicts db page-id) _ (when (and (not from-fix-test?) (exists? js/process) (seq conflicts)) (throw (ex-info "outliner core conflicts" {:conflicts conflicts - :db-before (:db-before tx-report) + :db-before (ldb/write-transit-str (:db-before tx-report)) :tx-data (:tx-data tx-report) :tx-meta (:tx-meta tx-report)}))) fix-conflicts-tx (when (seq conflicts) diff --git a/src/test/frontend/modules/outliner/core_test.cljs b/src/test/frontend/modules/outliner/core_test.cljs index 256184363..4f6ec5d28 100644 --- a/src/test/frontend/modules/outliner/core_test.cljs +++ b/src/test/frontend/modules/outliner/core_test.cljs @@ -13,10 +13,22 @@ [datascript.core :as d] [frontend.test.helper :as test-helper :refer [load-test-files]] [frontend.state :as state] - [clojure.set :as set])) + [clojure.set :as set] + [frontend.db.conn :as conn] + [frontend.worker.db-listener :as worker-db-listener])) (def test-db test-helper/test-db) +(defn listen-db-fixture + [f] + (let [test-db-conn (conn/get-db test-db false)] + (assert (some? test-db-conn)) + (worker-db-listener/listen-db-changes! test-db test-db-conn + {:handler-keys [:sync-db-to-main-thread]}) + + (f) + (d/unlisten! test-db-conn :frontend.worker.db-listener/listen-db-changes!))) + (defn disable-browser-fns [f] ;; get-selection-blocks has a js/document reference @@ -26,7 +38,8 @@ (use-fixtures :each disable-browser-fns fixtures/react-components - fixtures/reset-db) + fixtures/reset-db + listen-db-fixture) (defn get-block ([id] @@ -79,6 +92,7 @@ (defn transact-tree! [tree] (let [blocks (build-blocks tree)] + (assert (every? (fn [block] (and (:block/parent block) (:block/left block))) blocks) (str "Invalid blocks: " blocks)) (db/transact! test-db (concat [{:db/id 1 :block/uuid 1 :block/name "Test page"}] @@ -645,24 +659,33 @@ tags:: tag1, tag2 (let [datoms (->> (get-datoms) (remove (fn [datom] (= 1 (:e datom)))))] (if (seq datoms) - (let [id (:e (gen/generate (gen/elements datoms)))] - (db/pull test-db '[*] id)) + (let [id (:e (gen/generate (gen/elements datoms))) + block (db/pull test-db '[*] id)] + (assert (and (:block/left block) (:block/parent block)) + (str "No left or parent for block: " block)) + block) (do (transact-random-tree!) (get-random-block))))) -(defn get-random-successive-blocks +(comment + (defn get-random-successive-blocks + [] + (let [limit (inc (rand-int 20))] + (when-let [block (get-random-block)] + (loop [result [block] + node block] + (if-let [next (outliner-core/get-right-sibling (db/get-db test-db) (:db/id node))] + (let [next (db/pull test-db '[*] (:db/id next))] + (if (>= (count result) limit) + result + (recur (conj result next) next))) + result)))))) + +(defn get-random-blocks [] (let [limit (inc (rand-int 20))] - (when-let [block (get-random-block)] - (loop [result [block] - node block] - (if-let [next (outliner-core/get-right-sibling (db/get-db test-db) (:db/id node))] - (let [next (db/pull test-db '[*] (:db/id next))] - (if (>= (count result) limit) - result - (recur (conj result next) next))) - result))))) + (repeatedly limit get-random-block))) (deftest ^:long random-inserts (testing "Random inserts" @@ -684,7 +707,7 @@ tags:: tag1, tag2 (dotimes [_i 100] ;; (prn "Random deletes: " i) (insert-blocks! (gen-blocks) (get-random-block)) - (let [blocks (get-random-successive-blocks)] + (let [blocks (get-random-blocks)] (when (seq blocks) (outliner-tx/transact! (transact-opts) (outliner-core/delete-blocks! test-db (db/get-db test-db false) @@ -702,7 +725,7 @@ tags:: tag1, tag2 (swap! *random-blocks (fn [old] (set/union old (set (map :block/uuid blocks))))) (insert-blocks! blocks (get-random-block))) - (let [blocks (get-random-successive-blocks)] + (let [blocks (get-random-blocks)] (when (seq blocks) (let [target (get-random-block)] (outliner-tx/transact! (transact-opts) @@ -721,7 +744,7 @@ tags:: tag1, tag2 (swap! *random-blocks (fn [old] (set/union old (set (map :block/uuid blocks))))) (insert-blocks! blocks (get-random-block))) - (let [blocks (get-random-successive-blocks)] + (let [blocks (get-random-blocks)] (when (seq blocks) (outliner-tx/transact! (transact-opts) (outliner-core/move-blocks-up-down! test-db (db/get-db test-db false) blocks (gen/generate gen/boolean))) @@ -739,7 +762,7 @@ tags:: tag1, tag2 (swap! *random-blocks (fn [old] (set/union old (set (map :block/uuid new-blocks))))) (insert-blocks! new-blocks (get-random-block)) - (let [blocks (get-random-successive-blocks) + (let [blocks (get-random-blocks) indent? (gen/generate gen/boolean)] (when (seq blocks) (outliner-tx/transact! (transact-opts) @@ -761,7 +784,7 @@ tags:: tag1, tag2 ;; delete (fn [] - (let [blocks (get-random-successive-blocks)] + (let [blocks (get-random-blocks)] (when (seq blocks) (swap! *random-blocks (fn [old] (set/difference old (set (map :block/uuid blocks))))) @@ -772,7 +795,7 @@ tags:: tag1, tag2 ;; move (fn [] - (let [blocks (get-random-successive-blocks)] + (let [blocks (get-random-blocks)] (when (seq blocks) (outliner-tx/transact! (transact-opts) (outliner-core/move-blocks! test-db @@ -780,15 +803,15 @@ tags:: tag1, tag2 blocks (get-random-block) (gen/generate gen/boolean)))))) ;; move up down - (fn [] - (let [blocks (get-random-successive-blocks)] - (when (seq blocks) - (outliner-tx/transact! (transact-opts) - (outliner-core/move-blocks-up-down! test-db (db/get-db test-db false) blocks (gen/generate gen/boolean)))))) + ;; (fn [] + ;; (let [blocks (get-random-blocks)] + ;; (when (seq blocks) + ;; (outliner-tx/transact! (transact-opts) + ;; (outliner-core/move-blocks-up-down! test-db (db/get-db test-db false) blocks (gen/generate gen/boolean)))))) ;; indent outdent (fn [] - (let [blocks (get-random-successive-blocks)] + (let [blocks (get-random-blocks)] (when (seq blocks) (outliner-tx/transact! (transact-opts) (outliner-core/indent-outdent-blocks! test-db (db/get-db test-db false) blocks (gen/generate gen/boolean))))))]] diff --git a/src/test/frontend/worker/fixtures.cljs b/src/test/frontend/worker/fixtures.cljs index 69f152446..83c4594e8 100644 --- a/src/test/frontend/worker/fixtures.cljs +++ b/src/test/frontend/worker/fixtures.cljs @@ -12,7 +12,9 @@ (assert (some? test-db-conn)) (worker-undo-redo/clear-undo-redo-stack) (worker-db-listener/listen-db-changes! test-helper/test-db-name-db-version test-db-conn - {:handler-keys [:gen-undo-ops :sync-db-to-main-thread]}) + {:handler-keys [:gen-undo-ops + ;; :sync-db-to-main-thread + ]}) (f) (d/unlisten! test-db-conn :frontend.worker.db-listener/listen-db-changes!)))