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

@@ -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)))

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)

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))))))]]

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!)))