🐛 Make a copy head that takes a position refer to its children

When a copy head took the place of a main shape and its component was
the one of that place, it stopped being a swap, but its children kept
referring to the main of its own component instead of to the children
of that place. Validation did not see it, and the next sync deleted
those children and added them again, losing their overrides, or the
head did not follow later changes to that place. It happened in:
- a variant switch that carries a swapped child into a variant whose
  child there has the same component;
- update main of a copy that swapped a nested copy back to the
  component a deeper main puts in that place, after the main in between
  swapped it for another one; the clone in the main also kept
  :swap-group;
- the repair of :ref-not-in-near-main, which also never cleared
  :swap-group.

The swap in a copy, the switch, update main and the repair now share
ctf/take-position: the head refers to the main shape of its position,
is swapped while its component differs from that shape's, and else its
descendants refer to the descendants of that shape.

The switch also read the swapped child from the objects of the swap,
where it was already gone with its old parent. It now reads it once it
is moved into the new copy, so its placement turns its children too,
and the undo takes it back to the root as the move to the root left it.
The swap finds the new shapes in its own objects, not in its changes.
The component memory says how a head takes a position.

Benchmark (lower quantile, ms; baseline / now / ratio):
  deepest-edit-through-three-levels    35.2 /  37.1 / 1.05
  edit-through-a-chain-of-dependents   68.9 /  70.5 / 1.02
  library-update-into-copies           83.1 /  77.3 / 0.93
  main-edit-into-10-copies              1.8 /   1.7 / 0.94
  main-edit-into-100-copies            15.4 /  16.0 / 1.04
  main-edit-into-1000-copies          153.1 / 160.6 / 1.05
  variant-switch-into-copies           32.1 /  28.7 / 0.89

AI-assisted-by: claude-opus-5-5

Co-Authored-By: Claude Opus 5.5 (1M context) <noreply@anthropic.com>

.serena/memories/common/component-data-model.md

@@ -31,9 +31,10 @@ Masters are not normally touched through `set-shape-attr`, but touched flags can
 - A copy sub-head the user SWAPPED to another component keeps `:shape-ref` on the near-main child it replaces (its *position*); `:component-id`/`:component-file` name the component its *content* comes from; the touched group `:swap-group` marks the swap. Its children refer into its own component's main.
 - So for a swapped head the position shape (`find-ref-shape`, X in the near main) and the content shape (its component's main root) differ. `ctf/find-ref-shape` gives position (parent heads are tried outermost first); code that needs the content of a swapped head goes through the content helper, never through `get-ref-shape` with the head's own component.
 - A copy sub-head whose component differs from its near main's component must have `:swap-group`; one that matches must not.
+- A head takes a position only through `ctf/take-position` (swap in a copy, keep-touched switch, update-main into a copy, the `:ref-not-in-near-main` repair): it refers to the position, is swapped iff its component differs, and otherwise its descendants are remapped to the position's descendants. Setting `:shape-ref`/`:swap-group` by hand leaves the children referring to the wrong main, which validation does not catch and the next sync turns into delete + re-add.
 - Copy children are paired to main children by `shape-ref` (`is-main-of?`, seek, not index), swapped or not. `find-near-match` (positional) is only a validator/repair heuristic; validity requires membership of the ref among the near-main parent's children, not index equality (`mem:common/file-change-validation-migration-subtleties`).
 - Copy child ORDER converges to the main's via the async sync (`moved` branch of `compare-children`); local code must never reorder copy children directly (guards in `:mov-objects`/`:reorder-children`).
-- Files older than the feature `components/swap-group` stored the swap as a slot (`swap-slot-<uuid>` touched group, `:shape-ref` on the new component's root); the migration converts them.
+- Files older than the feature `components/swap-group` stored the swap as a slot (`swap-slot-<uuid>` touched group, `:shape-ref` on the new component's root); the migration converts them. Shape-level slot helpers: `app.common.files.swap-slots`; ref-walking ones and the conversion: `app.common.files.comp-processors`.
 
 ## Cloning paths
 

common/src/app/common/files/comp_processors.cljc

@@ -274,8 +274,8 @@
 
 (defn find-replaced-shape
   "The child of the near main of the parent of the copy head `shape` whose
-  position the head takes: the one that stands for the deepest main child
-  the head refers to, or else the free one at the same index."
+  position the head takes, with context: the one that stands for the deepest
+  main child the head refers to, or else the free one at the same index."
   [file container libraries shape]
   (let [parent     (ctn/get-shape container (:parent-id shape))
         parent-ref (when parent
@@ -283,12 +283,13 @@
                                                  :include-deleted? true
                                                  :with-context? true))]
     (when parent-ref
-      (or (find-swap-position parent-ref libraries (:shape-ref shape))
-          (let [taken   (into #{} (keep #(:shape-ref (ctn/get-shape container %))) (:shapes parent))
-                index   (d/index-of (:shapes parent) (:id shape))
-                near-id (when index (get (:shapes parent-ref) index))]
-            (when (and (some? near-id) (not (contains? taken near-id)))
-              (ctn/get-shape (:container (meta parent-ref)) near-id)))))))
+      (some-> (or (find-swap-position parent-ref libraries (:shape-ref shape))
+                  (let [taken   (into #{} (keep #(:shape-ref (ctn/get-shape container %))) (:shapes parent))
+                        index   (d/index-of (:shapes parent) (:id shape))
+                        near-id (when index (get (:shapes parent-ref) index))]
+                    (when (and (some? near-id) (not (contains? taken near-id)))
+                      (ctn/get-shape (:container (meta parent-ref)) near-id))))
+              (with-meta (meta parent-ref))))))
 
 (defn- swap-made-in-copy?
   "Whether a copy head with the swap slot `slot` was swapped in its copy,

common/src/app/common/files/repair.cljc

@@ -605,28 +605,21 @@
 (defmethod repair-error :ref-not-in-near-main
   [_ {:keys [shape page-id] :as error} file-data libraries]
   (let [page     (ctpl/get-page file-data page-id)
-        replaced (cfcp/find-replaced-shape {:id (:id file-data) :data file-data}
-                                           (ctn/make-container page :page)
-                                           libraries
-                                           shape)
-
-        reassign-shape
-        (fn [shape]
-          (log/debug :hint "  -> reassign shape-ref to" :shape-ref (:id replaced))
-          (cond-> (assoc shape :shape-ref (:id replaced))
-            (or (not= (:component-id shape) (:component-id replaced))
-                (not= (:component-file shape) (:component-file replaced)))
-            (update :touched (fnil conj #{}) :swap-group)))]
+        file     {:id (:id file-data) :data file-data}
+        objects  (:objects page)
+        replaced (cfcp/find-replaced-shape file (ctn/make-container page :page) libraries shape)]
 
     (log/debug :hint "repairing shape :ref-not-in-near-main" :id (:id shape) :name (:name shape) :page-id page-id)
     (if (some? replaced)
-      (-> (pcb/empty-changes nil page-id)
-          (pcb/with-file-data file-data)
-          (pcb/update-shapes [(:id shape)] reassign-shape))
+      (do (log/debug :hint "  -> take the position of" :shape-ref (:id replaced))
+          (-> (pcb/empty-changes nil page-id)
+              (pcb/with-file-data file-data)
+              (pcb/update-shapes (cfh/get-children-ids-with-self objects (:id shape))
+                                 (ctf/take-position file libraries objects shape (:id replaced) replaced))))
       ;; no position to take: the copy keeps its content, detached
       (-> (pcb/empty-changes nil page-id)
           (pcb/with-file-data file-data)
-          (pcb/update-shapes (cfh/get-children-ids-with-self (:objects page) (:id shape))
+          (pcb/update-shapes (cfh/get-children-ids-with-self objects (:id shape))
                              ctk/detach-shape)))))
 
 (defmethod repair-error :duplicate-ref

common/src/app/common/logic/libraries.cljc

@@ -1373,28 +1373,23 @@
                                                (:id component-parent-shape)))
 
         ;; A swapped head pushed to the main replaces the main child it refers to.
-        ;; Inside a copy of the main it is a swap of that child's position;
+        ;; Inside a copy of the main it takes the position of that child;
         ;; elsewhere it is a plain copy of its own component.
         swap-in-copy?    (and (ctk/swapped? shape)
                               (seq (ctn/get-parent-copy-heads (:objects component-container)
                                                               component-parent-shape)))
-        new-swap-ref     (when (ctk/swapped? shape)
-                           (if swap-in-copy?
-                             (:shape-ref (ctn/get-shape component-container (:shape-ref shape)))
-                             (swap-content-root-id libraries shape)))
+        replaced         (when swap-in-copy?
+                           (ctn/get-shape component-container (:shape-ref shape)))
 
         update-new-shape (fn [new-shape original-shape]
                            (cond-> (reposition-shape new-shape
                                                      root-instance
                                                      root-main)
-                             (and (= (:id original-shape) (:id shape))
-                                  (ctk/swapped? shape))
-                             (assoc :shape-ref new-swap-ref)
-
                              (and (= (:id original-shape) (:id shape))
                                   (ctk/swapped? shape)
                                   (not swap-in-copy?))
-                             (ctk/remove-swap-group)))
+                             (-> (assoc :shape-ref (swap-content-root-id libraries shape))
+                                 (ctk/remove-swap-group))))
 
         ;; the copy now follows the main, swap included
         update-original-shape (fn [original-shape new-shape]
@@ -1402,7 +1397,7 @@
                                     (assoc :shape-ref (:id new-shape))
                                     (ctk/remove-swap-group)))
 
-        [_new-shape new-shapes updated-shapes]
+        [new-head new-shapes updated-shapes]
         (ctst/clone-shape shape
                           (:id component-parent-shape)
                           (get page :objects)
@@ -1412,6 +1407,16 @@
                                       (:id component-parent-shape)
                                       (:frame-id component-parent-shape)))
 
+        new-shapes
+        (if swap-in-copy?
+          (let [objects  (d/index-by :id new-shapes)
+                position (ctf/find-ref-shape nil component-container libraries replaced
+                                             :include-deleted? true
+                                             :with-context? true)]
+            (mapv (ctf/take-position nil libraries objects new-head (:shape-ref replaced) position)
+                  new-shapes))
+          new-shapes)
+
         add-obj-change (fn [changes shape']
                          (update changes :redo-changes conj
                                  (cond-> (make-change
@@ -2796,17 +2801,6 @@
           rotate?
           (as-> shape (gsh/transform-shape shape (ctm/rotation-modifiers shape center angle))))))))
 
-(defn- added-subtree
-  "The shapes the changes add under the shape `id`, itself included."
-  [changes id]
-  (let [added (->> (:redo-changes changes)
-                   (filter #(= :add-obj (:type %)))
-                   (map :obj)
-                   (d/index-by :id))]
-    (->> (vals added)
-         (filter #(or (= (:id %) id)
-                      (contains? (set (cfh/get-parent-ids added (:id %))) id))))))
-
 (defn- generate-keep-orientation
   "Give the new head of a swap, and its subtree, the flips and the rotation
   of the shape it replaces, around the head's own center. They come from
@@ -2814,61 +2808,24 @@
   [changes new-shape shape]
   (if-let [orient (orient-like new-shape shape (gsh/shape->center new-shape))]
     (pcb/update-shapes changes
-                       (map :id (added-subtree changes (:id new-shape)))
+                       (cfh/get-children-ids-with-self (pcb/get-objects changes) (:id new-shape))
                        orient
                        {:ignore-touched true})
     changes))
 
-(defn- main-ref-ids
-  "Map the shapes of a main subtree to the shapes of a copy of it: for each
-  shape in the subtree of `head`, follow its ref chain until a shape whose id
-  is in `main-ids`, and map that id to the shape's id."
-  [file container libraries head main-ids]
-  (let [ref-in-main
-        (fn [shape]
-          (loop [shape shape container container steps 0]
-            (when (and (some? shape) (< steps 64))
-              (if (contains? main-ids (:id shape))
-                (:id shape)
-                (let [ref (ctf/find-ref-shape file container libraries shape
-                                              :include-deleted? true
-                                              :with-context? true)]
-                  (recur ref (:container (meta ref)) (inc steps)))))))]
-    (into {}
-          (keep (fn [shape]
-                  (when-let [main-id (ref-in-main shape)]
-                    [main-id (:id shape)])))
-          (cfh/get-children-with-self (:objects container) (:id head)))))
-
 (defn- generate-swap-in-copy
-  "A swap inside a copy keeps the position: the new head refers to the main
-  shape the old one referred to. It is marked as swapped while its component
-  differs from that shape's; otherwise it is a plain nested copy of it, and
-  its children refer to that shape's children."
+  "A swap inside a copy keeps the position: the new head takes the place of
+  the main shape the old one referred to."
   [changes new-shape shape file page libraries]
-  (let [file*     {:id (:id file) :data file}
-        ref-shape (ctf/find-ref-shape file* page libraries shape
-                                      :include-deleted? true
-                                      :with-context? true)
-        swapped?  (or (nil? ref-shape)
-                      (not= (:component-id ref-shape) (:component-id new-shape))
-                      (not= (:component-file ref-shape) (:component-file new-shape)))
-        children  (->> (added-subtree changes (:id new-shape))
-                       (remove #(= (:id %) (:id new-shape))))
-        ref-map   (when-not swapped?
-                    (main-ref-ids file* (:container (meta ref-shape)) libraries ref-shape
-                                  (into #{} (map :shape-ref) children)))]
-    [(cond-> (assoc new-shape :shape-ref (:shape-ref shape))
-       swapped?
-       (update :touched (fnil conj #{}) :swap-group))
-     (cond-> (pcb/update-shapes changes
-                                [(:id new-shape)]
-                                #(assoc % :shape-ref (:shape-ref shape))
-                                {:ignore-touched true})
-       (seq ref-map)
-       (pcb/update-shapes (map :id children)
-                          #(d/update-when % :shape-ref (fn [ref] (get ref-map ref ref)))
-                          {:ignore-touched true}))]))
+  (let [file*    {:id (:id file) :data file}
+        objects  (pcb/get-objects changes)
+        position (ctf/find-ref-shape file* page libraries shape
+                                     :include-deleted? true
+                                     :with-context? true)]
+    (pcb/update-shapes changes
+                       (cfh/get-children-ids-with-self objects (:id new-shape))
+                       (ctf/take-position file* libraries objects new-shape (:shape-ref shape) position)
+                       {:ignore-touched true})))
 
 (defn generate-new-shape-for-swap
   [changes shape file page libraries id-new-component index target-cell keep-props-values]
@@ -2896,10 +2853,13 @@
                                         {(:id shape) (:id shape)} ;; keep the id of the original shape
                                         {:force-frame? true})
 
-        [new-shape changes]
-        (if inside-copy?
-          (generate-swap-in-copy changes new-shape shape file page libraries)
-          [new-shape changes])
+        changes
+        (cond-> changes
+          inside-copy?
+          (generate-swap-in-copy new-shape shape file page libraries))
+
+        new-shape
+        (get (pcb/get-objects changes) (:id new-shape))
 
         changes
         (generate-keep-orientation changes new-shape shape)]

common/src/app/common/logic/variants.cljc

@@ -75,7 +75,7 @@
    (related-shape-in-new), move the orig-swapped-child into the parent of
    related-shape-in-new, make it take the place of related-shape-in-new, and
    then delete related-shape-in-new"
-  [changes related-shape-in-new orig-swapped-child ldata page]
+  [changes related-shape-in-new orig-swapped-child ldata page libraries]
   (let [;; Before to the swap, temporary move the previous
         ;; shape to the root panel to avoid problems when
         ;; the previous parent is deleted.
@@ -84,30 +84,34 @@
                            (pcb/with-objects (:objects page))
                            (pcb/change-parent uuid/zero [orig-swapped-child] 0 {:allow-altering-copies true}))
 
-        objects         (pcb/get-objects changes)
-        current-parent  (get objects (:parent-id related-shape-in-new))
-        pos             (d/index-of (:shapes current-parent) (:id related-shape-in-new))]
+        ;; the child at the root, where the undo of the next move takes it
+        child-at-root  (get (pcb/get-objects before-changes) (:id orig-swapped-child))
 
-    (-> (pcb/concat-changes before-changes changes)
+        current-parent (get (pcb/get-objects changes) (:parent-id related-shape-in-new))
+        pos            (d/index-of (:shapes current-parent) (:id related-shape-in-new))
 
-        ;; Move the previous shape to the new parent. It comes from the root,
-        ;; where the undo must take it back before the new copy is deleted
-        (pcb/change-parent (:parent-id related-shape-in-new)
-                           [(assoc orig-swapped-child :parent-id uuid/zero)]
-                           pos
-                           {:allow-altering-copies true})
+        ;; Move the previous shape to the new parent
+        changes        (-> (pcb/concat-changes before-changes changes)
+                           (pcb/change-parent (:parent-id related-shape-in-new) [child-at-root] pos
+                                              {:allow-altering-copies true}))
 
-        ;; Take the place of the related shape; it stays a swap while its
-        ;; component differs from that one
+        objects        (pcb/get-objects changes)
+        child-id       (:id orig-swapped-child)
+        file           {:id (:id ldata) :data ldata}
+        position       (ctf/find-ref-shape file (assoc page :objects objects) libraries related-shape-in-new
+                                           :include-deleted? true
+                                           :with-context? true)]
+
+    (-> changes
+        ;; Take the place of the related shape
         (pcb/update-shapes
-         [(:id orig-swapped-child)]
-         #(cond-> (assoc % :shape-ref (:shape-ref related-shape-in-new))
-            (and (= (:component-id %) (:component-id related-shape-in-new))
-                 (= (:component-file %) (:component-file related-shape-in-new)))
-            (ctk/remove-swap-group)))
+         (cfh/get-children-ids-with-self objects child-id)
+         (ctf/take-position file libraries objects (get objects child-id)
+                            (:shape-ref related-shape-in-new) position)
+         {:ignore-touched true})
 
         ;; and its placement, as sync would give it
-        (cll/generate-take-placement orig-swapped-child
+        (cll/generate-take-placement (get objects child-id)
                                      related-shape-in-new
                                      objects
                                      (and (ctsl/any-layout-immediate-child? objects related-shape-in-new)
@@ -242,7 +246,7 @@
                    (if swapped?
                      ;; If the orig-child-touched was swapped, keep it
                      (keep-swapped-item changes related-shape-in-new orig-child-touched
-                                        ldata page)
+                                        ldata page libraries)
                      ;; If the orig-child-touched wasn't swapped, copy
                      ;; the touched attributes into it
                      (cll/update-attrs-on-switch

common/src/app/common/types/file.cljc

@@ -448,6 +448,54 @@
                     :include-deleted? include-deleted?
                     :with-context? with-context?)))
 
+(defn- descendant-refs
+  "Map each main shape in `main-ids` to the shape of the subtree of the main
+  shape `position` (found with context) that copies it, following the ref
+  chain of each shape of that subtree."
+  [file libraries position main-ids]
+  (let [container (:container (meta position))
+        ref-in-main
+        (fn [shape]
+          (loop [shape shape container container visited #{}]
+            (when (and (some? shape) (not (contains? visited (:id shape))))
+              (if (contains? main-ids (:id shape))
+                (:id shape)
+                (let [ref (find-ref-shape file container libraries shape
+                                          :include-deleted? true
+                                          :with-context? true)]
+                  (recur ref (:container (meta ref)) (conj visited (:id shape))))))))]
+    (into {}
+          (keep (fn [shape]
+                  (when-let [main-id (ref-in-main shape)]
+                    [main-id (:id shape)])))
+          (cfh/get-children-with-self (:objects container) (:id position)))))
+
+(defn take-position
+  "A function that updates each shape of the subtree of the copy head `head`
+  in `objects` so that the head takes the position of the main shape `ref-id`.
+  `position` is that shape, found with context, or nil when it cannot be
+  reached. The head refers to it, and is swapped while its component differs
+  from the one of `position`; otherwise it is a plain copy of `position`, and
+  its descendants refer to the descendants of `position`."
+  [file libraries objects head ref-id position]
+  (let [swapped? (or (nil? position)
+                     (not= (:component-id position) (:component-id head))
+                     (not= (:component-file position) (:component-file head)))
+        main-ids (when-not swapped?
+                   (into #{}
+                         (keep #(:shape-ref (get objects %)))
+                         (cfh/get-children-ids objects (:id head))))
+        ref-map  (when (seq main-ids)
+                   (descendant-refs file libraries position main-ids))]
+    (fn [shape]
+      (if (= (:id shape) (:id head))
+        (if swapped?
+          (-> (assoc shape :shape-ref ref-id)
+              (update :touched (fnil conj #{}) :swap-group))
+          (-> (assoc shape :shape-ref ref-id)
+              (ctk/remove-swap-group)))
+        (d/update-when shape :shape-ref #(get ref-map % %))))))
+
 (defn swapped-subhead?
   "Whether `shape` references outside its near main parent and needs a swap slot.
   Same-parent positional differences are synchronized as reorders."

common/test/common_tests/files/repair_components_test.cljc

@@ -405,6 +405,24 @@
     (t/is (= (thi/id :nested-a) (:shape-ref swapped)))
     (t/is (ctk/swapped? swapped))))
 
+(t/deftest ref-not-in-near-main-with-the-component-of-the-position
+  ;; a nested copy that refers to the root of its own component, which is
+  ;; the component of the free position at its index
+  (let [base     (two-nested)
+        child-id (first (:shapes (ths/get-shape base :copy-a)))
+        file     (-> base
+                     (ths/update-shape :copy-a :shape-ref (thi/id :main1-root))
+                     (ths/update-shape-by-id child-id :shape-ref (thi/id :main1-child)))
+        [found file' errors] (repair file)
+        copy-a   (ths/get-shape file' :copy-a)]
+    (t/is (contains? found :ref-not-in-near-main))
+    (t/is (nil? errors))
+    ;; it is a plain copy of that position, children included
+    (t/is (= (thi/id :nested-a) (:shape-ref copy-a)))
+    (t/is (not (ctk/swapped? copy-a)))
+    (t/is (= (first (:shapes (ths/get-shape file' :nested-a)))
+             (:shape-ref (ths/get-shape-by-id file' child-id))))))
+
 (t/deftest duplicate-ref
   ;; two children of the copy take the position of the same main shape
   (let [file (ths/update-shape (two-nested) :copy-b :shape-ref (thi/id :nested-a))

common/test/common_tests/logic/swap_group_test.cljc

@@ -366,6 +366,20 @@
     (t/is (not (ctk/swapped? head)))
     (t/is (= (:id (thc/get-component file :heart)) (:component-id head)))))
 
+(t/deftest switch-to-a-variant-with-the-same-component-refers-to-its-children
+  (let [file  (-> (setup-variants)
+                  (tho/swap-component-in-shape :child2 :heart)
+                  (tho/swap-component-in-shape :copy01 :c02 {:keep-touched? true}))
+        child (first-child file :copy-child)
+        file' (-> file
+                  (tho/update-color :heart-rect "#333333")
+                  (propagate :heart :c02)
+                  (thf/validate-file!))]
+    (t/is (= (:id (first-child file :child2)) (:shape-ref child)))
+    ;; sync keeps the child, so its overrides stay
+    (t/is (= [(:id child)] (:shapes (ths/get-shape file' :copy-child))))
+    (t/is (= "#333333" (tho/bottom-fill-color file' :copy01)))))
+
 (t/deftest switch-does-not-carry-a-swap-made-in-the-main
   ;; :variant2 [:name Board]
   ;;     {:n02} [:name Board]              # [Component :d02]
@@ -433,6 +447,34 @@
     (t/is (= (:id main) (:shape-ref head)))
     (t/is (not (ctk/swapped? head)))))
 
+(t/deftest update-main-of-a-swap-back-to-the-deeper-component-is-a-plain-copy
+  ;; {:page-main}                      # [Component :page]
+  ;;     :inner-copy                   @--> [Component :card]
+  ;;         :inner-star               @--> [Component :heart] (swapped)
+  ;; :outer-copy                       #--> [Component :page]
+  ;;     :outer-inner                  @--> :inner-copy
+  ;;         :outer-star               @--> [Component :star] (swapped back)
+  (let [file  (-> (setup)
+                  (tho/add-frame :page-main)
+                  (thc/instantiate-component :card :inner-copy
+                                             :parent-label :page-main
+                                             :children-labels [:inner-star])
+                  (tho/swap-component-in-shape :inner-star :heart)
+                  (thc/make-component :page :page-main)
+                  (thc/instantiate-component :page :outer-copy
+                                             :children-labels [:outer-inner :outer-star])
+                  (tho/swap-component-in-shape :outer-star :star)
+                  (update-main :outer-copy :page))
+        main  (first-child file :inner-copy)
+        head  (ths/get-shape file :outer-star)]
+    (t/is (= (:id (thc/get-component file :star)) (:component-id main)))
+    (t/is (= (thi/id :card-star) (:shape-ref main)))
+    (t/is (not (ctk/swapped? main)))
+    (t/is (= (:id (first-child file :card-star))
+             (:shape-ref (ths/get-shape-by-id file (first (:shapes main))))))
+    (t/is (= (:id main) (:shape-ref head)))
+    (t/is (not (ctk/swapped? head)))))
+
 (t/deftest update-main-of-a-swapped-head-updates-its-own-component
   (let [file  (setup)
         _     (thi/set-id! :copy-star-rect (:id (first-child file :copy-star)))
@@ -584,6 +626,25 @@
     (t/is (== 30 (mth/precision (:rotation copy) 2)))
     (t/is (== 30 (mth/precision (:rotation child) 2)))))
 
+(t/deftest switch-turns-the-swap-with-the-child-of-the-new-variant
+  (let [file  (-> (thf/sample-file :file1)
+                  (tho/add-simple-component :star :star-main :star-rect
+                                            :root-params {:width 40 :height 40}
+                                            :child-params {:width 30 :height 30})
+                  (tho/add-simple-component :heart :heart-main :heart-rect
+                                            :root-params {:width 40 :height 40}
+                                            :child-params {:width 30 :height 30})
+                  (thv/add-variant-with-copy :variant :c01 :m01 :c02 :m02 :child1 :child2 :star)
+                  (transform-subtree :child2 #(ctm/rotation-modifiers %1 %2 30))
+                  (thc/instantiate-component :c01 :copy01 :children-labels [:copy-child])
+                  (tho/swap-component-in-shape :copy-child :heart))
+        file' (-> file
+                  (tho/swap-component-in-shape :copy01 :c02 {:keep-touched? true}))
+        head  (ths/get-shape file' :copy-child)]
+    (t/is (ctk/swapped? head))
+    (t/is (== 30 (:rotation (orientation file' :copy-child))))
+    (t/is (== 30 (mth/precision (:rotation (ths/get-shape-by-id file' (first (:shapes head)))) 2)))))
+
 (t/deftest swapped-head-follows-the-rotation-of-the-replaced-child
   (let [file  (-> (setup-sized)
                   (tho/swap-component-in-shape :copy-star :heart))