Skip to content

Commit 7c5146a

Browse files
committed
fix(sync): improve undo/redo merge reliability
1 parent e7e7313 commit 7c5146a

6 files changed

Lines changed: 1065 additions & 227 deletions

File tree

src/main/frontend/undo_redo.cljs

Lines changed: 122 additions & 36 deletions
Original file line numberDiff line numberDiff line change
@@ -56,7 +56,6 @@
5656

5757
(defn clear-history!
5858
[repo]
59-
(prn :debug :clear-undo-history repo)
6059
(swap! *undo-ops assoc repo [])
6160
(swap! *redo-ops assoc repo []))
6261

@@ -204,50 +203,137 @@
204203
not-exists-in-current-db
205204
(not removed-before-parent))))))))
206205

206+
(defn- tx-added-attrs
207+
[tx-data]
208+
(reduce (fn [acc [op e a v]]
209+
(if (= :db/add op)
210+
(update acc e assoc a v)
211+
acc))
212+
{}
213+
tx-data))
214+
215+
(defn- entity-exists-or-added?
216+
[conn added-attrs id]
217+
(or (contains? added-attrs id)
218+
(some? (d/entity @conn id))))
219+
220+
(defn- assert-reversed-tx-safe!
221+
[conn reversed-tx-data]
222+
(let [added-attrs (tx-added-attrs reversed-tx-data)
223+
ops-by-entity (group-by second reversed-tx-data)]
224+
(doseq [[e ops] ops-by-entity]
225+
(let [retract-entity? (some #(= :db/retractEntity (first %)) ops)
226+
retract-parent? (some #(and (= :db/retract (first %))
227+
(= :block/parent (nth % 2)))
228+
ops)
229+
add-parent? (some #(and (= :db/add (first %))
230+
(= :block/parent (nth % 2)))
231+
ops)
232+
retract-page? (some #(and (= :db/retract (first %))
233+
(= :block/page (nth % 2)))
234+
ops)
235+
add-page? (some #(and (= :db/add (first %))
236+
(= :block/page (nth % 2)))
237+
ops)]
238+
;; Moving blocks must not leave entities without parent/page refs.
239+
(when (and (not retract-entity?)
240+
retract-parent?
241+
(not add-parent?))
242+
(throw (ex-info "Reversed tx retracts parent without replacement"
243+
{:error :block-moved-or-target-deleted
244+
:entity-id e
245+
:ops ops})))
246+
(when (and (not retract-entity?)
247+
retract-page?
248+
(not add-page?))
249+
(throw (ex-info "Reversed tx retracts page without replacement"
250+
{:error :block-moved-or-target-deleted
251+
:entity-id e
252+
:ops ops})))))
253+
(doseq [[e attrs] added-attrs]
254+
(let [existing (d/entity @conn e)
255+
new-entity? (nil? existing)
256+
page? (or (:block/name attrs) (:block/name existing))
257+
parent (:block/parent attrs)
258+
page (:block/page attrs)]
259+
;; Redoing a block creation must restore parent/page refs.
260+
(when (and new-entity?
261+
(not page?)
262+
(not (contains? attrs :block/uuid)))
263+
(throw (ex-info "Missing block identity in reversed tx"
264+
{:error :block-moved-or-target-deleted
265+
:entity-id e
266+
:attrs attrs})))
267+
268+
(when (and new-entity?
269+
(contains? attrs :block/uuid)
270+
(not page?)
271+
(nil? parent))
272+
(throw (ex-info "Missing block parent in reversed tx"
273+
{:error :block-parent-missing
274+
:entity-id e
275+
:attrs attrs})))
276+
277+
(when (and parent
278+
(not (entity-exists-or-added? conn added-attrs parent)))
279+
(throw (ex-info "Parent deleted in reversed tx"
280+
{:error :block-moved-or-target-deleted
281+
:entity-id e
282+
:parent-id parent
283+
:attrs attrs})))
284+
285+
(when (and page
286+
(not (entity-exists-or-added? conn added-attrs page)))
287+
(throw (ex-info "Page deleted in reversed tx"
288+
{:error :block-moved-or-target-deleted
289+
:entity-id e
290+
:page-id page
291+
:attrs attrs})))))))
292+
207293
(defn get-reversed-datoms
208-
[conn undo? {:keys [tx-data added-ids retracted-ids] :as op} tx-meta]
294+
[conn undo? {:keys [tx-data added-ids retracted-ids] :as op} _tx-meta]
209295
(try
210296
(let [redo? (not undo?)
211297
e->datoms (->> (if redo? tx-data (reverse tx-data))
212298
(group-by :e))
213299
schema (:schema @conn)
214-
moved-blocks (get-moved-blocks e->datoms)]
215-
(->>
216-
(mapcat
217-
(fn [[e datoms]]
218-
(let [entity (d/entity @conn e)]
219-
(cond
220-
;; new children blocks have been added
221-
(and
222-
(not (:local-tx? tx-meta))
223-
(or (and (contains? retracted-ids e) redo?
224-
(other-children-exist? entity retracted-ids)) ; redo delete-blocks
225-
(and (contains? added-ids e) undo? ; undo insert-blocks
226-
(other-children-exist? entity added-ids))))
227-
(throw (ex-info "Children still exists"
228-
(merge op {:error :block-children-exists
229-
:undo? undo?})))
230-
231-
;; block has been moved or target got deleted by another client
232-
(block-moved-and-target-deleted? conn e->datoms e moved-blocks tx-data)
233-
(throw (ex-info "This block has been moved or its target has been deleted"
234-
(merge op {:error :block-moved-or-target-deleted
235-
:undo? undo?})))
236-
237-
;; The entity should be deleted instead of retracting its attributes
238-
(and entity
239-
(or (and (contains? retracted-ids e) redo?) ; redo delete-blocks
240-
(and (contains? added-ids e) undo?))) ; undo insert-blocks
241-
[[:db/retractEntity e]]
242-
243-
:else
244-
(reverse-datoms conn datoms schema added-ids retracted-ids undo? redo?))))
245-
e->datoms)
246-
(remove nil?)))
300+
moved-blocks (get-moved-blocks e->datoms)
301+
reversed-tx-data (->> (mapcat
302+
(fn [[e datoms]]
303+
(let [entity (d/entity @conn e)]
304+
(cond
305+
;; New children may have been added after the original op.
306+
(or (and (contains? retracted-ids e) redo?
307+
(other-children-exist? entity retracted-ids)) ; redo delete-blocks
308+
(and (contains? added-ids e) undo?
309+
(other-children-exist? entity added-ids))) ; undo insert-blocks
310+
(throw (ex-info "Children still exists"
311+
(merge op {:error :block-children-exists
312+
:undo? undo?})))
313+
314+
;; Block has moved or target got deleted.
315+
(block-moved-and-target-deleted? conn e->datoms e moved-blocks tx-data)
316+
(throw (ex-info "This block has been moved or its target has been deleted"
317+
(merge op {:error :block-moved-or-target-deleted
318+
:undo? undo?})))
319+
320+
;; Delete entity instead of retracting attrs one-by-one.
321+
(and entity
322+
(or (and (contains? retracted-ids e) redo?) ; redo delete-blocks
323+
(and (contains? added-ids e) undo?))) ; undo insert-blocks
324+
[[:db/retractEntity e]]
325+
326+
:else
327+
(reverse-datoms conn datoms schema added-ids retracted-ids undo? redo?))))
328+
e->datoms)
329+
(remove nil?))]
330+
(assert-reversed-tx-safe! conn reversed-tx-data)
331+
reversed-tx-data)
247332
(catch :default e
248333
(prn :debug :undo-redo :error (:error (ex-data e)))
249334
(when-not (contains? #{:block-moved-or-target-deleted
250-
:block-children-exists}
335+
:block-children-exists
336+
:block-parent-missing}
251337
(:error (ex-data e)))
252338
(throw e)))))
253339

0 commit comments

Comments
 (0)