From 91fe00b1522ce44dea008be39e2d47d6dfa87667 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9s=20Moya?= Date: Wed, 11 Mar 2026 10:59:06 +0100 Subject: [PATCH] :wrench: Refactor check-swap-slot using TDD --- .../src/app/common/files/comp_processors.cljc | 29 ++ common/src/app/common/files/migrations.cljc | 52 +-- common/src/app/common/files/validate.cljc | 36 +- .../app/common/test_helpers/compositions.cljc | 24 +- common/src/app/common/types/container.cljc | 4 + common/src/app/common/types/file.cljc | 101 +++++ common/src/app/common/types/shape_tree.cljc | 2 - .../files/comp_processors_test.cljc | 123 ++++++ .../common_tests/types/components_test.cljc | 358 ++++++++++++++++++ 9 files changed, 662 insertions(+), 67 deletions(-) create mode 100644 common/src/app/common/files/comp_processors.cljc create mode 100644 common/test/common_tests/files/comp_processors_test.cljc diff --git a/common/src/app/common/files/comp_processors.cljc b/common/src/app/common/files/comp_processors.cljc new file mode 100644 index 0000000000..b37510f2bc --- /dev/null +++ b/common/src/app/common/files/comp_processors.cljc @@ -0,0 +1,29 @@ +;; 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 INC + +(ns app.common.files.comp-processors + (:require + [app.common.types.component :as ctk] + [app.common.types.file :as ctf])) + +(defn fix-missing-swap-slots + "Locate shapes that have been swapped (i.e. their shape-ref does not point to the near match) but + they don't have a swap slot. In this case, add one pointing to the near match." + [file libraries] + (ctf/update-all-shapes + file + (fn [shape] + (if (ctk/subcopy-head? shape) + (let [container (:container (meta shape)) + near-match (ctf/find-near-match file container libraries shape :include-deleted? true :with-context? false)] + (if (and (some? near-match) + (not= (:shape-ref shape) (:id near-match)) + (nil? (ctk/get-swap-slot shape))) + (let [updated-shape (ctk/set-swap-slot shape (:id near-match))] + {:result :update :updated-shape updated-shape}) + {:result :keep})) + {:result :keep})))) + diff --git a/common/src/app/common/files/migrations.cljc b/common/src/app/common/files/migrations.cljc index e719452d8d..a0e5ff22bd 100644 --- a/common/src/app/common/files/migrations.cljc +++ b/common/src/app/common/files/migrations.cljc @@ -10,6 +10,7 @@ [app.common.data.macros :as dm] [app.common.features :as cfeat] [app.common.files.changes :as cpc] + [app.common.files.comp-processors :as cfcp] [app.common.files.defaults :as cfd] [app.common.files.helpers :as cfh] [app.common.geom.matrix :as gmt] @@ -1842,52 +1843,11 @@ (defmethod migrate-data "0020-fix-missing-swap-slots" [data _] (let [file {:id (:id data) :data data} - libraries (when (:libs data) - (deref (:libs data)))] - - (letfn [(update-shape-recursive - [container shape-id root?] - #_(when root? - (prn "Checking container:" (:id container))) - (if (:objects container) - (let [shape (ctsht/get-shape container shape-id)] - (if (and (ctk/instance-head? shape) (ctk/in-component-copy? shape)) - (let [ref-shape (ctf/find-ref-shape file container libraries shape :include-deleted? true :with-context? true) - container (:container (meta ref-shape))] - (if (some? ref-shape) - (compare-slots container container shape ref-shape) - container)) - (reduce (fn [container child-id] - (update-shape-recursive container child-id false)) - container - (:shapes shape)))) - container)) - - (compare-slots - [container-copy container-main shape-copy shape-main] - (prn "comparing shape:" (:id shape-copy) " with ref:" (:id shape-main)) - (if (and (not= (:shape-ref shape-copy) (:id shape-main)) - (nil? (ctk/get-swap-slot shape-copy))) - (let [new-slot (or (ctk/get-swap-slot shape-main) (:id shape-main))] - (prn "Fixing swap slot for shape:" (:id shape-copy) " to " new-slot) - container-copy) - (if (nil? (ctk/get-swap-slot shape-copy)) - (let [children-id-pairs (d/zip-all (:shapes shape-copy) (:shapes shape-main))] - (reduce (fn [container [child-copy-id child-main-id]] - (let [child-copy (ctsht/get-shape container-copy child-copy-id) - child-main (ctsht/get-shape container-main child-main-id)] - (if (and (some? child-copy) (some? child-main)) - (compare-slots container container-main child-copy child-main) - container-copy))) - container-copy - children-id-pairs)) - container-copy)))] - - (prn "start migration" (:id data)) - (-> data - (update :pages-index d/update-vals #(update-shape-recursive % uuid/zero true)) - (d/update-when :components d/update-vals #(update-shape-recursive % (:main-instance-id %) true)) - (d/tap-r (fn [_] (prn "end migration"))))))) + libraries (if (:libs data) + (deref (:libs data)) + {})] + (-> (cfcp/fix-missing-swap-slots file libraries) + :data))) (def available-migrations (into (d/ordered-set) diff --git a/common/src/app/common/files/validate.cljc b/common/src/app/common/files/validate.cljc index a3a423fded..9b3e1bba64 100644 --- a/common/src/app/common/files/validate.cljc +++ b/common/src/app/common/files/validate.cljc @@ -366,6 +366,19 @@ "This shape has children with the same swap slot" shape file page))) +(defn- check-required-swap-slot + "Validate that the shape has swap-slot if it's a subinstance head and the ref shape is not the + matching shape by position in the near main." + [shape file page libraries] + (let [near-match (ctf/find-near-match file page libraries shape :include-deleted? true :with-context? false)] + (when (and (some? near-match) + (not= (:shape-ref shape) (:id near-match)) + (nil? (ctk/get-swap-slot shape))) + (report-error :missing-slot + "Shape has been swapped, should have swap slot" + shape file page + :swap-slot (or (ctk/get-swap-slot near-match) (:id shape)))))) + (defn- check-valid-touched "Validate that the text touched flags are coherent." [shape file page] @@ -435,6 +448,7 @@ (check-component-not-root shape file page) (check-valid-touched shape file page) (check-ref-component-id shape file page libraries) + (check-required-swap-slot shape file page libraries) ;; We can have situations where the nested copy and the ancestor copy come from different libraries and some of them have been dettached ;; so we only validate the shape-ref if the ancestor is from a valid library (when library-exists @@ -699,7 +713,7 @@ ;; PUBLIC API: VALIDATION FUNCTIONS ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(declare check-swap-slots) +#_(declare check-swap-slots) (defn validate-file "Validate full referential integrity and semantic coherence on file data. @@ -711,7 +725,7 @@ (doseq [page (filter :id (ctpl/pages-seq data))] (check-shape uuid/zero file page libraries) - (when (str/includes? (:name file) "check-swap-slot") + #_(when (str/includes? (:name file) "check-swap-slot") (check-swap-slots uuid/zero file page libraries)) (->> (get-orphan-shapes page) (run! #(check-shape % file page libraries)))) @@ -754,7 +768,7 @@ :file-id (:id file) :details errors))) -(declare compare-slots) +#_(declare compare-slots) ;; Optional check to look for missing swap slots. ;; Search for copies that do not point the shape-ref to the near component but don't have swap slot @@ -764,18 +778,18 @@ ;; may have copies with shapes that do not match by position, but have not been swapped. So we enable ;; it for specific files only. To activate the check, you need to add the string "check-swap-slot" to ;; the name of the file. -(defn- check-swap-slots +#_(defn- check-swap-slots [shape-id file page libraries] (let [shape (ctst/get-shape page shape-id)] (if (and (ctk/instance-head? shape) (ctk/in-component-copy? shape)) - (let [ref-shape (ctf/find-ref-shape file page libraries shape :include-deleted? true :with-context? true) - container (:container (meta ref-shape))] - (when (some? ref-shape) - (compare-slots shape ref-shape file page container))) - (doall (for [child-id (:shapes shape)] - (check-swap-slots child-id file page libraries)))))) + (let [ref-shape (ctf/find-ref-shape file page libraries shape :include-deleted? true :with-context? true) + container (:container (meta ref-shape))] + (when (some? ref-shape) + (compare-slots shape ref-shape file page container))) + (doall (for [child-id (:shapes shape)] + (check-swap-slots child-id file page libraries)))))) -(defn- compare-slots +#_(defn- compare-slots [shape-copy shape-main file container-copy container-main] (if (and (not= (:shape-ref shape-copy) (:id shape-main)) (nil? (ctk/get-swap-slot shape-copy))) diff --git a/common/src/app/common/test_helpers/compositions.cljc b/common/src/app/common/test_helpers/compositions.cljc index b230e342d9..bffbab4616 100644 --- a/common/src/app/common/test_helpers/compositions.cljc +++ b/common/src/app/common/test_helpers/compositions.cljc @@ -278,11 +278,14 @@ (defn swap-component "Swap the specified shape by the component specified by component-tag" - [file shape component-tag & {:keys [page-label propagate-fn keep-touched? new-shape-label]}] + [file shape component-tag & {:keys [page-label propagate-fn keep-touched? new-shape-label library]}] (let [page (if page-label (thf/get-page file page-label) (thf/current-page file)) - libraries {(:id file) file} + libraries (cond-> {(:id file) file} + (some? library) + (assoc (:id library) library)) + library (or library file) orig-shapes (when keep-touched? (cfh/get-children-with-self (:objects page) (:id shape))) @@ -290,10 +293,10 @@ (cll/generate-component-swap (pcb/empty-changes) (:objects page) shape - (:data file) + (:data library) page libraries - (-> (thc/get-component file component-tag) + (-> (thc/get-component library component-tag) :id) 0 nil @@ -314,10 +317,14 @@ (thf/validate-file!)) file'))) -(defn swap-component-in-shape [file shape-tag component-tag & {:keys [page-label propagate-fn]}] - (swap-component file (ths/get-shape file shape-tag :page-label page-label) component-tag :page-label page-label :propagate-fn propagate-fn)) +(defn swap-component-in-shape [file shape-tag component-tag & {:keys [page-label propagate-fn library]}] + (swap-component file (ths/get-shape file shape-tag :page-label page-label) + component-tag + :page-label page-label + :propagate-fn propagate-fn + :library library)) -(defn swap-component-in-first-child [file shape-tag component-tag & {:keys [page-label propagate-fn]}] +(defn swap-component-in-first-child [file shape-tag component-tag & {:keys [page-label propagate-fn library]}] (let [first-child-id (->> (ths/get-shape file shape-tag :page-label page-label) :shapes first)] @@ -325,7 +332,8 @@ (ths/get-shape-by-id file first-child-id :page-label page-label) component-tag :page-label page-label - :propagate-fn propagate-fn))) + :propagate-fn propagate-fn + :library library))) (defn update-color "Update the first fill color for the shape identified by shape-tag" diff --git a/common/src/app/common/types/container.cljc b/common/src/app/common/types/container.cljc index 324528854b..3a510272ff 100644 --- a/common/src/app/common/types/container.cljc +++ b/common/src/app/common/types/container.cljc @@ -55,6 +55,10 @@ [page-or-component type] (assoc page-or-component :type type)) +(defn unmake-container + [container] + (dissoc container :type)) + (defn page? [container] (= (:type container) :page)) diff --git a/common/src/app/common/types/file.cljc b/common/src/app/common/types/file.cljc index 3733359a6c..ce2046b882 100644 --- a/common/src/app/common/types/file.cljc +++ b/common/src/app/common/types/file.cljc @@ -225,6 +225,86 @@ (ctpl/update-page file-data (:id container) f) (ctkl/update-component file-data (:id container) f))) +(defn update-pages + "Update all pages inside the file" + [file-data f] + (update file-data :pages-index d/update-vals + (fn [page] + (-> page + (ctn/make-container :page) + (f) + (ctn/unmake-container))))) + +(defn update-components + "Update all components inside the file" + [file-data f] + (d/update-when file-data :components d/update-vals + (fn [component] + (-> component + (ctn/make-container :component) + (f) + (ctn/unmake-container))))) + +(defn update-containers + "Update all pages and components inside the file" + [file-data f] + (-> file-data + (update-pages f) + (update-components f))) + +(defn update-objects-tree + "Do a depth-first traversal of the shapes in a container, doing different kinds of updates. + The function f receives a shape with a context metadata with the container. + It must return a map with the following keys: + - :result -> :keep, :update or :remove + - :updated-shape -> the updated shape if result is :update" + [container f] + (letfn [(update-shape-recursive + [container shape-id] + (let [shape (ctst/get-shape container shape-id)] + (when (not shape) + (throw (ex-info "Shape not found" {:shape-id shape-id}))) + (let [shape (with-meta shape {:container container}) + + {:keys [result updated-shape]} (f shape) + + container' + (case result + :keep + container + + :update + (ctst/set-shape container updated-shape) + + :remove + (ctst/delete-shape container shape-id true) + + :else + (throw (ex-info "Invalid result from update function" {:result result})))] + + (reduce update-shape-recursive + container' + (:shapes shape)))))] + + (let [root-id (if (ctn/page? container) + uuid/zero + (:main-instance-id container))] + + (if-not (empty? (:objects container)) + (update-shape-recursive container root-id) + container)))) + +(defn update-all-shapes + "Update all shapes in the file, using the update-objects-tree function for each container" + [file f] + (update-file-data + file + (fn [file-data] + (update-containers + file-data + (fn [container] + (update-objects-tree container f)))))) + ;; Asset helpers (defn find-component-file [file libraries component-file] @@ -328,6 +408,27 @@ (get-ref-shape (:data component-file) component shape :with-context? with-context?))))] (some find-ref-shape-in-head (ctn/get-parent-heads (:objects container) shape)))) +(defn find-near-match + "Locate the shape that occupies the same position in the near main component. + This will be the ref-shape except if the shape is a copy subhead that has been + swapped. In this case, the near match will be the ref-shape that was before + the swap." + [file container libraries shape & {:keys [with-context?] :or {with-context? false}}] + (let [parent-shape (ctst/get-shape container (:parent-id shape)) + parent-ref-shape (when parent-shape + (find-ref-shape file container libraries parent-shape :include-deleted? true :with-context? true)) + ref-container (when parent-ref-shape + (:container (meta parent-ref-shape))) + shape-index (when parent-shape + (d/index-of (:shapes parent-shape) (:id shape))) + near-match-id (when (and parent-ref-shape shape-index) + (get (:shapes parent-ref-shape) shape-index)) + near-match (when near-match-id + (cond-> (ctst/get-shape ref-container near-match-id) + with-context? + (with-meta (meta parent-ref-shape))))] + near-match)) + (defn advance-shape-ref "Get the shape-ref of the near main of the shape, recursively repeated as many times as the given levels." diff --git a/common/src/app/common/types/shape_tree.cljc b/common/src/app/common/types/shape_tree.cljc index 92732e18a1..3944d96afb 100644 --- a/common/src/app/common/types/shape_tree.cljc +++ b/common/src/app/common/types/shape_tree.cljc @@ -16,8 +16,6 @@ [app.common.types.shape.layout :as ctl] [app.common.uuid :as uuid])) - -;; FIXME: the order of arguments seems arbitrary, container should be a first artgument (defn add-shape "Insert a shape in the tree, at the given index below the given parent or frame. Update the parent as needed." diff --git a/common/test/common_tests/files/comp_processors_test.cljc b/common/test/common_tests/files/comp_processors_test.cljc new file mode 100644 index 0000000000..e5dbd7abb7 --- /dev/null +++ b/common/test/common_tests/files/comp_processors_test.cljc @@ -0,0 +1,123 @@ +;; 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 INC + +(ns common-tests.files.comp-processors-test + (:require + [app.common.data :as d] + [app.common.files.comp-processors :as cfcp] + [app.common.test-helpers.components :as thc] + [app.common.test-helpers.compositions :as tho] + [app.common.test-helpers.files :as thf] + [app.common.test-helpers.ids-map :as thi] + [app.common.test-helpers.shapes :as ths] + [app.common.types.component :as ctk] + [clojure.test :as t])) + +(t/deftest test-fix-missing-swap-slots + + (t/testing "empty file should not need any action" + (let [file (thf/sample-file :file1) + file' (cfcp/fix-missing-swap-slots file {})] + (t/is (empty? (d/map-diff file file'))))) + + (t/testing "file without components should not need any action" + (let [file + ;; :frame1 [:name Frame1] + ;; :child1 [:name Rect1] + (-> (thf/sample-file :file1) + (tho/add-frame-with-child :frame1 :shape1)) + + file' (cfcp/fix-missing-swap-slots file {})] + + (t/is (empty? (d/map-diff file file'))))) + + (t/testing "file with nested not swapped components should not need any action" + (let [file + ;; {:main1-root} [:name Frame1] # [Component :component1] + ;; :main1-child [:name Rect1] + ;; + ;; {:main2-root} [:name Frame2] # [Component :component2] + ;; :nested-head [:name Frame1] @--> [Component :component1] :main1-root + ;; [:name Rect1] ---> :main1-child + ;; + ;; :copy2 [:name Frame2] #--> [Component :component2] :main2-root + ;; [:name Frame1] @--> [Component :component1] :nested-head + ;; [:name Rect1] ---> + (-> (thf/sample-file :file1) + (tho/add-nested-component-with-copy :component1 :main1-root :main1-child + :component2 :main2-root :nested-head + :copy2 :copy2-root)) + + file' (cfcp/fix-missing-swap-slots file {})] + + (t/is (empty? (d/map-diff file file'))))) + + (t/testing "file with a normally swapped copy should not need any action" + (let [file + ;; {:main1-root} [:name Frame1] # [Component :component1] + ;; :main1-child [:name Rect1] + ;; + ;; {:main2-root} [:name Frame2] # [Component :component2] + ;; :nested-head [:name Frame1] @--> [Component :component1] :main1-root + ;; [:name Rect1] ---> :main1-child + ;; + ;; {:main3-root} [:name Frame3] # [Component :component3] + ;; :main3-child [:name Rect3] + ;; + ;; :copy2 [:name Frame2] #--> [Component :component2] :main2-root + ;; :copy2-nested-head [:name Frame3] @--> [Component :component3] :main3-root + ;; {swap-slot :nested-head} + ;; [:name Rect3] ---> :main3-child + (-> (thf/sample-file :file1) + (tho/add-nested-component :component1 :main1-root :main1-child + :component2 :main2-root :nested-head) + (thc/instantiate-component :component2 :copy2 :children-labels [:copy2-nested-head]) + (tho/add-simple-component :component3 :main3-root :main3-child + :root-params {:name "Frame3"} + :child-params {:name "Rect3"}) + (tho/swap-component-in-first-child :copy2 :component3)) + + file' (cfcp/fix-missing-swap-slots file {})] + + (t/is (empty? (d/map-diff file file'))))) + + (t/testing "file with a swapped copy with broken slot should have it repaired" + (println "==start test==================================================") + (let [file + ;; {:main1-root} [:name Frame1] # [Component :component1] + ;; :main1-child [:name Rect1] + ;; + ;; {:main2-root} [:name Frame2] # [Component :component2] + ;; :nested-head [:name Frame1] @--> [Component :component1] :main1-root + ;; [:name Rect1] ---> :main1-child + ;; + ;; {:main3-root} [:name Frame3] # [Component :component3] + ;; :main3-child [:name Rect3] + ;; + ;; :copy2 [:name Frame2] #--> [Component :component2] :main2-root + ;; :copy2-nested-head [:name Frame3] @--> [Component :component3] :main3-root + ;; NO SWAP SLOT + ;; [:name Rect3] ---> :main3-child + (-> (thf/sample-file :file1) + (tho/add-nested-component :component1 :main1-root :main1-child + :component2 :main2-root :nested-head) + (thc/instantiate-component :component2 :copy2 :children-labels [:copy2-nested-head]) + (tho/add-simple-component :component3 :main3-root :main3-child + :root-params {:name "Frame3"} + :child-params {:name "Rect3"}) + (tho/swap-component-in-first-child :copy2 :component3) + (ths/update-shape :copy2-nested-head :touched nil)) + + file' (cfcp/fix-missing-swap-slots file {}) + + diff (d/map-diff file file') + + copy2-nested-head' (ths/get-shape file' :copy2-nested-head)] + + (thf/dump-file file :keys [:name :swap-slot-label] :show-refs? true) + (println "====================================================") + (prn "diff" diff) + (t/is (= (ctk/get-swap-slot copy2-nested-head') (thi/id :nested-head)))))) diff --git a/common/test/common_tests/types/components_test.cljc b/common/test/common_tests/types/components_test.cljc index 36394f29a2..684d45db99 100644 --- a/common/test/common_tests/types/components_test.cljc +++ b/common/test/common_tests/types/components_test.cljc @@ -6,9 +6,13 @@ (ns common-tests.types.components-test (:require + [app.common.test-helpers.components :as thc] + [app.common.test-helpers.compositions :as tho] + [app.common.test-helpers.files :as thf] [app.common.test-helpers.ids-map :as thi] [app.common.test-helpers.shapes :as ths] [app.common.types.component :as ctk] + [app.common.types.file :as ctf] [clojure.test :as t])) (t/use-fixtures :each thi/test-fixture) @@ -39,3 +43,357 @@ (t/is (= (ctk/get-swap-slot s4) #uuid "9cc181fa-5eef-8084-8004-7bb2ab45fd1f")) (t/is (= (ctk/get-swap-slot s5) #uuid "9cc181fa-5eef-8084-8004-7bb2ab45fd1f")) (t/is (nil? (ctk/get-swap-slot s6))))) + +(t/deftest test-find-near-match + + (t/testing "shapes not in a component have no near match" + (let [file + ;; :frame1 [:name Frame1] + ;; :child1 [:name Rect1] + (-> (thf/sample-file :file1) + (tho/add-frame-with-child :frame1 :shape1)) + + page (thf/current-page file) + + frame1 (ths/get-shape file :frame1) + shape1 (ths/get-shape file :shape1) + + near-match1 (ctf/find-near-match file page {} frame1) + near-match2 (ctf/find-near-match file page {} shape1)] + + (t/is (nil? near-match1)) + (t/is (nil? near-match2)))) + + (t/testing "shapes in a copy get the ref-shape" + (let [file + ;; {:main-root} [:name Frame1] # [Component :component1] + ;; :main-child1 [:name Rect1] + ;; :main-child2 [:name Rect2] + ;; :main-child3 [:name Rect3] + ;; + ;; :copy-root [:name Frame1] #--> [Component :component1] :main-root + ;; [:name Rect1] ---> :main-child1 + ;; [:name Rect2] ---> :main-child2 + ;; [:name Rect3] ---> :main-child3 + (-> (thf/sample-file :file1) + (tho/add-component-with-many-children-and-copy :component1 + :main-root [:main-child1 :main-child2 :main-child3] + :copy-root)) + + page (thf/current-page file) + + main-root (ths/get-shape file :main-root) + main-child1 (ths/get-shape file :main-child1) + main-child2 (ths/get-shape file :main-child2) + main-child3 (ths/get-shape file :main-child3) + copy-root (ths/get-shape file :copy-root) + copy-child1 (ths/get-shape-by-id file (nth (:shapes copy-root) 0)) + copy-child2 (ths/get-shape-by-id file (nth (:shapes copy-root) 1)) + copy-child3 (ths/get-shape-by-id file (nth (:shapes copy-root) 2)) + + near-main-root (ctf/find-near-match file page {} main-root) + near-main-child1 (ctf/find-near-match file page {} main-child1) + near-main-child2 (ctf/find-near-match file page {} main-child2) + near-main-child3 (ctf/find-near-match file page {} main-child3) + near-copy-root (ctf/find-near-match file page {} copy-root) + near-copy-child1 (ctf/find-near-match file page {} copy-child1) + near-copy-child2 (ctf/find-near-match file page {} copy-child2) + near-copy-child3 (ctf/find-near-match file page {} copy-child3)] + + (t/is (nil? near-main-root)) + (t/is (nil? near-main-child1)) + (t/is (nil? near-main-child2)) + (t/is (nil? near-main-child3)) + (t/is (nil? near-copy-root)) + (t/is (= (:id near-copy-child1) (thi/id :main-child1))) + (t/is (= (:id near-copy-child2) (thi/id :main-child2))) + (t/is (= (:id near-copy-child3) (thi/id :main-child3))))) + + (t/testing "shapes in nested not swapped copies get the ref-shape" + (let [file + ;; {:main1-root} [:name Frame1] # [Component :component1] + ;; :main1-child [:name Rect1] + ;; + ;; {:main2-root} [:name Frame2] # [Component :component2] + ;; :nested-head [:name Frame1] @--> [Component :component1] :main1-root + ;; :nested-child [:name Rect1] ---> :main1-child + ;; + ;; :copy2 [:name Frame2] #--> [Component :component2] :main2-root + ;; :copy2-nested-head [:name Frame1] @--> [Component :component1] :nested-head + ;; :copy2-nested-child [:name Rect1] ---> :nested-child + (-> (thf/sample-file :file1) + (tho/add-nested-component :component1 :main1-root :main1-child + :component2 :main2-root :nested-head + :nested-head-params {:children-labels [:nested-child]}) + (thc/instantiate-component :component2 :copy2 + :children-labels [:copy2-nested-head :copy2-nested-child])) + + page (thf/current-page file) + + main1-root (ths/get-shape file :main1-root) + main1-child (ths/get-shape file :main1-child) + main2-root (ths/get-shape file :main2-root) + nested-head (ths/get-shape file :nested-head) + nested-child (ths/get-shape file :nested-child) + copy2 (ths/get-shape file :copy2) + copy2-nested-head (ths/get-shape file :copy2-nested-head) + copy2-nested-child (ths/get-shape file :copy2-nested-child) + + near-main1-root (ctf/find-near-match file page {} main1-root) + near-main1-child (ctf/find-near-match file page {} main1-child) + near-main2-root (ctf/find-near-match file page {} main2-root) + near-nested-head (ctf/find-near-match file page {} nested-head) + near-nested-child (ctf/find-near-match file page {} nested-child) + near-copy2 (ctf/find-near-match file page {} copy2) + near-copy2-nested-head (ctf/find-near-match file page {} copy2-nested-head) + near-copy2-nested-child (ctf/find-near-match file page {} copy2-nested-child)] + + (t/is (nil? near-main1-root)) + (t/is (nil? near-main1-child)) + (t/is (nil? near-main2-root)) + (t/is (nil? near-nested-head)) + (t/is (= (:id near-nested-child) (thi/id :main1-child))) + (t/is (nil? near-copy2)) + (t/is (= (:id near-copy2-nested-head) (thi/id :nested-head))) + (t/is (= (:id near-copy2-nested-child) (thi/id :nested-child))))) + + (t/testing "shapes in swapped copies get the swap slot" + (let [file + ;; {:main1-root} [:name Frame1] # [Component :component1] + ;; :main1-child [:name Rect1] + ;; + ;; {:main2-root} [:name Frame2] # [Component :component2] + ;; :nested-head [:name Frame1] @--> [Component :component1] :main1-root + ;; :nested-child [:name Rect1] ---> :main1-child + ;; + ;; {:main3-root} [:name Frame3] # [Component :component3] + ;; :main3-child [:name Rect3] + ;; + ;; :copy2 [:name Frame2] #--> [Component :component2] :main2-root + ;; :copy2-nested-head [:name Frame3] @--> [Component :component3] :main3-root + ;; {swap-slot :nested-head} + ;; [:name Rect3] ---> :main3-child + (-> (thf/sample-file :file1) + (tho/add-nested-component :component1 :main1-root :main1-child + :component2 :main2-root :nested-head + :nested-head-params {:children-labels [:nested-child]}) + (thc/instantiate-component :component2 :copy2 :children-labels [:copy2-nested-head]) + (tho/add-simple-component :component3 :main3-root :main3-child + :root-params {:name "Frame3"} + :child-params {:name "Rect3"}) + (tho/swap-component-in-first-child :copy2 :component3)) + + page (thf/current-page file) + + main1-root (ths/get-shape file :main1-root) + main1-child (ths/get-shape file :main1-child) + main2-root (ths/get-shape file :main2-root) + nested-head (ths/get-shape file :nested-head) + nested-child (ths/get-shape file :nested-child) + copy2 (ths/get-shape file :copy2) + copy2-nested-head (ths/get-shape file :copy2-nested-head) + copy2-nested-child (ths/get-shape-by-id file (first (:shapes copy2-nested-head))) + + near-main1-root (ctf/find-near-match file page {} main1-root) + near-main1-child (ctf/find-near-match file page {} main1-child) + near-main2-root (ctf/find-near-match file page {} main2-root) + near-nested-head (ctf/find-near-match file page {} nested-head) + near-nested-child (ctf/find-near-match file page {} nested-child) + near-copy2 (ctf/find-near-match file page {} copy2) + near-copy2-nested-head (ctf/find-near-match file page {} copy2-nested-head) + near-copy2-nested-child (ctf/find-near-match file page {} copy2-nested-child)] + + (t/is (nil? near-main1-root)) + (t/is (nil? near-main1-child)) + (t/is (nil? near-main2-root)) + (t/is (nil? near-nested-head)) + (t/is (= (:id near-nested-child) (thi/id :main1-child))) + (t/is (nil? near-copy2)) + (t/is (= (:id near-copy2-nested-head) (thi/id :nested-head))) + (t/is (= (:id near-copy2-nested-child) (thi/id :main3-child))))) + + (t/testing "shapes in second level nested copies under swapped get the shape in the new main" + (let [file + ;; {:main1-root} [:name Frame1] # [Component :component1] + ;; :main1-child [:name Rect1] + ;; + ;; {:main2-root} [:name Frame2] # [Component :component2] + ;; :nested2-head [:name Frame1] @--> [Component :component1] :main1-root + ;; :nested2-child [:name Rect1] ---> :main1-child + ;; + ;; {:main3-root} [:name Frame3] # [Component :component3] + ;; :main3-child [:name Rect3] + ;; + ;; {:main4-root} [:name Frame4] # [Component :component4] + ;; :nested4-head [:name Frame3] @--> [Component :component1] :main3-root + ;; :nested4-child [:name Rect3] ---> :main3-child + ;; + ;; :copy2 [:name Frame2] #--> [Component :component2] :main2-root + ;; :copy2-nested-head [:name Frame4] @--> [Component :component4] :main4-root + ;; {swap-slot :nested2-head} + ;; [:name Frame3] @--> :nested4-head + ;; [:name Rect3] ---> :nested4-child + (-> (thf/sample-file :file1) + (tho/add-nested-component :component1 :main1-root :main1-child + :component2 :main2-root :nested2-head + :nested-head-params {:children-labels [:nested2-child]}) + (thc/instantiate-component :component2 :copy2 :children-labels [:copy2-nested-head]) + (tho/add-nested-component :component3 :main3-root :main3-child + :component4 :main4-root :nested4-head + :root1-params {:name "Frame3"} + :main1-child-params {:name "Rect3"} + :main2-root-params {:name "Frame4"} + :nested-head-params {:children-labels [:nested4-child]}) + (tho/swap-component-in-first-child :copy2 :component4)) + + page (thf/current-page file) + + main1-root (ths/get-shape file :main1-root) + main1-child (ths/get-shape file :main1-child) + main2-root (ths/get-shape file :main2-root) + nested2-head (ths/get-shape file :nested2-head) + nested2-child (ths/get-shape file :nested2-child) + main3-root (ths/get-shape file :main3-root) + main3-child (ths/get-shape file :main3-child) + main4-root (ths/get-shape file :main4-root) + nested4-head (ths/get-shape file :nested4-head) + nested4-child (ths/get-shape file :nested4-child) + copy2 (ths/get-shape file :copy2) + copy2-nested-head (ths/get-shape file :copy2-nested-head) + copy2-nested4-head (ths/get-shape-by-id file (first (:shapes copy2-nested-head))) + copy2-nested4-child (ths/get-shape-by-id file (first (:shapes copy2-nested4-head))) + + near-main1-root (ctf/find-near-match file page {} main1-root) + near-main1-child (ctf/find-near-match file page {} main1-child) + near-main2-root (ctf/find-near-match file page {} main2-root) + near-nested2-head (ctf/find-near-match file page {} nested2-head) + near-nested2-child (ctf/find-near-match file page {} nested2-child) + near-main3-root (ctf/find-near-match file page {} main3-root) + near-main3-child (ctf/find-near-match file page {} main3-child) + near-main4-root (ctf/find-near-match file page {} main4-root) + near-nested4-head (ctf/find-near-match file page {} nested4-head) + near-nested4-child (ctf/find-near-match file page {} nested4-child) + near-copy2 (ctf/find-near-match file page {} copy2) + near-copy2-nested-head (ctf/find-near-match file page {} copy2-nested-head) + near-copy2-nested4-head (ctf/find-near-match file page {} copy2-nested4-head) + near-copy2-nested4-child (ctf/find-near-match file page {} copy2-nested4-child)] + + (t/is (nil? near-main1-root)) + (t/is (nil? near-main1-child)) + (t/is (nil? near-main2-root)) + (t/is (nil? near-nested2-head)) + (t/is (= (:id near-nested2-child) (thi/id :main1-child))) + (t/is (nil? near-main3-root)) + (t/is (nil? near-main3-child)) + (t/is (nil? near-main4-root)) + (t/is (nil? near-nested4-head)) + (t/is (= (:id near-nested4-child) (thi/id :main3-child))) + (t/is (nil? near-copy2)) + (t/is (= (:id near-copy2-nested-head) (thi/id :nested2-head))) + (t/is (= (:id near-copy2-nested4-head) (thi/id :nested4-head))) + (t/is (= (:id near-copy2-nested4-child) (thi/id :nested4-child))))) + + (t/testing "component in external libraries still work well" + (let [library1 + ;; {:main1-root} [:name Frame1] # [Component :component1] + ;; :main1-child [:name Rect1] + ;; + ;; {:main2-root} [:name Frame2] # [Component :component2] + ;; :nested2-head [:name Frame1] @--> [Component :component1] :main1-root + ;; :nested2-child [:name Rect1] ---> :main1-child + (-> (thf/sample-file :library1) + (tho/add-nested-component :component1 :main1-root :main1-child + :component2 :main2-root :nested2-head + :nested-head-params {:children-labels [:nested2-child]})) + library2 + ;; {:main3-root} [:name Frame3] # [Component :component3] + ;; :main3-child [:name Rect3] + ;; + ;; {:main4-root} [:name Frame4] # [Component :component4] + ;; :nested4-head [:name Frame3] @--> [Component :component1] :main3-root + ;; :nested4-child [:name Rect3] ---> :main3-child + (-> (thf/sample-file :library2) + (tho/add-nested-component :component3 :main3-root :main3-child + :component4 :main4-root :nested4-head + :root1-params {:name "Frame3"} + :main1-child-params {:name "Rect3"} + :main2-root-params {:name "Frame4"} + :nested-head-params {:children-labels [:nested4-child]})) + + file + ;; :copy2 [:name Frame2] #--> [Component :component2] :main2-root + ;; :copy2-nested-head [:name Frame4] @--> [Component :component4] :main4-root + ;; {swap-slot :nested2-head} + ;; [:name Frame3] @--> :nested4-head + ;; [:name Rect3] ---> :nested4-child + (-> (thf/sample-file :file1) + (thc/instantiate-component :component2 :copy2 :children-labels [:copy2-nested-head] + :library library1) + (tho/swap-component-in-first-child :copy2 :component4 :library library2)) + + page-library1 (thf/current-page library1) + page-library2 (thf/current-page library2) + page-file (thf/current-page file) + libraries {(:id library1) library1 + (:id library2) library2} + + main1-root (ths/get-shape library1 :main1-root) + main1-child (ths/get-shape library1 :main1-child) + main2-root (ths/get-shape library1 :main2-root) + nested2-head (ths/get-shape library1 :nested2-head) + nested2-child (ths/get-shape library1 :nested2-child) + main3-root (ths/get-shape library2 :main3-root) + main3-child (ths/get-shape library2 :main3-child) + main4-root (ths/get-shape library2 :main4-root) + nested4-head (ths/get-shape library2 :nested4-head) + nested4-child (ths/get-shape library2 :nested4-child) + copy2 (ths/get-shape file :copy2) + copy2-nested-head (ths/get-shape file :copy2-nested-head) + copy2-nested4-head (ths/get-shape-by-id file (first (:shapes copy2-nested-head))) + copy2-nested4-child (ths/get-shape-by-id file (first (:shapes copy2-nested4-head))) + + near-main1-root (ctf/find-near-match file page-file libraries main1-root) + near-main1-child (ctf/find-near-match file page-file libraries main1-child) + near-main2-root (ctf/find-near-match file page-file libraries main2-root) + near-nested2-head (ctf/find-near-match library1 page-library1 libraries nested2-head) + near-nested2-child (ctf/find-near-match library1 page-library1 libraries nested2-child) + near-main3-root (ctf/find-near-match file page-file libraries main3-root) + near-main3-child (ctf/find-near-match file page-file libraries main3-child) + near-main4-root (ctf/find-near-match file page-file libraries main4-root) + near-nested4-head (ctf/find-near-match library2 page-library2 libraries nested4-head) + near-nested4-child (ctf/find-near-match library2 page-library2 libraries nested4-child) + near-copy2 (ctf/find-near-match file page-file libraries copy2) + near-copy2-nested-head (ctf/find-near-match file page-file libraries copy2-nested-head) + near-copy2-nested4-head (ctf/find-near-match file page-file libraries copy2-nested4-head) + near-copy2-nested4-child (ctf/find-near-match file page-file libraries copy2-nested4-child)] + + (thf/dump-file library1 :keys [:name :swap-slot-label] :show-refs? true) + (t/is (some? main1-root)) + (t/is (some? main1-child)) + (t/is (some? main2-root)) + (t/is (some? nested2-head)) + (t/is (some? nested2-child)) + (t/is (some? main3-root)) + (t/is (some? main3-child)) + (t/is (some? main4-root)) + (t/is (some? nested4-head)) + (t/is (some? nested4-child)) + (t/is (some? copy2)) + (t/is (some? copy2-nested-head)) + (t/is (some? copy2-nested4-head)) + (t/is (some? copy2-nested4-child)) + + (t/is (nil? near-main1-root)) + (t/is (nil? near-main1-child)) + (t/is (nil? near-main2-root)) + (t/is (nil? near-nested2-head)) + (t/is (= (:id near-nested2-child) (thi/id :main1-child))) + (t/is (nil? near-main3-root)) + (t/is (nil? near-main3-child)) + (t/is (nil? near-main4-root)) + (t/is (nil? near-nested4-head)) + (t/is (= (:id near-nested4-child) (thi/id :main3-child))) + (t/is (nil? near-copy2)) + (t/is (= (:id near-copy2-nested-head) (thi/id :nested2-head))) + (t/is (= (:id near-copy2-nested4-head) (thi/id :nested4-head))) + (t/is (= (:id near-copy2-nested4-child) (thi/id :nested4-child))))))