⚡ Fuse the reg-objects of a change batch per container

The component sync emits a `:reg-objects` for the parents of every
shape it touches, so a component swap collected 291 of them for 36
containers. Recomputing a group's geometry N times in a row gives the
same result as doing it once, so most of that work was thrown away,
in the browser and on the server, on every save.

`mch/merge-reg-objects` collapses them into one per container, with
the union of the shapes. The merged change moves to the end of the
batch: a group has to be recomputed after the shapes that resized
it, not before, or it keeps a stale `:selrect` until something else
touches it. That is also why it must not stay in the position of the
first change it replaces.

It runs on every commit, redo and undo alike, so the undo stack gets
the same benefit, and again when the buffer is batched for saving.
Measured on the swap that motivated this: 291 `:reg-objects` become
36, and the batch goes from 806 changes / 6.4 MB to 551 / 324 KB.

AI-assisted-by: space-bunny

.serena/memories/common/changes-architecture.md

@@ -13,6 +13,11 @@ Each change is a map such as `{:type ... :id ... :page-id ...}`. Common families
 
 Each transaction carries `:redo-changes` and inverse `:undo-changes`. The undo stack stores transactions and can move its index backward/forward.
 
+## Batches that were already built
+
+`common/src/app/common/files/changes_merge.cljc` (alias `mch`) rewrites a finished batch into an equivalent smaller one, without touching file data.
+- `mch/merge-reg-objects`: the component sync emits one `:reg-objects` per touched shape, so a component swap carries hundreds of them for a handful of groups. It collapses them into one per container, union of `:shapes`, moved to the end of the batch so a group is always recomputed after the shapes that resized it. Applied to both redo and undo, on every commit (`frontend/src/app/main/data/changes.cljs`) and again when the buffer is batched for saving (`frontend/src/app/main/data/persistence.cljs`). Measured on a real swap: 291 `:reg-objects` become 36, the whole batch goes 806 changes / 6.4 MB to 551 / 324 KB.
+
 ## changes-builder API
 
 `common/src/app/common/files/changes_builder.cljc` (usually alias `pcb`) is the fluent builder. Start from `(pcb/empty-changes <it> <page-id>)` or `(pcb/empty-changes nil <page-id>)` for tests.

common/src/app/common/files/changes_merge.cljc

@@ -0,0 +1,65 @@
+;; 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 app.common.files.changes-merge
+  "Operations that rewrite a batch of changes that has already been built.
+
+   These take a finished batch and return an equivalent, smaller one. They do
+   not read the file data and do not build changes; for that, see the
+   changes-builder.")
+
+(defn- reg-objects-key
+  "The container a `:reg-objects` applies to. The applier touches
+  `:pages-index page-id` and `:components component-id`, and a missing id is a
+  no-op, so the pair identifies the change."
+  [change]
+  [(:page-id change) (:component-id change)])
+
+(defn- reg-objects-change
+  "Build the merged `:reg-objects` for a container. `:page-id` and
+  `:component-id` are only set when present, the change schema rejects an
+  explicit nil."
+  [[page-id component-id] shapes]
+  (cond-> {:type :reg-objects
+           :shapes (vec shapes)}
+    page-id (assoc :page-id page-id)
+    component-id (assoc :component-id component-id)))
+
+(defn merge-reg-objects
+  "Collapse the `:reg-objects` of a change batch into one per container.
+
+   The component sync emits one per touched shape, so a large operation piles
+   many of them onto the same few groups: one measured component swap carried
+   291 of them for 36 containers. `:reg-objects` recomputes group geometry
+   from the children, so a single run with the union of the shapes gives the
+   same result as running each one in turn.
+
+   The merged change goes to the end of the batch, not to the position of the
+   first one it replaces. A group must be recomputed after the shapes that
+   resized it, otherwise it keeps a stale `:selrect` and the mismatch does not
+   show until something else touches the group.
+
+   Works the same for `:undo-changes`, whose list already runs in reverse
+   order: the merged change lands at the end there too, so the group is
+   recomputed once the shapes are back to their previous values."
+  [changes]
+  (let [regs (filter #(= :reg-objects (:type %)) changes)
+        ;; Containers keyed by [page-id component-id], remembering the order
+        ;; they first showed up so the merged batch is deterministic.
+        merged (reduce (fn [acc change]
+                         (let [k (reg-objects-key change)]
+                           (if (contains? (:groups acc) k)
+                             (update-in acc [:groups k] into (:shapes change))
+                             (-> acc
+                                 (assoc-in [:groups k] (set (:shapes change)))
+                                 (update :order conj k)))))
+                       {:order [] :groups {}}
+                       regs)]
+
+    (into (vec (remove #(= :reg-objects (:type %)) changes))
+          (map (fn [k]
+                 (reg-objects-change k (get-in merged [:groups k])))
+               (:order merged)))))

common/test/common_tests/files_changes_test.cljc

@@ -9,13 +9,17 @@
    [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]
@@ -251,6 +255,185 @@
                 "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)

frontend/src/app/main/data/changes.cljs

@@ -9,6 +9,7 @@
    [app.common.data :as d]
    [app.common.data.macros :as dm]
    [app.common.files.changes :as cpc]
+   [app.common.files.changes-merge :as mch]
    [app.common.logging :as log]
    [app.common.time :as ct]
    [app.common.types.shape :as cts]
@@ -171,6 +172,14 @@
   (let [commit-id (or commit-id (uuid/next))
         source    (d/nilv source :local)
         local?    (= source :local)
+        ;; The component sync emits a `reg-objects` per touched shape, so a
+        ;; component swap or a wide group edit fills the batch with hundreds of
+        ;; them for a handful of groups. Fusing per container keeps the batch
+        ;; equivalent and much smaller. It runs here so every commit is already
+        ;; fused on its way to the store, the undo stack and the save queue,
+        ;; redo and undo alike.
+        redo-changes (mch/merge-reg-objects redo-changes)
+        undo-changes (mch/merge-reg-objects undo-changes)
         commit    {:id commit-id
                    :created-at (ct/now)
                    :source source

frontend/src/app/main/data/persistence.cljs

@@ -9,6 +9,7 @@
    [app.common.data :as d]
    [app.common.data.macros :as dm]
    [app.common.exceptions :as ex]
+   [app.common.files.changes-merge :as mch]
    [app.common.logging :as log]
    [app.common.time :as ct]
    [app.common.uuid :as uuid]
@@ -542,8 +543,13 @@
   [buffer]
   (->> (rx/from (group-by :file-id buffer))
        (rx/map (fn [[_ [item :as commits]]]
-                 (let [uchg (into [] xf-mapcat-undo commits)
-                       rchg (into [] xf-mapcat-redo commits)]
+                 (let [;; The component sync emits a `reg-objects` per touched
+                       ;; shape, and a batched swap collects hundreds of them
+                       ;; for a handful of groups. Fusing them per container
+                       ;; keeps the batch equivalent and much smaller, both
+                       ;; here and in the undo stack.
+                       uchg (mch/merge-reg-objects (into [] xf-mapcat-undo commits))
+                       rchg (mch/merge-reg-objects (into [] xf-mapcat-redo commits))]
                    (-> item
                        (assoc :undo-changes uchg)
                        (assoc :redo-changes rchg)