fix: undo redo ops

This commit is contained in:
Tienson Qin
2026-03-21 15:56:55 +08:00
parent fe97e890d6
commit 5d713931a2
3 changed files with 285 additions and 31 deletions

View File

@@ -256,7 +256,10 @@
(defn- block-property-value
[db block-id property-id]
(some-> (d/entity db block-id) (get property-id) (property-ref-value db property-id)))
(some->>
(some-> (d/entity db block-id)
(get property-id))
(property-ref-value db property-id)))
(defn- build-inverse-property-op
[db-before [op args]]
@@ -308,15 +311,35 @@
:insert-blocks
(let [[blocks target-id opts] args
created-uuids (created-block-uuids-from-tx-data tx-data)
blocks' (if (and (not (:keep-uuid? opts))
(= (count blocks) (count created-uuids)))
target-ref (stable-entity-ref db target-id)
target-uuid (when (and (vector? target-ref)
(= :block/uuid (first target-ref)))
(second target-ref))
blocks' (cond
(and (:replace-empty-target? opts)
target-uuid
(seq blocks))
(let [[fst-block & rst-blocks] blocks]
(into [(assoc fst-block :block/uuid target-uuid)]
(if (and (not (:keep-uuid? opts))
(= (count rst-blocks) (count created-uuids)))
(map (fn [block uuid]
(assoc block :block/uuid uuid))
rst-blocks
created-uuids)
rst-blocks)))
(and (not (:keep-uuid? opts))
(= (count blocks) (count created-uuids)))
(mapv (fn [block uuid]
(assoc block :block/uuid uuid))
blocks
created-uuids)
:else
blocks)]
[:insert-blocks [blocks'
(stable-entity-ref db target-id)
target-ref
(assoc (dissoc (or opts {}) :outliner-op)
:keep-uuid? true)]])
@@ -339,17 +362,35 @@
(build-inverse-save-block db-before block opts))
:insert-blocks
(let [[blocks _target-id _opts] args
ids (->> blocks
(keep (fn [block]
(when-let [u (:block/uuid block)]
[:block/uuid u])))
vec)]
(when (seq ids)
[:delete-blocks [ids {}]]))
(let [[blocks _target-id opts] args]
(if (:replace-empty-target? opts)
(let [[fst-block & rst-blocks] blocks
delete-ids (->> rst-blocks
(keep (fn [block]
(when-let [u (:block/uuid block)]
[:block/uuid u])))
vec)
restore-target-op (when fst-block
(build-inverse-save-block db-before fst-block nil))]
(concat
(when (seq delete-ids)
[[:delete-blocks [delete-ids {}]]])
(when restore-target-op
[restore-target-op])))
(let [ids (->> blocks
(keep (fn [block]
(when-let [u (:block/uuid block)]
[:block/uuid u])))
vec)]
(when (seq ids)
[[:delete-blocks [ids {}]]]))))
(build-inverse-property-op db-before op-entry))))
(remove nil?)
(mapcat #(if (and (sequential? %)
(sequential? (first %)))
%
[%]))
vec
seq))
@@ -640,4 +681,7 @@
(defn listen-db-changes!
[repo conn]
(d/listen! conn ::gen-undo-ops
(fn [tx-report] (gen-undo-ops! repo tx-report))))
(fn [tx-report]
(when-not (:db-before tx-report)
(throw (ex-info "no-db" {})))
(gen-undo-ops! repo tx-report))))

View File

@@ -370,15 +370,35 @@
(let [[blocks target-id opts] args
created-uuids (created-block-uuids-from-tx-data tx-data)
blocks' (mapv #(sanitize-insert-block-payload db %) blocks)
blocks' (if (and (not (:keep-uuid? opts))
(= (count blocks') (count created-uuids)))
target-ref (stable-entity-ref db target-id)
target-uuid (when (and (vector? target-ref)
(= :block/uuid (first target-ref)))
(second target-ref))
blocks' (cond
(and (:replace-empty-target? opts)
target-uuid
(seq blocks'))
(let [[fst-block & rst-blocks] blocks']
(into [(assoc fst-block :block/uuid target-uuid)]
(if (and (not (:keep-uuid? opts))
(= (count rst-blocks) (count created-uuids)))
(map (fn [block uuid]
(assoc block :block/uuid uuid))
rst-blocks
created-uuids)
rst-blocks)))
(and (not (:keep-uuid? opts))
(= (count blocks') (count created-uuids)))
(mapv (fn [block uuid]
(assoc block :block/uuid uuid))
blocks'
created-uuids)
:else
blocks')]
[:insert-blocks [blocks'
(stable-entity-ref db target-id)
target-ref
(assoc (dissoc (or opts {}) :outliner-op)
:keep-uuid? true)]])
@@ -532,14 +552,28 @@
(worker-build-inverse-save-block db-before block opts))
:insert-blocks
(let [[blocks _target-id _opts] args
ids (->> blocks
(keep (fn [block]
(when-let [u (:block/uuid block)]
[:block/uuid u])))
vec)]
(when (seq ids)
[:delete-blocks [ids {}]]))
(let [[blocks _target-id opts] args]
(if (:replace-empty-target? opts)
(let [[fst-block & rst-blocks] blocks
delete-ids (->> rst-blocks
(keep (fn [block]
(when-let [u (:block/uuid block)]
[:block/uuid u])))
vec)
restore-target-op (when fst-block
(worker-build-inverse-save-block db-before fst-block nil))]
(concat
(when (seq delete-ids)
[[:delete-blocks [delete-ids {}]]])
(when restore-target-op
[restore-target-op])))
(let [ids (->> blocks
(keep (fn [block]
(when-let [u (:block/uuid block)]
[:block/uuid u])))
vec)]
(when (seq ids)
[[:delete-blocks [ids {}]]]))))
:create-page
(let [[_title opts] args
@@ -549,9 +583,20 @@
nil)))
(remove nil?)
(mapcat #(if (and (sequential? %)
(sequential? (first %)))
%
[%]))
vec
seq))
(defn- has-replace-empty-target-insert-op?
[forward-ops]
(some (fn [[op [_blocks _target-id opts]]]
(and (= :insert-blocks op)
(:replace-empty-target? opts)))
forward-ops))
(defn- canonicalize-explicit-outliner-ops
[db tx-data ops]
(cond
@@ -571,6 +616,28 @@
:else
nil))
(defn- patch-inverse-delete-block-ops
[inverse-outliner-ops forward-outliner-ops]
(let [forward-insert-ops* (atom (->> forward-outliner-ops
reverse
(filter #(= :insert-blocks (first %)))
vec))]
(mapv (fn [[op args :as inverse-op]]
(if (and (= :delete-blocks op)
(seq @forward-insert-ops*))
(let [[_ [blocks _target-id _opts]] (first @forward-insert-ops*)
ids (->> blocks
(keep (fn [block]
(when-let [uuid (:block/uuid block)]
[:block/uuid uuid])))
vec)]
(swap! forward-insert-ops* subvec 1)
(if (seq ids)
[:delete-blocks [ids (second args)]]
inverse-op))
inverse-op))
inverse-outliner-ops)))
(defn- canonicalize-outliner-ops
[db tx-meta tx-data]
(let [explicit-forward-ops (:db-sync/forward-outliner-ops tx-meta)
@@ -609,11 +676,18 @@
(let [tx-id (or (:db-sync/tx-id tx-meta) (random-uuid))
now (.now js/Date)
outliner-ops (canonicalize-outliner-ops db-after tx-meta tx-data)
inverse-outliner-ops (canonicalize-explicit-outliner-ops
db-after
tx-data
(or (:db-sync/inverse-outliner-ops tx-meta)
(build-worker-inverse-outliner-ops db-before outliner-ops)))
built-inverse-outliner-ops (build-worker-inverse-outliner-ops db-before outliner-ops)
inverse-outliner-ops (if (has-replace-empty-target-insert-op? outliner-ops)
built-inverse-outliner-ops
(if-let [explicit-inverse-outliner-ops (:db-sync/inverse-outliner-ops tx-meta)]
(some-> (canonicalize-explicit-outliner-ops
db-after
tx-data
explicit-inverse-outliner-ops)
(patch-inverse-delete-block-ops outliner-ops)
seq
vec)
built-inverse-outliner-ops))
inferred-outliner-ops?' (inferred-outliner-ops? tx-meta)]
(ldb/transact! conn [{:db-sync/tx-id tx-id
:db-sync/normalized-tx-data normalized-tx-data
@@ -682,9 +756,23 @@
(defn- history-action-ops
[{:keys [forward-outliner-ops inverse-outliner-ops outliner-ops]} undo?]
(let [ops (if undo? inverse-outliner-ops forward-outliner-ops)]
(let [semantic-undo-supported-forward-ops
#{:save-block
:insert-blocks
:create-page
:move-blocks-up-down
:indent-outdent-blocks}
semantic-undo-complete? (and (seq inverse-outliner-ops)
(every? (fn [[op]]
(contains? semantic-undo-supported-forward-ops op))
forward-outliner-ops))
ops (if undo?
(when semantic-undo-complete?
inverse-outliner-ops)
forward-outliner-ops)]
(or (some-> ops seq vec)
(when-not (= canonical-transact-op outliner-ops)
(when (and (not undo?)
(not= canonical-transact-op outliner-ops))
(some-> outliner-ops seq vec)))))
(defn- history-action-tx-data

View File

@@ -1141,6 +1141,71 @@
(is (= "child 1 inline edit"
(:block/title (d/entity @conn [:block/uuid child-uuid]))))))))))
(deftest apply-history-action-redo-replays-status-property-test
(testing "apply-history-action should redo a status property change"
(let [conn (db-test/create-conn-with-blocks
{:pages-and-blocks
[{:page {:block/title "page1"}
:blocks [{:block/title "task"
:build/properties {:status "Todo"}}]}]})
client-ops-conn (d/create-conn client-op/schema-in-db)]
(with-datascript-conns conn client-ops-conn
(fn []
(let [task (db-test/find-block-by-content @conn "task")
task-uuid (:block/uuid task)]
(outliner-property/set-block-property! conn
(:db/id task)
:logseq.property/status
"Doing")
(let [{:keys [tx-id]} (first (#'sync-apply/pending-txs test-repo))]
(is (= true
(:applied? (#'sync-apply/apply-history-action! test-repo tx-id true {}))))
(is (= :logseq.property/status.todo
(some-> (d/entity @conn [:block/uuid task-uuid])
:logseq.property/status
:db/ident)))
(is (= true
(:applied? (#'sync-apply/apply-history-action! test-repo tx-id false {}))))
(is (= :logseq.property/status.doing
(some-> (d/entity @conn [:block/uuid task-uuid])
:logseq.property/status
:db/ident))))))))))
(deftest apply-history-action-redo-replays-block-concat-test
(testing "block concat history should undo via reversed tx and redo cleanly"
(let [conn (db-test/create-conn-with-blocks
{:pages-and-blocks
[{:page {:block/title "page1"}
:blocks [{:block/title "hellohello"}
{:block/title "hello"}]}]})
client-ops-conn (d/create-conn client-op/schema-in-db)]
(with-datascript-conns conn client-ops-conn
(fn []
(let [left (db-test/find-block-by-content @conn "hellohello")
right (db-test/find-block-by-content @conn "hello")
left-uuid (:block/uuid left)
right-uuid (:block/uuid right)]
(outliner-op/apply-ops! conn
[[:delete-blocks [[(:db/id right)]
{:deleted-by-uuid (random-uuid)}]]
[:save-block [{:block/uuid left-uuid
:block/title "hellohellohello"} nil]]]
local-tx-meta)
(let [{:keys [tx-id]} (first (#'sync-apply/pending-txs test-repo))]
(is (= "hellohellohello"
(:block/title (d/entity @conn [:block/uuid left-uuid]))))
(is (nil? (d/entity @conn [:block/uuid right-uuid])))
(is (= true
(:applied? (#'sync-apply/apply-history-action! test-repo tx-id true {}))))
(is (= "hellohello"
(:block/title (d/entity @conn [:block/uuid left-uuid]))))
(is (some? (d/entity @conn [:block/uuid right-uuid])))
(is (= true
(:applied? (#'sync-apply/apply-history-action! test-repo tx-id false {}))))
(is (= "hellohellohello"
(:block/title (d/entity @conn [:block/uuid left-uuid]))))
(is (nil? (d/entity @conn [:block/uuid right-uuid]))))))))))
(deftest apply-history-action-redo-replays-save-then-insert-test
(testing "apply-history-action should redo a combined save-block then insert-block history action"
(let [{:keys [conn client-ops-conn child1]} (setup-parent-child)
@@ -1178,6 +1243,63 @@
(is (= "inserted after save"
(:block/title (d/entity @conn [:block/uuid inserted-uuid']))))))))))
(deftest apply-history-action-redo-replays-paste-into-empty-target-test
(testing "redo should replay paste into an empty target block without invalid rebase op"
(let [conn (db-test/create-conn-with-blocks
{:pages-and-blocks
[{:page {:block/title "page 1"}
:blocks [{:block/title "first"}
{:block/title ""}]}]})
client-ops-conn (d/create-conn client-op/schema-in-db)
empty-target (db-test/find-block-by-content @conn "")
empty-target-uuid (:block/uuid empty-target)
parent-uuid (random-uuid)
copied-blocks [{:block/uuid parent-uuid
:block/title "paste parent"}
{:block/uuid (random-uuid)
:block/title "paste child"
:block/parent [:block/uuid parent-uuid]}]]
(with-datascript-conns conn client-ops-conn
(fn []
(outliner-op/apply-ops! conn
[[:insert-blocks [copied-blocks
(:db/id empty-target)
{:sibling? true
:outliner-op :paste
:replace-empty-target? true}]]]
local-tx-meta)
(let [pending (first (#'sync-apply/pending-txs test-repo))
{:keys [tx-id]} pending
pasted-id (d/q '[:find ?e .
:in $ ?title
:where
[?e :block/title ?title]]
@conn
"paste parent")
pasted-child-id (d/q '[:find ?e .
:in $ ?title
:where
[?e :block/title ?title]]
@conn
"paste child")
pasted (d/entity @conn pasted-id)
pasted-uuid (:block/uuid pasted)
pasted-child-uuid (:block/uuid (d/entity @conn pasted-child-id))]
(is (some #(and (= :save-block (first %))
(= empty-target-uuid (get-in % [1 0 :block/uuid])))
(:inverse-outliner-ops pending)))
(is (= true
(:applied? (#'sync-apply/apply-history-action! test-repo tx-id true {}))))
(let [restored-target (d/entity @conn [:block/uuid empty-target-uuid])]
(is (some? restored-target))
(is (= "" (:block/title restored-target))))
(is (nil? (d/entity @conn [:block/uuid pasted-child-uuid])))
(is (= true
(:applied? (#'sync-apply/apply-history-action! test-repo tx-id false {}))))
(let [redone (d/entity @conn [:block/uuid pasted-uuid])]
(is (some? redone))
(is (= "paste parent" (:block/title redone))))))))))
(deftest direct-outliner-core-insert-blocks-persists-insert-blocks-outliner-op-test
(testing "direct outliner-core/insert-blocks! still persists singleton insert-blocks outliner-ops"
(let [{:keys [conn client-ops-conn parent]} (setup-parent-child)]