mirror of https://github.com/logseq/logseq
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.pull/11293/head
Tienson Qin
parent
afd76f24d4
commit
08c5cc18d0
|
|
@ -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))
|
||||
(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) 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)))]
|
||||
(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 left}))))
|
||||
: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
|
||||
(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 {})))))))
|
||||
(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?]
|
||||
[_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)))
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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,12 +659,16 @@ 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)))))
|
||||
|
||||
(comment
|
||||
(defn get-random-successive-blocks
|
||||
[]
|
||||
(let [limit (inc (rand-int 20))]
|
||||
|
|
@ -662,7 +680,12 @@ tags:: tag1, tag2
|
|||
(if (>= (count result) limit)
|
||||
result
|
||||
(recur (conj result next) next)))
|
||||
result)))))
|
||||
result))))))
|
||||
|
||||
(defn get-random-blocks
|
||||
[]
|
||||
(let [limit (inc (rand-int 20))]
|
||||
(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))))))]]
|
||||
|
|
|
|||
|
|
@ -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!)))
|
||||
|
|
|
|||
Loading…
Reference in New Issue