Skip to content

Commit

Permalink
Add tests for the new undo/redo
Browse files Browse the repository at this point in the history
  • Loading branch information
@tiensonqin
tiensonqin committed May 16, 2024
1 parent 1822631 commit 55cec66
Show file tree
Hide file tree
Showing 3 changed files with 174 additions and 98 deletions.
32 changes: 18 additions & 14 deletions src/main/frontend/worker/undo_redo2.cljs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -24,13 +24,6 @@
(def ^:private undo-op-item-schema
(mu/closed-schema
[:multi {:dispatch first}
[::record-editor-info
[:cat :keyword
[:map
[:block-uuid :uuid]
[:container-id [:or :int [:enum :unknown-container]]]
[:start-pos [:maybe :int]]
[:end-pos [:maybe :int]]]]]
[::db-transact
[:cat :keyword
[:map
Expand All @@ -41,6 +34,15 @@
[:outliner-op :keyword]]]
[:added-ids [:set :int]]
[:retracted-ids [:set :int]]]]]

[::record-editor-info
[:cat :keyword
[:map
[:block-uuid :uuid]
[:container-id [:or :int [:enum :unknown-container]]]
[:start-pos [:maybe :int]]
[:end-pos [:maybe :int]]]]]

[::ui-state
[:cat :keyword :string]]]))

Expand Down Expand Up @@ -75,7 +77,7 @@
(comment
;; This version checks updated datoms by other clients, allows undo and redo back
;; to the current state.
;; The con is that it'll undo the changes by others.
;; The downside is that it'll undo the changes made by others.
(defn- pop-undo-op
[repo conn]
(let [undo-stack (get @*undo-ops repo)
Expand Down Expand Up @@ -210,7 +212,7 @@
(nil? (d/entity @conn before-parent)))))))))))

(defn get-reversed-datoms
[conn undo? {:keys [tx-data added-ids retracted-ids]}]
[conn undo? {:keys [tx-data added-ids retracted-ids] :as op}]
(try
(when (and (seq added-ids) (seq retracted-ids))
(throw (ex-info "entities are created and deleted in the same tx"
Expand All @@ -230,21 +232,23 @@
(and (nil? entity)
(not (contains? added-and-retracted-ids e)))
(throw (ex-info "Entity has been deleted"
{:error :entity-deleted}))
(merge op {:error :entity-deleted
:undo? undo?})))

;; block has been moved or target got deleted by another client
(moved-block-or-target-deleted? conn e->datoms e moved-blocks redo?)
(throw (ex-info (str "This block has been moved or its target has been deleted"
{:redo? redo?})
{:error :block-moved-or-target-deleted}))
(throw (ex-info "This block has been moved or its target has been deleted"
(merge op {:error :block-moved-or-target-deleted
:undo? undo?})))

;; new children blocks have been added
(or (and (contains? retracted-ids e) redo?
(other-children-exist? entity retracted-ids)) ; redo delete-blocks
(and (contains? added-ids e) undo? ; undo insert-blocks
(other-children-exist? entity added-ids)))
(throw (ex-info "Children still exists"
{:error :block-children-exists}))
(merge op {:error :block-children-exists
:undo? undo?})))

;; The entity should be deleted instead of retracting its attributes
(and entity
Expand Down
168 changes: 84 additions & 84 deletions src/test/frontend/modules/outliner/core_test.cljs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -101,7 +101,8 @@
(concat [{:db/id 1
:block/uuid 1
:block/name "Test page"}]
blocks))))
blocks)
{:outliner-op :insert-blocks})))

(def tree
[[22 [[2 [[3 [[4]
Expand All @@ -124,8 +125,8 @@

(defn- transact-opts
[]
{:transact-opts {:repo test-db
:conn (db/get-db test-db false)}})
{:outliner-op :test
:transact-opts {:conn (db/get-db test-db false)}})

(deftest test-delete-block
(testing "
Expand Down Expand Up @@ -519,38 +520,38 @@
tags:: tag1, tag2
- block #blarg #bar"}])
(testing "save deletes a page's tags"
(let [conn (db/get-db test-helper/test-db false)
pre-block (->> (d/q '[:find (pull ?b [*])
:where [?b :block/pre-block? true]]
(let [conn (db/get-db test-db false)
pre-block (->> (d/q '[:find (pull ?b [*])
:where [?b :block/pre-block? true]]
@conn)
ffirst)
_ (save-block! (-> pre-block
(update :block/properties dissoc :tags)
(update :block/properties-text-values dissoc :tags)))
updated-page (-> (d/q '[:find (pull ?bp [* {:block/alias [*]}])
:where [?b :block/pre-block? true]
[?b :block/page ?bp]]
@conn)
ffirst)
_ (save-block! (-> pre-block
(update :block/properties dissoc :tags)
(update :block/properties-text-values dissoc :tags)))
updated-page (-> (d/q '[:find (pull ?bp [* {:block/alias [*]}])
:where [?b :block/pre-block? true]
[?b :block/page ?bp]]
@conn)
ffirst)]
(is (nil? (:block/tags updated-page))
"Page's tags are deleted")
(is (= #{"foo" "bar"} (set (map :block/name (:block/alias updated-page))))
"Page's aliases remain the same")
(is (= {:block/properties {:alias #{"foo" "bar"}}
:block/properties-text-values {:alias "foo, bar"}}
(select-keys updated-page [:block/properties :block/properties-text-values]))
"Page property attributes are correct")
(is (= {:block/properties {:alias #{"foo" "bar"}}
:block/properties-text-values {:alias "foo, bar"}}
(-> (d/q '[:find (pull ?b [*])
:where [?b :block/pre-block? true]]
@conn)
ffirst
(select-keys [:block/properties :block/properties-text-values])))
"Pre-block property attributes are correct")))
ffirst)]
(is (nil? (:block/tags updated-page))
"Page's tags are deleted")
(is (= #{"foo" "bar"} (set (map :block/name (:block/alias updated-page))))
"Page's aliases remain the same")
(is (= {:block/properties {:alias #{"foo" "bar"}}
:block/properties-text-values {:alias "foo, bar"}}
(select-keys updated-page [:block/properties :block/properties-text-values]))
"Page property attributes are correct")
(is (= {:block/properties {:alias #{"foo" "bar"}}
:block/properties-text-values {:alias "foo, bar"}}
(-> (d/q '[:find (pull ?b [*])
:where [?b :block/pre-block? true]]
@conn)
ffirst
(select-keys [:block/properties :block/properties-text-values])))
"Pre-block property attributes are correct")))

(testing "save deletes orphaned pages when a block's refs change"
(let [conn (db/get-db test-helper/test-db false)
(let [conn (db/get-db test-db false)
pages (set (map first (d/q '[:find ?bn :where [?b :block/name ?bn]] @conn)))
_ (assert (set/subset? #{"blarg" "bar"} pages) "Pages from block exist")
block-with-refs (ffirst (d/q '[:find (pull ?b [* {:block/refs [*]}])
Expand Down Expand Up @@ -600,8 +601,8 @@ tags:: tag1, tag2
blocks
target
{:sibling? (gen/generate gen/boolean)
:keep-uuid? true
:replace-empty-target? false})))
:keep-uuid? (gen/generate gen/boolean)
:replace-empty-target? (gen/generate gen/boolean)})))

(defn transact-random-tree!
[]
Expand Down Expand Up @@ -730,53 +731,56 @@ tags:: tag1, tag2
(let [total (get-blocks-count)]
(is (= total (count @*random-blocks)))))))))))

(defn run-random-mixed-ops!
[*random-blocks]
(let [ops [;; insert
(fn []
(let [blocks (gen-blocks)]
(swap! *random-blocks (fn [old]
(set/union old (set (map :block/uuid blocks)))))
(insert-blocks! blocks (get-random-block))))

;; delete
(fn []
(let [blocks (get-random-blocks)]
(when (seq blocks)
(swap! *random-blocks (fn [old]
(set/difference old (set (map :block/uuid blocks)))))
(outliner-tx/transact! (transact-opts)
(outliner-core/delete-blocks! test-db (db/get-db test-db false)
(state/get-date-formatter)
blocks {})))))

;; move
(fn []
(let [blocks (get-random-blocks)]
(when (seq blocks)
(outliner-tx/transact! (transact-opts)
(outliner-core/move-blocks! test-db
(db/get-db test-db false)
blocks (get-random-block) (gen/generate gen/boolean))))))

;; move up down
(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-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))))))]]
(dotimes [_i 100]
((rand-nth ops)))))

(deftest ^:long random-mixed-ops
(testing "Random mixed operations"
(transact-random-tree!)
(let [c1 (get-blocks-ids)
*random-blocks (atom c1)
ops [;; insert
(fn []
(let [blocks (gen-blocks)]
(swap! *random-blocks (fn [old]
(set/union old (set (map :block/uuid blocks)))))
(insert-blocks! blocks (get-random-block))))

;; delete
(fn []
(let [blocks (get-random-blocks)]
(when (seq blocks)
(swap! *random-blocks (fn [old]
(set/difference old (set (map :block/uuid blocks)))))
(outliner-tx/transact! (transact-opts)
(outliner-core/delete-blocks! test-db (db/get-db test-db false)
(state/get-date-formatter)
blocks {})))))

;; move
(fn []
(let [blocks (get-random-blocks)]
(when (seq blocks)
(outliner-tx/transact! (transact-opts)
(outliner-core/move-blocks! test-db
(db/get-db test-db false)
blocks (get-random-block) (gen/generate gen/boolean))))))

;; move up down
;; (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-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))))))]]
(dotimes [_i 100]
((rand-nth ops)))
(let [*random-blocks (atom (get-blocks-ids))]
(transact-random-tree!)
(run-random-mixed-ops! *random-blocks)
(let [total (get-blocks-count)
page-id 1]

Expand All @@ -787,11 +791,7 @@ tags:: tag1, tag2

;; 2. verify page's length + page itself = total blocks
(is (= (inc (db-model/get-page-blocks-count test-db page-id))
total))

;; 3. verify the outliner parent/left structure
;; TODO
))))
total))))))

(deftest test-non-consecutive-blocks->vec-tree
(let [blocks [{:block/page #:db{:id 2313},
Expand Down
72 changes: 72 additions & 0 deletions src/test/frontend/worker/undo_redo2_test.cljs
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,72 @@
(ns frontend.worker.undo-redo2-test
(:require [clojure.test :as t :refer [deftest is testing use-fixtures]]
[datascript.core :as d]
[frontend.db :as db]
[frontend.test.helper :as test-helper]
[frontend.worker.undo-redo2 :as undo-redo2]
[frontend.modules.outliner.core-test :as outliner-test]
[frontend.test.fixtures :as fixtures]
[frontend.worker.db-listener :as worker-db-listener]
[frontend.state :as state]))

;; TODO: random property ops test

(def test-db test-helper/test-db)

(defn listen-db-fixture
[f]
(let [test-db-conn (db/get-db test-db false)]
(assert (some? test-db-conn))
(worker-db-listener/listen-db-changes! test-db test-db-conn
{:handler-keys [:gen-undo-ops]})

(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
(with-redefs [state/get-selection-blocks (constantly [])]
(f)))

(use-fixtures :each
disable-browser-fns
fixtures/react-components
fixtures/reset-db
listen-db-fixture)

(defn- undo-all!
[conn]
(loop [i 0]
(let [r (undo-redo2/undo test-db conn)]
(if (not= :frontend.worker.undo-redo2/empty-undo-stack r)
(recur (inc i))
(prn :undo-count i)))))

(defn- redo-all!
[conn]
(loop [i 0]
(let [r (undo-redo2/redo test-db conn)]
(if (not= :frontend.worker.undo-redo2/empty-redo-stack r)
(recur (inc i))
(prn :redo-count i)))))

(defn- get-datoms
[db]
(set (map (fn [d] [(:e d) (:a d) (:v d)]) (d/datoms db :eavt))))

(deftest ^:long undo-redo-test
(testing "Random mixed operations"
(let [*random-blocks (atom (outliner-test/get-blocks-ids))]
(outliner-test/transact-random-tree!)
(let [conn (db/get-db false)
_ (outliner-test/run-random-mixed-ops! *random-blocks)
db-after @conn]

(undo-all! conn)

(is (= (get-datoms @conn) #{}))

(redo-all! conn)

(is (= (get-datoms @conn) (get-datoms db-after)))))))

0 comments on commit 55cec66

Please sign in to comment.