|
56 | 56 |
|
57 | 57 | (defn clear-history! |
58 | 58 | [repo] |
59 | | - (prn :debug :clear-undo-history repo) |
60 | 59 | (swap! *undo-ops assoc repo []) |
61 | 60 | (swap! *redo-ops assoc repo [])) |
62 | 61 |
|
|
204 | 203 | not-exists-in-current-db |
205 | 204 | (not removed-before-parent)))))))) |
206 | 205 |
|
| 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 | + |
207 | 293 | (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] |
209 | 295 | (try |
210 | 296 | (let [redo? (not undo?) |
211 | 297 | e->datoms (->> (if redo? tx-data (reverse tx-data)) |
212 | 298 | (group-by :e)) |
213 | 299 | 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) |
247 | 332 | (catch :default e |
248 | 333 | (prn :debug :undo-redo :error (:error (ex-data e))) |
249 | 334 | (when-not (contains? #{:block-moved-or-target-deleted |
250 | | - :block-children-exists} |
| 335 | + :block-children-exists |
| 336 | + :block-parent-missing} |
251 | 337 | (:error (ex-data e))) |
252 | 338 | (throw e))))) |
253 | 339 |
|
|
0 commit comments