;; This Source Code Form is subject to the terms of the Mozilla Public ;; License, v. 2.0. If a copy of the MPL was not distributed with this ;; file, You can obtain one at http://mozilla.org/MPL/2.0/. ;; ;; Copyright (c) KALEIDOS SUBSIDIARY SL (ns common-tests.files-changes-test (:require [app.common.features :as ffeat] [app.common.files.changes :as ch] [app.common.files.changes-builder :as pcb] [app.common.files.changes-merge :as mch] [app.common.files.helpers :as cfh] [app.common.geom.point :as gpt] [app.common.geom.shapes :as gsh] [app.common.math :as mth] [app.common.schema :as sm] [app.common.schema.generators :as sg] [app.common.schema.test :as smt] [app.common.time :as ct] [app.common.types.file :as ctf] [app.common.types.page :as ctp] [app.common.types.shape :as cts] [app.common.types.tokens-lib :as ctob] [app.common.types.tokens-status :as ctos] [app.common.types.typography :as ctt] [app.common.uuid :as uuid] [clojure.datafy :refer [datafy]] [clojure.test :as t] [clojure.walk :as walk] [common-tests.types.shape-decode-encode-test :refer [json-roundtrip]])) (defn- make-file-data [file-id page-id] (binding [ffeat/*current* #{"components/v2"}] (ctf/make-file-data file-id page-id))) (defn- without-modified-at [data] (walk/prewalk (fn [value] ;; Expose opaque token types so they compare by value and their nested ;; timestamps are excluded too. (let [value (if (or (ctob/tokens-lib? value) (ctob/token-set? value) (ctos/tokens-status? value)) (datafy value) value)] (if (map? value) (dissoc value :modified-at) value))) data)) (defn- assert-idempotent [data changes] ;; Modification timestamps may differ; all other stored data must agree. ;; Exercise validation and the touched second pass at distinct times. (let [once (with-redefs [ct/now (constantly (ct/inst 1000))] (ch/process-changes data changes)) twice (with-redefs [ct/now (constantly (ct/inst 2000))] (ch/process-changes once changes))] (t/is (= (without-modified-at once) (without-modified-at twice)) "Replaying changes must preserve file data except modification timestamps") ;; Ordered maps compare equal regardless of iteration order, but set order ;; determines which token wins when active sets contain the same name. (when (:tokens-lib once) (t/is (= (vec (ctob/get-set-names (:tokens-lib once))) (vec (ctob/get-set-names (:tokens-lib twice)))) "Replaying changes must preserve token set order")))) (t/deftest library-changes-are-idempotent (let [file-id (uuid/custom 10 1) page-id (uuid/custom 10 2) shape-id (uuid/custom 10 3) component-id (uuid/custom 10 4) color {:id (uuid/custom 10 5) :name "Red" :color "#ff0000" :opacity 1} typography (ctt/make-typography {:id (uuid/custom 10 6)}) component {:type :add-component :id component-id :name "Component" :path "" :main-instance-id shape-id :main-instance-page page-id} base (ch/process-changes (make-file-data file-id page-id) [{:type :add-obj :id shape-id :page-id page-id :frame-id uuid/zero :obj (cts/setup-shape {:id shape-id :type :frame :name "Main" :frame-id uuid/zero :parent-id uuid/zero :component-id component-id :component-file file-id :main-instance true :component-root true})}]) populated (with-redefs [ct/now (constantly (ct/inst 0))] (ch/process-changes base [component {:type :add-color :color color} {:type :add-typography :typography typography}])) deleted (ch/process-changes populated [{:type :del-component :id component-id}])] (doseq [[label data change] [["add color" base {:type :add-color :color color}] ["modify color" populated {:type :mod-color :color (assoc color :name "Renamed")}] ["delete color" populated {:type :del-color :id (:id color)}] ["add typography" base {:type :add-typography :typography typography}] ["modify typography" populated {:type :mod-typography :typography (assoc typography :name "Renamed")}] ["delete typography" populated {:type :del-typography :id (:id typography)}] ["add component" base component] ["modify component" populated {:type :mod-component :id component-id :name "Renamed"}] ["delete component" populated {:type :del-component :id component-id}] ["delete component permanently" populated {:type :del-component :id component-id :skip-undelete? true}] ["restore component" deleted {:type :restore-component :id component-id :page-id page-id}] ["purge component" populated {:type :purge-component :id component-id}] ["set main instance attribute" populated {:type :mod-obj :id shape-id :page-id page-id :operations [{:type :set :attr :name :val "Renamed"}]}] ["assign main instance attribute" populated {:type :mod-obj :id shape-id :page-id page-id :operations [{:type :assign :value {:name "Renamed"}}]}]]] (t/testing label (assert-idempotent data [change]))))) (t/deftest token-changes-are-idempotent (let [set-id (uuid/custom 20 1) other-id (uuid/custom 20 2) token-id (uuid/custom 20 3) theme-id (uuid/custom 20 4) token-attrs {:id token-id :name "spacing" :type :spacing :value "8" :modified-at (ct/inst 0)} theme-attrs {:id theme-id :name "Light" :sets #{"base"} :modified-at (ct/inst 0)} lib (with-redefs [ct/now (constantly (ct/inst 0))] (-> (ctob/make-tokens-lib) (ctob/add-set (ctob/make-token-set :id set-id :name "base")) (ctob/add-set (ctob/make-token-set :id other-id :name "group/other")) (ctob/add-token set-id (ctob/make-token token-attrs)) (ctob/add-theme (ctob/make-token-theme theme-attrs)))) data (assoc (make-file-data (uuid/custom 20 5) (uuid/custom 20 6)) :tokens-lib lib)] (doseq [[label change] [["update token with serialized timestamp" {:type :set-token :set-id set-id :token-id token-id :attrs (assoc token-attrs :value "16")}] ["delete token" {:type :set-token :set-id set-id :token-id token-id :attrs nil}] ["set token set without optional timestamp" {:type :set-token-set :id set-id :attrs {:id set-id :name "base"}}] ["set token set with timestamp" {:type :set-token-set :id set-id :attrs {:id set-id :name "base" :modified-at (ct/inst 0)}}] ["delete token set" {:type :set-token-set :id set-id :attrs nil}] ["update theme with serialized timestamp" {:type :set-token-theme :id theme-id :attrs (assoc theme-attrs :sets #{"group/other"})}] ["delete theme" {:type :set-token-theme :id theme-id :attrs nil}] ["set tokens status" {:type :set-tokens-status :theme-ids #{theme-id} :set-ids #{set-id}}] ["reorder token set" {:type :move-token-set :from-path ["base"] :to-path ["base"] :before-path nil :before-group false}] ["move token set to another group" {:type :move-token-set :from-path ["base"] :to-path ["group" "base"] :before-path nil :before-group false}] ["reorder token set group" {:type :move-token-set-group :from-path ["group"] :to-path ["group"] :before-path ["base"] :before-group false}] ["move token set group" {:type :move-token-set-group :from-path ["group"] :to-path ["renamed"] :before-path nil :before-group false}] ["rename token set group" {:type :rename-token-set-group :set-group-path ["group"] :set-group-fname "renamed"}] ["rename token set group to its current name" {:type :rename-token-set-group :set-group-path ["group"] :set-group-fname "group"}]]] (t/testing label (assert-idempotent data [change]))))) (t/deftest registering-nested-groups-is-idempotent (let [file-id (uuid/custom 30 1) page-id (uuid/custom 30 2) outer-id (uuid/custom 30 3) inner-id (uuid/custom 30 4) rect-id (uuid/custom 30 5) data (ch/process-changes (make-file-data file-id page-id) (mapv (fn [[id parent-id type]] {:type :add-obj :id id :page-id page-id :frame-id uuid/zero :parent-id parent-id :obj (cts/setup-shape {:id id :type type :name (name type) :frame-id uuid/zero :parent-id parent-id :x 0 :y 0 :width 10 :height 10})}) [[outer-id uuid/zero :group] [inner-id outer-id :group] [rect-id inner-id :rect]])) moved (gsh/move (get-in data [:pages-index page-id :objects rect-id]) (gpt/point 100 0)) data (ch/process-changes data [{:type :mod-obj :id rect-id :page-id page-id :operations (mapv (fn [[attr val]] {:type :set :attr attr :val val}) (select-keys moved [:x :y :selrect :points]))}])] (t/testing "child before parent" (assert-idempotent data [{:type :reg-objects :page-id page-id :shapes [inner-id outer-id]}])) (t/testing "parent before child" (let [changes [{:type :reg-objects :page-id page-id :shapes [outer-id inner-id]}] result (ch/process-changes data changes)] (t/is (= {:x 100.0 :y 0.0 :width 10.0 :height 10.0} (select-keys (get-in result [:pages-index page-id :objects outer-id]) [:x :y :width :height])) "The first application must update the outer group's bounds") (assert-idempotent data changes))))) (t/deftest registering-sibling-groups-is-idempotent (let [page-id (uuid/custom 31 1) outer-id (uuid/custom 31 2) group-a (uuid/custom 31 3) group-b (uuid/custom 31 4) rect-a (uuid/custom 31 5) rect-b (uuid/custom 31 6) data (ch/process-changes (make-file-data (uuid/custom 31 7) page-id) (mapv (fn [[id parent-id type]] {:type :add-obj :id id :page-id page-id :frame-id uuid/zero :parent-id parent-id :obj (cts/setup-shape {:id id :type type :name (name type) :frame-id uuid/zero :parent-id parent-id :x 0 :y 0 :width 10 :height 10})}) [[outer-id uuid/zero :group] [group-a outer-id :group] [group-b outer-id :group] [rect-a group-a :rect] [rect-b group-b :rect]])) data (ch/process-changes data (mapv (fn [[id dx]] (let [shape (get-in data [:pages-index page-id :objects id]) moved (gsh/move shape (gpt/point dx 0))] {:type :mod-obj :id id :page-id page-id :operations (mapv (fn [[attr val]] {:type :set :attr attr :val val}) (select-keys moved [:x :y :selrect :points]))})) [[rect-a 100] [rect-b 200]]))] (doseq [shapes [[group-a group-b] [group-b group-a] [outer-id group-a group-b] [group-a outer-id group-b]]] (t/testing (str "Group order " shapes) (let [changes [{:type :reg-objects :page-id page-id :shapes shapes}] result (ch/process-changes data changes)] (t/is (= {:x 100.0 :y 0.0 :width 110.0 :height 10.0} (select-keys (get-in result [:pages-index page-id :objects outer-id]) [:x :y :width :height])) "The parent must use the updated bounds of both children") (assert-idempotent data changes)))))) (defn- make-nested-groups "Two pages, each with a group holding a group that holds a rect." [] (let [page-a (uuid/custom 41 1) page-b (uuid/custom 41 2) outer-a (uuid/custom 41 3) inner-a (uuid/custom 41 4) rect-a (uuid/custom 41 5) outer-b (uuid/custom 41 6) inner-b (uuid/custom 41 7) rect-b (uuid/custom 41 8)] {:page-a page-a :page-b page-b :outer-a outer-a :inner-a inner-a :rect-a rect-a :outer-b outer-b :inner-b inner-b :rect-b rect-b :data (ch/process-changes (make-file-data (uuid/custom 41 9) page-a) (into [{:type :add-page :id page-b :page (ctp/make-empty-page {:id page-b :name "page-b"})}] (map (fn [[id page-id parent-id type]] {:type :add-obj :id id :page-id page-id :frame-id uuid/zero :parent-id parent-id :obj (cts/setup-shape {:id id :type type :name (name type) :frame-id uuid/zero :parent-id parent-id :x 0 :y 0 :width 10 :height 10})}) [[outer-a page-a uuid/zero :group] [inner-a page-a outer-a :group] [rect-a page-a inner-a :rect] [outer-b page-b uuid/zero :group] [inner-b page-b outer-b :group] [rect-b page-b inner-b :rect]])))})) (defn- resize-rect "The changes the component sync emits after resizing a rect: the new geometry followed by a `:reg-objects` for the rect's parents, plus the inverse pair. `parents` is `[inner-id outer-id]`, the groups above the rect." [data page-id rect-id parents dx] (let [shape (get-in data [:pages-index page-id :objects rect-id]) moved (gsh/move shape (gpt/point dx 0)) redo [{:type :mod-obj :id rect-id :page-id page-id :operations (mapv (fn [[attr val]] {:type :set :attr attr :val val}) (select-keys moved [:x :y :selrect :points]))} {:type :reg-objects :page-id page-id :shapes parents}]] {:redo redo ;; The inverse: the shape back to its previous geometry, then the same ;; `reg-objects` so the groups shrink with it. :undo (list* {:type :mod-obj :id rect-id :page-id page-id :operations (mapv (fn [op] {:type :set :attr (:attr op) :val (get shape (:attr op))}) (:operations (first redo)))} [(second redo)])})) (defn- move-rect-changes [data page-id rect-id parents dx] (:redo (resize-rect data page-id rect-id parents dx))) (t/deftest merge-reg-objects-collapses-per-container (t/testing "one change per container, with the union of the shapes" (let [{:keys [data page-a rect-a inner-a outer-a]} (make-nested-groups) parents [inner-a outer-a] batch (concat (move-rect-changes data page-a rect-a parents 100) (move-rect-changes data page-a rect-a parents 50)) merged (mch/merge-reg-objects batch) regs (filterv #(= :reg-objects (:type %)) merged)] (t/is (= 1 (count regs)) "both reg-objects of the same container collapse into one") (t/is (= page-a (:page-id (first regs)))) (t/is (= #{inner-a outer-a} (set (:shapes (first regs)))) "the merged change carries every shape, no duplicates") (t/is (= (- (count batch) 1) (count merged)) "only the redundant reg-objects disappear, everything else is kept") (t/is (= (count (remove #(= :reg-objects (:type %)) batch)) (count (remove #(= :reg-objects (:type %)) merged))) "non reg-objects changes keep their order and count"))) (t/testing "the merged change goes last, so groups see the final children" (let [{:keys [data page-a rect-a inner-a outer-a]} (make-nested-groups) batch (vec (move-rect-changes data page-a rect-a [inner-a outer-a] 100)) merged (mch/merge-reg-objects batch)] (t/is (= :reg-objects (:type (last merged))) "a group recomputed before its child resized keeps a stale selrect"))) (t/testing "batches without reg-objects are returned untouched" (let [batch [{:type :mod-obj :id (uuid/custom 41 5) :page-id (uuid/custom 41 1) :operations [{:type :set :attr :name :val "x"}]}]] (t/is (= batch (mch/merge-reg-objects batch))))) (t/testing "a batch with a single reg-objects keeps one change" (let [{:keys [data page-a rect-a inner-a outer-a]} (make-nested-groups) batch (vec (move-rect-changes data page-a rect-a [inner-a outer-a] 100)) merged (mch/merge-reg-objects batch)] (t/is (= 1 (count (filter #(= :reg-objects (:type %)) merged)))) (t/is (= (count batch) (count merged)))))) (t/deftest merge-reg-objects-is-equivalent-to-the-separate-changes (let [{:keys [data page-a page-b inner-a outer-a inner-b outer-b rect-a rect-b]} (make-nested-groups) ;; Two pages, and on one of them a second resize that lands after the ;; first reg-objects: the case where position matters. batch (vec (concat (move-rect-changes data page-a rect-a [inner-a outer-a] 100) (move-rect-changes data page-b rect-b [inner-b outer-b] 100) (move-rect-changes data page-a rect-a [inner-a outer-a] 50))) merged (mch/merge-reg-objects batch) result-separate (with-redefs [ct/now (constantly (ct/inst 1000))] (ch/process-changes data batch)) result-merged (with-redefs [ct/now (constantly (ct/inst 1000))] (ch/process-changes data merged))] (t/testing "two of the three reg-objects collapse, one per container" (t/is (= 2 (count (filter #(= :reg-objects (:type %)) merged)))) (t/is (= (- (count batch) 1) (count merged)))) (t/testing "applying the merged batch matches applying them one by one" (t/is (= (without-modified-at result-separate) (without-modified-at result-merged)) "fusing reg-objects must not move any group to a stale geometry")) (t/testing "the group ends up wrapping the last resize" ;; Both resizes are computed from the same base data, so the second one ;; wins: the rect lands at x=50 and the group must wrap it there. (t/is (= {:x 50 :y 0 :width 10 :height 10} (update-vals (select-keys (get-in result-merged [:pages-index page-a :objects outer-a]) [:x :y :width :height]) #(long (mth/round %)))) "a group left at the first reg-objects would still wrap x=0")) (t/testing "the merged batch is still a valid change batch" (t/is (ch/check-changes merged)) (t/is (ch/check-changes batch) "sanity: the original batch validates too")))) (t/deftest merge-reg-objects-works-on-undo-changes (t/testing "undo-changes are a list and merge like redo-changes" (let [{:keys [data page-a page-b rect-a rect-b inner-a outer-a inner-b outer-b]} (make-nested-groups) resize-a1 (resize-rect data page-a rect-a [inner-a outer-a] 100) resize-a2 (resize-rect data page-a rect-a [inner-a outer-a] 50) resize-b (resize-rect data page-b rect-b [inner-b outer-b] 100) ;; Undo entry for three resizes: every `reg-objects` behind its shape ;; change, two of them on the same page, which is what merging is for. undo (apply list (concat (:undo resize-a1) (:undo resize-a2) (:undo resize-b))) after (ch/process-changes data (vec (concat (:redo resize-a1) (:redo resize-a2) (:redo resize-b)))) merged (mch/merge-reg-objects undo) undone-separate (with-redefs [ct/now (constantly (ct/inst 1000))] (ch/process-changes after undo)) undone-merged (with-redefs [ct/now (constantly (ct/inst 1000))] (ch/process-changes after merged))] (t/is (list? undo) "the builder hands undo-changes over as a list") (t/is (= 6 (count undo))) (t/is (= 3 (count (filter #(= :reg-objects (:type %)) undo)))) (t/testing "the three reg-objects collapse to one per container" (t/is (= 5 (count merged))) (t/is (= 2 (count (filter #(= :reg-objects (:type %)) merged)))) (t/is (= :reg-objects (:type (last merged))) "the group must be recomputed after the child is back in place")) (t/testing "undoing gives the same result merged or not" (t/is (= (without-modified-at undone-separate) (without-modified-at undone-merged)))) (t/testing "and the groups shrink back with their children" (doseq [[page-id outer-id] [[page-a outer-a] [page-b outer-b]]] (t/is (= {:x 0.0 :y 0.0 :width 10.0 :height 10.0} (select-keys (get-in undone-merged [:pages-index page-id :objects outer-id]) [:x :y :width :height])) "a group recomputed before the child was restored keeps a stale selrect")))))) (t/deftest add-obj (let [file-id (uuid/custom 2 2) page-id (uuid/custom 1 1) data (make-file-data file-id page-id) id-a (uuid/custom 2 1) id-b (uuid/custom 2 2) id-c (uuid/custom 2 3)] (t/testing "Adds single object" (let [chg {:type :add-obj :page-id page-id :id id-a :parent-id uuid/zero :frame-id uuid/zero :obj (cts/setup-shape {:frame-id uuid/zero :parent-id uuid/zero :id id-a :type :rect :name "rect"})} res (ch/process-changes data [chg])] (let [objects (get-in res [:pages-index page-id :objects])] (t/is (= 2 (count objects))) (t/is (= (:obj chg) (get objects id-a))) (t/is (= [id-a] (get-in objects [uuid/zero :shapes])))))) (t/testing "Adds several objects with different indexes" (let [chg (fn [id index] {:type :add-obj :page-id page-id :id id :frame-id uuid/zero :index index :obj (cts/setup-shape {:id id :frame-id uuid/zero :type :rect :name (str id)})}) res (ch/process-changes data [(chg id-a 0) (chg id-b 0) (chg id-c 1)])] ;; (clojure.pprint/pprint data) ;; (clojure.pprint/pprint res) (let [objects (get-in res [:pages-index page-id :objects])] (t/is (= 4 (count objects))) (t/is (not (nil? (get objects id-a)))) (t/is (not (nil? (get objects id-b)))) (t/is (not (nil? (get objects id-c)))) (t/is (= [id-b id-c id-a] (get-in objects [uuid/zero :shapes])))))))) (t/deftest mod-obj (let [file-id (uuid/custom 2 2) page-id (uuid/custom 1 1) data (make-file-data file-id page-id)] (t/testing "simple mod-obj" (let [chg {:type :mod-obj :page-id page-id :id uuid/zero :operations [{:type :set :attr :name :val "foobar"}]} res (ch/process-changes data [chg])] (let [objects (get-in res [:pages-index page-id :objects])] (t/is (= "foobar" (get-in objects [uuid/zero :name])))))) (t/testing "mod-obj for not existing shape" (let [chg {:type :mod-obj :page-id page-id :id (uuid/next) :operations [{:type :set :attr :name :val "foobar"}]} res (ch/process-changes data [chg])] (t/is (= res data)))))) (t/deftest mod-page (let [file-id (uuid/custom 2 2) page-id (uuid/custom 1 1) data (make-file-data file-id page-id)] (t/testing "sets background and background-token together" (let [chg {:type :mod-page :id page-id :background "#ffffff" :background-token "brand.bg"} res (ch/process-changes data [chg]) page (get-in res [:pages-index page-id])] (t/is (= "#ffffff" (:background page))) (t/is (= "brand.bg" (:background-token page))))) (t/testing "clears background-token while leaving background untouched" (let [data' (-> data (assoc-in [:pages-index page-id :background] "#ffffff") (assoc-in [:pages-index page-id :background-token] "brand.bg")) chg {:type :mod-page :id page-id :background-token nil} res (ch/process-changes data' [chg]) page (get-in res [:pages-index page-id])] (t/is (= "#ffffff" (:background page))) (t/is (not (contains? page :background-token))))))) (t/deftest del-obj (let [file-id (uuid/custom 2 2) page-id (uuid/custom 1 1) id (uuid/custom 2 1) data (make-file-data file-id page-id) data (-> data (assoc-in [:pages-index page-id :objects uuid/zero :shapes] [id]) (assoc-in [:pages-index page-id :objects id] {:id id :frame-id uuid/zero :type :rect :name "rect"}))] (t/testing "delete" (let [chg {:type :del-obj :page-id page-id :id id} res (ch/process-changes data [chg])] (let [objects (get-in res [:pages-index page-id :objects])] (t/is (= 1 (count objects))) (t/is (= [] (get-in objects [uuid/zero :shapes])))))) (t/testing "delete idempotency" (let [chg {:type :del-obj :page-id page-id :id id} res1 (ch/process-changes data [chg]) res2 (ch/process-changes res1 [chg])] (t/is (= res1 res2)) (let [objects (get-in res1 [:pages-index page-id :objects])] (t/is (= 1 (count objects))) (t/is (= [] (get-in objects [uuid/zero :shapes])))))))) (t/deftest move-objects-1 (let [frame-a-id (uuid/custom 0 1) frame-b-id (uuid/custom 0 2) group-a-id (uuid/custom 0 3) group-b-id (uuid/custom 0 4) rect-a-id (uuid/custom 0 5) rect-b-id (uuid/custom 0 6) rect-c-id (uuid/custom 0 7) rect-d-id (uuid/custom 0 8) rect-e-id (uuid/custom 0 9) file-id (uuid/custom 2 2) page-id (uuid/custom 1 1) data (make-file-data file-id page-id) data (update-in data [:pages-index page-id :objects] #(-> % (assoc-in [uuid/zero :shapes] [frame-a-id frame-b-id]) (assoc-in [frame-a-id] (cts/setup-shape {:id frame-a-id :parent-id uuid/zero :frame-id uuid/zero :name "Frame a" :shapes [group-a-id group-b-id rect-e-id] :type :frame})) (assoc-in [frame-b-id] (cts/setup-shape {:id frame-b-id :parent-id uuid/zero :frame-id uuid/zero :name "Frame b" :shapes [] :type :frame})) ;; Groups (assoc-in [group-a-id] (cts/setup-shape {:id group-a-id :name "Group A" :type :group :parent-id frame-a-id :frame-id frame-a-id :shapes [rect-a-id rect-b-id rect-c-id]})) (assoc-in [group-b-id] (cts/setup-shape {:id group-b-id :name "Group B" :type :group :parent-id frame-a-id :frame-id frame-a-id :shapes [rect-d-id]})) ;; Shapes (assoc-in [rect-a-id] (cts/setup-shape {:id rect-a-id :name "Rect A" :type :rect :parent-id group-a-id :frame-id frame-a-id})) (assoc-in [rect-b-id] (cts/setup-shape {:id rect-b-id :name "Rect B" :type :rect :parent-id group-a-id :frame-id frame-a-id})) (assoc-in [rect-c-id] (cts/setup-shape {:id rect-c-id :name "Rect C" :type :rect :parent-id group-a-id :frame-id frame-a-id})) (assoc-in [rect-d-id] (cts/setup-shape {:id rect-d-id :name "Rect D" :parent-id group-b-id :type :rect :frame-id frame-a-id})) (assoc-in [rect-e-id] (cts/setup-shape {:id rect-e-id :name "Rect E" :type :rect :parent-id frame-a-id :frame-id frame-a-id}))))] (t/testing "Create new group an add objects from the same group" (let [new-group-id (uuid/next) changes [{:type :add-obj :page-id page-id :id new-group-id :frame-id frame-a-id :obj (cts/setup-shape {:id new-group-id :type :group :frame-id frame-a-id :name "Group C"})} {:type :mov-objects :page-id page-id :parent-id new-group-id :shapes [rect-b-id rect-c-id]}] res (ch/process-changes data changes)] ;; (clojure.pprint/pprint data) ;; (println "===============") ;; (clojure.pprint/pprint res) (let [objects (get-in res [:pages-index page-id :objects])] (t/is (= [group-a-id group-b-id rect-e-id new-group-id] (get-in objects [frame-a-id :shapes]))) (t/is (= [rect-b-id rect-c-id] (get-in objects [new-group-id :shapes]))) (t/is (= [rect-a-id] (get-in objects [group-a-id :shapes])))))) (t/testing "Move elements to an existing group at index" (let [changes [{:type :mov-objects :page-id page-id :parent-id group-b-id :index 0 :shapes [rect-a-id rect-c-id]}] res (ch/process-changes data changes)] (let [objects (get-in res [:pages-index page-id :objects])] (t/is (= [group-a-id group-b-id rect-e-id] (get-in objects [frame-a-id :shapes]))) (t/is (= [rect-b-id] (get-in objects [group-a-id :shapes]))) (t/is (= [rect-a-id rect-c-id rect-d-id] (get-in objects [group-b-id :shapes])))))) (t/testing "Move elements from group and frame to an existing group at index" (let [changes [{:type :mov-objects :page-id page-id :parent-id group-b-id :index 0 :shapes [rect-a-id rect-e-id]}] res (ch/process-changes data changes)] (let [objects (get-in res [:pages-index page-id :objects])] (t/is (= [group-a-id group-b-id] (get-in objects [frame-a-id :shapes]))) (t/is (= [rect-b-id rect-c-id] (get-in objects [group-a-id :shapes]))) (t/is (= [rect-a-id rect-e-id rect-d-id] (get-in objects [group-b-id :shapes])))))) (t/testing "Move elements from several groups" (let [changes [{:type :mov-objects :page-id page-id :parent-id group-b-id :index 0 :shapes [rect-a-id rect-e-id]}] res (ch/process-changes data changes)] (let [objects (get-in res [:pages-index page-id :objects])] (t/is (= [group-a-id group-b-id] (get-in objects [frame-a-id :shapes]))) (t/is (= [rect-b-id rect-c-id] (get-in objects [group-a-id :shapes]))) (t/is (= [rect-a-id rect-e-id rect-d-id] (get-in objects [group-b-id :shapes])))))) (t/testing "Move all elements from a group" (let [changes [{:type :mov-objects :page-id page-id :parent-id group-a-id :shapes [rect-d-id]}] res (ch/process-changes data changes)] (let [objects (get-in res [:pages-index page-id :objects])] (t/is (= [group-a-id group-b-id rect-e-id] (get-in objects [frame-a-id :shapes]))) (t/is (empty? (get-in objects [group-b-id :shapes])))))) (t/testing "Move elements to a group with different frame" (let [changes [{:type :mov-objects :page-id page-id :parent-id frame-b-id :shapes [group-a-id]}] res (ch/process-changes data changes)] ;; (pprint (get-in data [:pages-index page-id :objects])) ;; (println "==========") ;; (pprint (get-in res [:pages-index page-id :objects])) (let [objects (get-in res [:pages-index page-id :objects])] (t/is (= [group-b-id rect-e-id] (get-in objects [frame-a-id :shapes]))) (t/is (= [group-a-id] (get-in objects [frame-b-id :shapes]))) (t/is (= frame-b-id (get-in objects [group-a-id :frame-id]))) (t/is (= frame-b-id (get-in objects [rect-a-id :frame-id]))) (t/is (= frame-b-id (get-in objects [rect-b-id :frame-id]))) (t/is (= frame-b-id (get-in objects [rect-c-id :frame-id])))))) (t/testing "Move elements to frame zero" (let [changes [{:type :mov-objects :page-id page-id :parent-id uuid/zero :shapes [group-a-id] :index 0}] res (ch/process-changes data changes)] (let [objects (get-in res [:pages-index page-id :objects])] ;; (pprint (get-in data [:objects uuid/zero])) ;; (println "==========") ;; (pprint (get-in objects [uuid/zero])) (t/is (= [group-a-id frame-a-id frame-b-id] (get-in objects [uuid/zero :shapes])))))) (t/testing "Don't allow to move inside self" (let [changes [{:type :mov-objects :page-id page-id :parent-id group-a-id :shapes [group-a-id]}] res (ch/process-changes data changes)] (t/is (= data res)))))) (t/deftest mov-objects-regression-1 (let [shape-1-id (uuid/custom 2 1) shape-2-id (uuid/custom 2 2) shape-3-id (uuid/custom 2 3) frame-id (uuid/custom 1 1) file-id (uuid/custom 4 4) page-id (uuid/custom 0 1) changes [{:type :add-obj :id frame-id :page-id page-id :parent-id uuid/zero :frame-id uuid/zero :obj (cts/setup-shape {:type :frame :name "Frame"})} {:type :add-obj :page-id page-id :frame-id frame-id :parent-id frame-id :id shape-1-id :obj (cts/setup-shape {:type :rect :name "Shape 1"})} {:type :add-obj :page-id page-id :id shape-2-id :parent-id uuid/zero :frame-id uuid/zero :obj (cts/setup-shape {:type :rect :name "Shape 2"})} {:type :add-obj :page-id page-id :id shape-3-id :parent-id uuid/zero :frame-id uuid/zero :obj (cts/setup-shape {:type :rect :name "Shape 3"})}] data (make-file-data file-id page-id) data (ch/process-changes data changes)] (t/testing "preserve order on multiple shape mov 1" (let [changes [{:type :mov-objects :page-id page-id :shapes [shape-2-id shape-3-id] :parent-id uuid/zero :index 0}] res (ch/process-changes data changes)] ;; (println "==> BEFORE") ;; (pprint (get-in data [:objects])) ;; (println "==> AFTER") ;; (pprint (get-in res [:objects])) (t/is (= [frame-id shape-2-id shape-3-id] (get-in data [:pages-index page-id :objects uuid/zero :shapes]))) (t/is (= [shape-2-id shape-3-id frame-id] (get-in res [:pages-index page-id :objects uuid/zero :shapes]))))) (t/testing "preserve order on multiple shape mov 1" (let [changes [{:type :mov-objects :page-id page-id :shapes [shape-3-id shape-2-id] :parent-id uuid/zero :index 0}] res (ch/process-changes data changes)] ;; (println "==> BEFORE") ;; (pprint (get-in data [:objects])) ;; (println "==> AFTER") ;; (pprint (get-in res [:objects])) (t/is (= [frame-id shape-2-id shape-3-id] (get-in data [:pages-index page-id :objects uuid/zero :shapes]))) (t/is (= [shape-3-id shape-2-id frame-id] (get-in res [:pages-index page-id :objects uuid/zero :shapes]))))) (t/testing "move inside->outside-inside" (let [changes [{:type :mov-objects :page-id page-id :shapes [shape-2-id] :parent-id frame-id} {:type :mov-objects :page-id page-id :shapes [shape-2-id] :parent-id uuid/zero}] res (ch/process-changes data changes)] (t/is (= (get-in res [:pages-index page-id :objects shape-1-id :frame-id]) (get-in data [:pages-index page-id :objects shape-1-id :frame-id]))) (t/is (= (get-in res [:pages-index page-id :objects shape-2-id :frame-id]) (get-in data [:pages-index page-id :objects shape-2-id :frame-id]))))))) (t/deftest move-objects-2 (let [shape-1-id (uuid/custom 1 1) shape-2-id (uuid/custom 1 2) shape-3-id (uuid/custom 1 3) shape-4-id (uuid/custom 1 4) group-1-id (uuid/custom 1 5) file-id (uuid/custom 1 6) page-id (uuid/custom 0 1) changes [{:type :add-obj :page-id page-id :id shape-1-id :frame-id uuid/zero :obj (cts/setup-shape {:id shape-1-id :type :rect :name "Shape a"})} {:type :add-obj :page-id page-id :id shape-2-id :frame-id uuid/zero :obj (cts/setup-shape {:id shape-2-id :type :rect :name "Shape b"})} {:type :add-obj :page-id page-id :id shape-3-id :frame-id uuid/zero :obj (cts/setup-shape {:id shape-3-id :type :rect :name "Shape c"})} {:type :add-obj :page-id page-id :id shape-4-id :frame-id uuid/zero :obj (cts/setup-shape {:id shape-4-id :type :rect :name "Shape d"})} {:type :add-obj :page-id page-id :id group-1-id :frame-id uuid/zero :obj (cts/setup-shape {:id group-1-id :type :group :name "Group"})} {:type :mov-objects :page-id page-id :parent-id group-1-id :shapes [shape-1-id shape-2-id]}] data (make-file-data file-id page-id) data (ch/process-changes data changes)] (t/testing "case 1" (let [changes [{:type :mov-objects :page-id page-id :parent-id uuid/zero :index 2 :shapes [shape-3-id]}] res (ch/process-changes data changes)] ;; Before (t/is (= [shape-3-id shape-4-id group-1-id] (get-in data [:pages-index page-id :objects uuid/zero :shapes]))) ;; After (t/is (= [shape-4-id shape-3-id group-1-id] (get-in res [:pages-index page-id :objects uuid/zero :shapes]))) ;; (pprint (get-in data [:pages-index page-id :objects uuid/zero])) ;; (pprint (get-in res [:pages-index page-id :objects uuid/zero])) )) (t/testing "case 2" (let [changes [{:type :mov-objects :page-id page-id :parent-id group-1-id :index 2 :shapes [shape-3-id]}] res (ch/process-changes data changes)] ;; Before (t/is (= [shape-3-id shape-4-id group-1-id] (get-in data [:pages-index page-id :objects uuid/zero :shapes]))) (t/is (= [shape-1-id shape-2-id] (get-in data [:pages-index page-id :objects group-1-id :shapes]))) ;; After: (t/is (= [shape-4-id group-1-id] (get-in res [:pages-index page-id :objects uuid/zero :shapes]))) (t/is (= [shape-1-id shape-2-id shape-3-id] (get-in res [:pages-index page-id :objects group-1-id :shapes]))) ;; (pprint (get-in data [:pages-index page-id :objects group-1-id])) ;; (pprint (get-in res [:pages-index page-id :objects group-1-id])) )) (t/testing "case 3" (let [changes [{:type :mov-objects :page-id page-id :parent-id group-1-id :index 1 :shapes [shape-3-id]}] res (ch/process-changes data changes)] ;; Before (t/is (= [shape-3-id shape-4-id group-1-id] (get-in data [:pages-index page-id :objects uuid/zero :shapes]))) (t/is (= [shape-1-id shape-2-id] (get-in data [:pages-index page-id :objects group-1-id :shapes]))) ;; After (t/is (= [shape-4-id group-1-id] (get-in res [:pages-index page-id :objects uuid/zero :shapes]))) (t/is (= [shape-1-id shape-3-id shape-2-id] (get-in res [:pages-index page-id :objects group-1-id :shapes]))) ;; (pprint (get-in data [:pages-index page-id :objects group-1-id])) ;; (pprint (get-in res [:pages-index page-id :objects group-1-id])) )) (t/testing "case 4" (let [changes [{:type :mov-objects :page-id page-id :parent-id group-1-id :index 0 :shapes [shape-3-id]}] res (ch/process-changes data changes)] ;; Before (t/is (= [shape-3-id shape-4-id group-1-id] (get-in data [:pages-index page-id :objects uuid/zero :shapes]))) (t/is (= [shape-1-id shape-2-id] (get-in data [:pages-index page-id :objects group-1-id :shapes]))) ;; After (t/is (= [shape-4-id group-1-id] (get-in res [:pages-index page-id :objects uuid/zero :shapes]))) (t/is (= [shape-3-id shape-1-id shape-2-id] (get-in res [:pages-index page-id :objects group-1-id :shapes]))) ;; (pprint (get-in data [:pages-index page-id :objects group-1-id])) ;; (pprint (get-in res [:pages-index page-id :objects group-1-id])) )) (t/testing "case 5" (let [changes [{:type :mov-objects :page-id page-id :parent-id uuid/zero :index 0 :shapes [shape-2-id]}] res (ch/process-changes data changes)] ;; (pprint (get-in data [:pages-index page-id :objects uuid/zero])) ;; (pprint (get-in res [:pages-index page-id :objects uuid/zero])) ;; (pprint (get-in data [:pages-index page-id :objects group-1-id])) ;; (pprint (get-in res [:pages-index page-id :objects group-1-id])) ;; Before (t/is (= [shape-3-id shape-4-id group-1-id] (get-in data [:pages-index page-id :objects uuid/zero :shapes]))) (t/is (= [shape-1-id shape-2-id] (get-in data [:pages-index page-id :objects group-1-id :shapes]))) ;; After (t/is (= [shape-2-id shape-3-id shape-4-id group-1-id] (get-in res [:pages-index page-id :objects uuid/zero :shapes]))) (t/is (= [shape-1-id] (get-in res [:pages-index page-id :objects group-1-id :shapes]))))) (t/testing "case 6" (let [changes [{:type :mov-objects :page-id page-id :parent-id uuid/zero :index 0 :shapes [shape-2-id shape-1-id]}] res (ch/process-changes data changes)] ;; (pprint (get-in data [:pages-index page-id :objects uuid/zero])) ;; (pprint (get-in res [:pages-index page-id :objects uuid/zero])) ;; (pprint (get-in data [:pages-index page-id :objects group-1-id])) ;; (pprint (get-in res [:pages-index page-id :objects group-1-id])) ;; Before (t/is (= [shape-3-id shape-4-id group-1-id] (get-in data [:pages-index page-id :objects uuid/zero :shapes]))) (t/is (= [shape-1-id shape-2-id] (get-in data [:pages-index page-id :objects group-1-id :shapes]))) ;; After (t/is (= [shape-2-id shape-1-id shape-3-id shape-4-id group-1-id] (get-in res [:pages-index page-id :objects uuid/zero :shapes]))) (t/is (not= nil (get-in res [:pages-index page-id :objects group-1-id]))))))) (t/deftest set-guide-json-encode-decode (let [schema ch/schema:set-guide-change encode (sm/encoder schema (sm/json-transformer)) decode (sm/decoder schema (sm/json-transformer))] (smt/check! (smt/for [data (sg/generator schema)] (let [data-1 (encode data) data-2 (json-roundtrip data-1) data-3 (decode data-2)] ;; (app.common.pprint/pprint data-2) ;; (app.common.pprint/pprint data-3) (= data data-3))) {:num 1000}))) (t/deftest set-guide-1 (let [file-id (uuid/custom 2 2) page-id (uuid/custom 1 1) data (make-file-data file-id page-id)] (smt/check! (smt/for [change (sg/generator ch/schema:set-guide-change)] (let [change (assoc change :page-id page-id) result (ch/process-changes data [change])] (= (:params change) (get-in result [:pages-index page-id :guides (:id change)])))) {:num 1000}))) (t/deftest set-guide-2 (let [file-id (uuid/custom 2 2) page-id (uuid/custom 1 1) data (make-file-data file-id page-id)] (smt/check! (smt/for [change (->> (sg/generator ch/schema:set-guide-change) (sg/filter :params))] (let [change1 (assoc change :page-id page-id) result1 (ch/process-changes data [change1]) change2 (assoc change1 :params nil) result2 (ch/process-changes result1 [change2])] (and (some? (:params change1)) (= (:params change1) (get-in result1 [:pages-index page-id :guides (:id change1)])) (nil? (:params change2)) (nil? (get-in result2 [:pages-index page-id :guides]))))) {:num 1000}))) (t/deftest set-comment-thread-position (let [file-id (uuid/custom 2 2) page-id (uuid/custom 1 1) thread-id (uuid/custom 3 1) frame-id (uuid/custom 4 1) data (make-file-data file-id page-id)] (t/testing "stores position and frame-id" (let [change {:type :set-comment-thread-position :page-id page-id :comment-thread-id thread-id :frame-id frame-id :position (gpt/point 10 20)} res (ch/process-changes data [change])] (t/is (= {:frame-id frame-id :position (gpt/point 10 20)} (get-in res [:pages-index page-id :comment-thread-positions thread-id]))))) (t/testing "removes the position when frame-id and position are nil" (let [data (ch/process-changes data [{:type :set-comment-thread-position :page-id page-id :comment-thread-id thread-id :frame-id frame-id :position (gpt/point 10 20)}]) res (ch/process-changes data [{:type :set-comment-thread-position :page-id page-id :comment-thread-id thread-id :frame-id nil :position nil}])] (t/is (nil? (get-in res [:pages-index page-id :comment-thread-positions thread-id]))))) (t/testing "builder round-trips the position through undo and redo" (let [data (ch/process-changes data [{:type :set-comment-thread-position :page-id page-id :comment-thread-id thread-id :frame-id frame-id :position (gpt/point 10 20)}]) page (get-in data [:pages-index page-id]) changes (-> (pcb/empty-changes) (pcb/with-page page) (pcb/set-comment-thread-position {:id thread-id :frame-id frame-id :position (gpt/point 100 200)})) redone (ch/process-changes data (:redo-changes changes)) undone (ch/process-changes redone (:undo-changes changes))] (t/is (= (gpt/point 100 200) (get-in redone [:pages-index page-id :comment-thread-positions thread-id :position]))) (t/is (= (gpt/point 10 20) (get-in undone [:pages-index page-id :comment-thread-positions thread-id :position]))))))) (t/deftest set-plugin-data-json-encode-decode (let [schema ch/schema:set-plugin-data-change encode (sm/encoder schema (sm/json-transformer)) decode (sm/decoder schema (sm/json-transformer))] (smt/check! (smt/for [data (sg/generator schema)] (let [data-1 (encode data) data-2 (json-roundtrip data-1) data-3 (decode data-2)] (= data data-3))) {:num 1000}))) (t/deftest set-plugin-data-gen-and-validate (let [file-id (uuid/custom 2 2) page-id (uuid/custom 1 1) data (make-file-data file-id page-id)] (smt/check! (smt/for [change (sg/generator ch/schema:set-plugin-data-change)] (sm/validate ch/schema:set-plugin-data-change change)) {:num 1000}))) (t/deftest set-flow-json-encode-decode (let [schema ch/schema:set-flow-change encode (sm/encoder schema (sm/json-transformer)) decode (sm/decoder schema (sm/json-transformer))] (smt/check! (smt/for [data (sg/generator schema)] (let [data-1 (encode data) data-2 (json-roundtrip data-1) data-3 (decode data-2)] ;; (app.common.pprint/pprint data-2) ;; (app.common.pprint/pprint data-3) (= data data-3))) {:num 1000}))) (t/deftest set-flow-1 (let [file-id (uuid/custom 2 2) page-id (uuid/custom 1 1) data (make-file-data file-id page-id)] (smt/check! (smt/for [change (sg/generator ch/schema:set-flow-change)] (let [change (assoc change :page-id page-id) result (ch/process-changes data [change])] (= (:params change) (get-in result [:pages-index page-id :flows (:id change)])))) {:num 1000}))) (t/deftest set-flow-2 (let [file-id (uuid/custom 2 2) page-id (uuid/custom 1 1) data (make-file-data file-id page-id)] (smt/check! (smt/for [change (->> (sg/generator ch/schema:set-flow-change) (sg/filter :params))] (let [change1 (assoc change :page-id page-id) result1 (ch/process-changes data [change1]) change2 (assoc change1 :params nil) result2 (ch/process-changes result1 [change2])] (and (some? (:params change1)) (= (:params change1) (get-in result1 [:pages-index page-id :flows (:id change1)])) (nil? (:params change2)) (nil? (get-in result2 [:pages-index page-id :flows]))))) {:num 1000}))) (t/deftest set-default-grid-json-encode-decode (let [schema ch/schema:set-default-grid-change encode (sm/encoder schema (sm/json-transformer)) decode (sm/decoder schema (sm/json-transformer))] (smt/check! (smt/for [data (sg/generator schema)] (let [data-1 (encode data) data-2 (json-roundtrip data-1) data-3 (decode data-2)] ;; (println "==========") ;; (app.common.pprint/pprint data-2) ;; (app.common.pprint/pprint data-3) ;; (println "==========") (= data data-3))) {:num 1000}))) (t/deftest set-default-grid-1 (let [file-id (uuid/custom 2 2) page-id (uuid/custom 1 1) data (make-file-data file-id page-id)] (smt/check! (smt/for [change (sg/generator ch/schema:set-default-grid-change)] (let [change (assoc change :page-id page-id) result (ch/process-changes data [change])] ;; (app.common.pprint/pprint change) (= (:params change) (get-in result [:pages-index page-id :default-grids (:grid-type change)])))) {:num 1000}))) (t/deftest set-default-grid-2 (let [file-id (uuid/custom 2 2) page-id (uuid/custom 1 1) data (make-file-data file-id page-id)] (smt/check! (smt/for [change (->> (sg/generator ch/schema:set-default-grid-change) (sg/filter :params))] (let [change1 (assoc change :page-id page-id) result1 (ch/process-changes data [change1]) change2 (assoc change1 :params nil) result2 (ch/process-changes result1 [change2])] ;; (app.common.pprint/pprint change1) (and (some? (:params change1)) (= (:params change1) (get-in result1 [:pages-index page-id :default-grids (:grid-type change1)])) (nil? (:params change2)) (nil? (get-in result2 [:pages-index page-id :default-grids]))))) {:num 1000})))