⚡ Keep only the shape data the worker reads (#12840)

* ⚡ Keep only the shape data the worker reads

The worker kept a full copy of the current page for its selection and
snap indexes. It now keeps only the attributes the indexes and the
change replay read, and re-indexes only the shapes that changed.

On a 52k-shape page the worker heap goes from 698 MB to 286 MB.

Closes #12740

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

* ♻️ Share the worker re-trim with its replay test

The worker and its replay test now share `retrim-objects`.

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

common/src/app/common/files/changes.cljc

@@ -524,6 +524,59 @@
      (let [result (reduce #(or (process-change %1 %2) %1) data items)]
        (reduce process-touched-change result @*touched-changes*)))))
 
+(defn- get-frame-descendant-ids
+  "Ids below `id` whose `:frame-id` a move rewrites; the walk stops at
+  boards, as `update-frame-id` in `:mov-objects` does."
+  [objects id]
+  (let [shape (get objects id)]
+    (when-not (cfh/frame-shape? shape)
+      (mapcat #(cons % (get-frame-descendant-ids objects %))
+              (get shape :shapes)))))
+
+(defn- get-change-candidate-ids
+  [old-objects new-objects change]
+  (case (:type change)
+    :add-obj
+    (let [parent-id (or (:parent-id change) (:frame-id change))]
+      [(:id change)
+       (if (contains? new-objects parent-id) parent-id uuid/zero)])
+
+    (:mod-obj :fix-obj)
+    [(:id change)]
+
+    :del-obj
+    (let [id     (:id change)
+          target (get old-objects id)]
+      (when (some? target)
+        (into [id (or (:parent-id target) (:frame-id target))]
+              (cfh/get-children-ids old-objects id))))
+
+    :mov-objects
+    (let [shapes (:shapes change)]
+      (-> [(:parent-id change)]
+          (into shapes)
+          (into (keep #(dm/get-in old-objects [% :parent-id])) shapes)
+          (into (mapcat #(get-frame-descendant-ids new-objects %)) shapes)))
+
+    :reg-objects
+    (let [shapes (:shapes change)]
+      (into (vec shapes) (mapcat #(cfh/get-parent-ids new-objects %)) shapes))
+
+    :reorder-children
+    [(:parent-id change)]
+
+    nil))
+
+(defn get-candidate-object-ids
+  "Ids on `page-id` that `changes` may have added, edited or removed;
+  it may hold unchanged ids but never misses a changed one."
+  [old-objects new-objects page-id changes]
+  (into #{}
+        (comp (filter #(= page-id (:page-id %)))
+              (mapcat #(get-change-candidate-ids old-objects new-objects %))
+              (remove nil?))
+        changes))
+
 ;; --- Comment Threads
 
 (defmethod process-change :set-comment-thread-position
@@ -653,6 +706,7 @@
   [objects {:keys [parent-id shapes allow-altering-copies] :as change}]
   (if-let [old-shapes (dm/get-in objects [parent-id :shapes])]
     ;; Component sync owns copy child ordering.
+    ;; The worker replays this on trimmed shapes: see `app.worker.trim`.
     (if (and (not allow-altering-copies)
              (ctk/in-component-copy? (get objects parent-id)))
       objects
@@ -736,6 +790,7 @@
                              (empty? children)
                              group
 
+                             ;; The worker replays this on trimmed shapes: see `app.worker.trim`.
                              (= :bool (:type group))
                              (path/update-bool-shape group objects)
 
@@ -764,6 +819,7 @@
           ;; Avoid placing a shape as a direct or indirect child of itself, or
           ;; inside its main component if it's in a copy, or inside a copy, or
           ;; from a copy
+          ;; The worker replays this on trimmed shapes: see `app.worker.trim`.
           (is-valid-move? [objects shape-id]
             (let [invalid-targets (calculate-invalid-targets objects shape-id)
                   shape (get objects shape-id)]

common/src/app/common/files/page_diff.cljc

@@ -12,7 +12,9 @@
    [clojure.set :as set]))
 
 (defn calculate-page-diff
-  [old-page page check-attrs]
+  "Only the objects in `object-ids` are compared; guides are always
+  compared in full."
+  [old-page page check-attrs object-ids]
 
   (let [old-objects (get old-page :objects)
         old-guides (or (get old-page :guides) [])
@@ -83,8 +85,7 @@
         changed-object-ids
         (into #{}
               (filter changed-object?)
-              (set/union (set (keys old-objects))
-                         (set (keys new-objects))))
+              object-ids)
 
         changed-guides-ids
         (into #{}

common/test/common_tests/files/page_diff_test.cljc

@@ -0,0 +1,54 @@
+;; 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.page-diff-test
+  (:require
+   [app.common.files.page-diff :as diff]
+   [app.common.types.shape :as cts]
+   [app.common.uuid :as uuid]
+   [clojure.test :as t]))
+
+(def ^:private check-attrs [:frame-id :x :y :width :height :hidden :selrect :grids])
+
+(def ^:private rect-a-id (uuid/custom 50 1))
+(def ^:private rect-b-id (uuid/custom 50 2))
+(def ^:private rect-c-id (uuid/custom 50 3))
+(def ^:private guide-id (uuid/custom 50 4))
+
+(defn- make-rect
+  [id x]
+  (cts/setup-shape {:id id :type :rect :name "rect"
+                    :frame-id uuid/zero :parent-id uuid/zero
+                    :x x :y 0 :width 10 :height 10}))
+
+(def ^:private old-page
+  {:id (uuid/custom 50 10)
+   :objects {rect-a-id (make-rect rect-a-id 0)
+             rect-b-id (make-rect rect-b-id 0)}})
+
+(def ^:private new-page
+  {:id (uuid/custom 50 10)
+   :objects {rect-a-id (make-rect rect-a-id 50)
+             rect-b-id (make-rect rect-b-id 50)
+             rect-c-id (make-rect rect-c-id 0)}
+   :guides {guide-id {:id guide-id :axis :x :position 10}}})
+
+(t/deftest diff-with-every-id-reports-every-change
+  (let [result (diff/calculate-page-diff old-page new-page check-attrs
+                                         #{rect-a-id rect-b-id rect-c-id})]
+    (t/is (= #{rect-a-id rect-b-id}
+             (into #{} (map (comp :id second)) (:updated-shapes result))))
+    (t/is (= [rect-c-id] (mapv :id (:new-shapes result))))
+    (t/is (= [guide-id] (mapv :id (:new-guides result))))))
+
+(t/deftest diff-ignores-objects-outside-the-given-ids
+  (let [result (diff/calculate-page-diff old-page new-page check-attrs #{rect-a-id})]
+    (t/is (= [rect-a-id] (mapv (comp :id second) (:updated-shapes result))))
+    (t/is (= [] (:new-shapes result)))))
+
+(t/deftest diff-always-compares-every-guide
+  (let [result (diff/calculate-page-diff old-page new-page check-attrs #{})]
+    (t/is (= [guide-id] (mapv :id (:new-guides result))))))

common/test/common_tests/files_changes_test.cljc

@@ -22,6 +22,7 @@
    [app.common.types.typography :as ctt]
    [app.common.uuid :as uuid]
    [clojure.datafy :refer [datafy]]
+   [clojure.set :as set]
    [clojure.test :as t]
    [clojure.walk :as walk]
    [common-tests.types.shape-decode-encode-test :refer [json-roundtrip]]))
@@ -1165,3 +1166,138 @@
               (nil? (get-in result2 [:pages-index page-id :default-grids])))))
 
      {:num 1000})))
+
+;; --- Candidate object ids
+
+(defn- add-shape-change
+  [page-id [id parent-id frame-id type]]
+  {:type :add-obj :id id :page-id page-id
+   :frame-id frame-id :parent-id parent-id
+   :obj (cts/setup-shape
+         {:id id :type type :name (name type)
+          :frame-id frame-id :parent-id parent-id
+          :x 0 :y 0 :width 10 :height 10})})
+
+(defn- make-tree-data
+  "A board with a group of two rects, a rect at the root, and two nested
+  groups around a rect."
+  [page-id ids]
+  (ch/process-changes
+   (make-file-data (uuid/custom 40 99) page-id)
+   (mapv (partial add-shape-change page-id)
+         [[(ids :board)  uuid/zero    uuid/zero    :frame]
+          [(ids :group)  (ids :board) (ids :board) :group]
+          [(ids :rect-a) (ids :group) (ids :board) :rect]
+          [(ids :rect-b) (ids :group) (ids :board) :rect]
+          [(ids :rect-c) uuid/zero    uuid/zero    :rect]
+          [(ids :outer)  uuid/zero    uuid/zero    :group]
+          [(ids :inner)  (ids :outer) uuid/zero    :group]
+          [(ids :rect-d) (ids :inner) uuid/zero    :rect]])))
+
+(def ^:private tree-ids
+  (zipmap [:board :group :rect-a :rect-b :rect-c :outer :inner :rect-d :new]
+          (map #(uuid/custom 40 %) (range 1 10))))
+
+(defn- get-changed-ids
+  [old-objects new-objects]
+  (into #{}
+        (filter #(not= (get old-objects %) (get new-objects %)))
+        (set/union (set (keys old-objects)) (set (keys new-objects)))))
+
+(defn- apply-and-get-candidates
+  "Applies `changes`, checks that the candidates cover every changed id,
+  and returns the candidates."
+  [data page-id changes]
+  (let [old-objects (get-in data [:pages-index page-id :objects])
+        result      (ch/process-changes data changes)
+        new-objects (get-in result [:pages-index page-id :objects])
+        candidates  (ch/get-candidate-object-ids old-objects new-objects page-id changes)]
+    (t/is (set/subset? (get-changed-ids old-objects new-objects) candidates)
+          "Every changed object must be a candidate")
+    candidates))
+
+(t/deftest candidate-ids-of-added-shapes
+  (let [page-id (uuid/custom 40 100)
+        ids     tree-ids
+        data    (make-tree-data page-id ids)]
+    (t/testing "A shape added at the root gives the shape and the root"
+      (t/is (= #{(ids :new) uuid/zero}
+               (apply-and-get-candidates
+                data page-id
+                [(add-shape-change page-id [(ids :new) uuid/zero uuid/zero :rect])]))))
+    (t/testing "A shape added inside a board gives the shape and the board"
+      (t/is (= #{(ids :new) (ids :board)}
+               (apply-and-get-candidates
+                data page-id
+                [(add-shape-change page-id [(ids :new) (ids :board) (ids :board) :rect])]))))))
+
+(t/deftest candidate-ids-of-modified-shape
+  (let [page-id (uuid/custom 40 100)
+        ids     tree-ids
+        data    (make-tree-data page-id ids)]
+    (t/is (= #{(ids :rect-a)}
+             (apply-and-get-candidates
+              data page-id
+              [{:type :mod-obj :id (ids :rect-a) :page-id page-id
+                :operations [{:type :set :attr :name :val "renamed"}]}])))))
+
+(t/deftest candidate-ids-of-deleted-group
+  (let [page-id    (uuid/custom 40 100)
+        ids        tree-ids
+        data       (make-tree-data page-id ids)
+        candidates (apply-and-get-candidates
+                    data page-id
+                    [{:type :del-obj :id (ids :group) :page-id page-id}])]
+    (t/is (set/subset? #{(ids :group) (ids :rect-a) (ids :rect-b) (ids :board)}
+                       candidates))))
+
+(t/deftest candidate-ids-of-moved-group
+  (let [page-id    (uuid/custom 40 100)
+        ids        tree-ids
+        data       (make-tree-data page-id ids)
+        candidates (apply-and-get-candidates
+                    data page-id
+                    [{:type :mov-objects :page-id page-id
+                      :parent-id (ids :board) :shapes [(ids :outer)]}])]
+    (t/is (set/subset? #{(ids :outer) (ids :inner) (ids :rect-d) (ids :board) uuid/zero}
+                       candidates))))
+
+(t/deftest candidate-ids-of-registered-objects
+  (let [page-id (uuid/custom 40 100)
+        ids     tree-ids
+        data    (make-tree-data page-id ids)
+        rect    (get-in data [:pages-index page-id :objects (ids :rect-d)])
+        moved   (gsh/move rect (gpt/point 100 0))
+        data    (ch/process-changes
+                 data
+                 [{:type :mod-obj :id (ids :rect-d) :page-id page-id
+                   :operations (mapv (fn [[attr val]] {:type :set :attr attr :val val})
+                                     (select-keys moved [:x :y :selrect :points]))}])]
+    (t/is (set/subset? #{(ids :inner) (ids :outer)}
+                       (apply-and-get-candidates
+                        data page-id
+                        [{:type :reg-objects :page-id page-id :shapes [(ids :rect-d)]}])))))
+
+(t/deftest candidate-ids-of-reordered-children
+  (let [page-id (uuid/custom 40 100)
+        ids     tree-ids
+        data    (make-tree-data page-id ids)]
+    (t/is (= #{(ids :group)}
+             (apply-and-get-candidates
+              data page-id
+              [{:type :reorder-children :page-id page-id
+                :parent-id (ids :group) :shapes [(ids :rect-b) (ids :rect-a)]}])))))
+
+(t/deftest candidate-ids-ignore-other-pages
+  (let [page-id (uuid/custom 40 100)
+        ids     tree-ids
+        data    (make-tree-data page-id ids)]
+    (t/is (= #{}
+             (ch/get-candidate-object-ids
+              (get-in data [:pages-index page-id :objects])
+              (get-in data [:pages-index page-id :objects])
+              page-id
+              [{:type :mod-obj :id (ids :rect-a) :page-id (uuid/custom 40 101)
+                :operations [{:type :set :attr :name :val "renamed"}]}
+               {:type :set-plugin-data :object-type :shape :object-id (ids :rect-a)
+                :page-id page-id :namespace "ns" :key "k" :value "v"}])))))

common/test/common_tests/runner.cljc

@@ -26,6 +26,7 @@
    [common-tests.files-migrations-test]
    [common-tests.files.comp-processors-test]
    [common-tests.files.helpers-test]
+   [common-tests.files.page-diff-test]
    [common-tests.files.repair-test]
    [common-tests.files.shapes-builder-test]
    [common-tests.files.tokens-test]
@@ -135,6 +136,7 @@
    'common-tests.files-migrations-test
    'common-tests.files.comp-processors-test
    'common-tests.files.helpers-test
+   'common-tests.files.page-diff-test
    'common-tests.files.repair-test
    'common-tests.files.shapes-builder-test
    'common-tests.files.tokens-test

frontend/src/app/worker/index.cljs

@@ -7,7 +7,6 @@
 (ns app.worker.index
   "Page index management within the worker."
   (:require
-   [app.common.data :as d]
    [app.common.data.macros :as dm]
    [app.common.files.changes :as ch]
    [app.common.geom.rect :as grc]
@@ -16,15 +15,53 @@
    [app.worker.impl :as impl]
    [app.worker.selection :as selection]
    [app.worker.snap :as snap]
+   [app.worker.trim :as trim]
    [okulary.core :as l]))
 
 (log/set-level! :info)
 
 (defonce state (l/atom {:pages-index {}}))
 
+;; Changes that edit what the indexes read. Replaying one on a trimmed page
+;; needs the attributes it reads in `app.worker.trim`.
+(def index-change-types
+  #{:add-obj :mod-obj :del-obj :fix-obj :mov-objects :reg-objects
+    :reorder-children :set-guide :del-page})
+
+;; Changes that leave the indexes alone.
+(def skipped-change-types
+  #{:set-comment-thread-position :set-flow :set-default-grid
+    :add-page :mod-page :mov-page :set-plugin-data
+    :add-color :mod-color :del-color
+    :add-media :mod-media :del-media
+    :add-component :mod-component :del-component :restore-component :purge-component
+    :add-typography :mod-typography :del-typography
+    :set-tokens-lib :set-token :set-token-set :set-token-theme :set-tokens-status
+    :set-own-tokens-status :rename-token-set-group :move-token-set
+    :move-token-set-group :set-base-font-size :set-tokens-source})
+
+(defn- index-change?
+  [{:keys [type]}]
+  (cond
+    (contains? index-change-types type)
+    true
+
+    (contains? skipped-change-types type)
+    false
+
+    :else
+    (do (log/wrn :hint "change type unknown to the worker index, skipped" :type type)
+        false)))
+
+(defn- changed-object?
+  [old-object new-object]
+  (and (not (identical? old-object new-object))
+       (not= old-object new-object)))
+
 (defmethod impl/handler :index/initialize
   [{:keys [page] :as message}]
-  (let [tpoint (ct/tpoint-ms)]
+  (let [tpoint (ct/tpoint-ms)
+        page   (trim/trim-page page)]
     (try
       (swap! state update :pages-index assoc (:id page) page)
       (swap! state update ::selection selection/add-page page)
@@ -49,7 +86,8 @@
   (let [tpoint (ct/tpoint-ms)]
     (try
       (if-let [old-page (dm/get-in @state [:pages-index page-id])]
-        (let [new-page (-> state
+        (let [changes  (filterv index-change? changes)
+              new-page (-> state
                            (swap! ch/process-changes changes false)
                            (dm/get-in [:pages-index page-id]))]
           (if (nil? new-page)
@@ -58,18 +96,20 @@
                               (update ::snap dissoc page-id)
                               (update ::selection dissoc page-id)))
 
-            (let [text-rects (dm/get-in @state [::text-rect page-id])
+            (let [old-objects (:objects old-page)
+                  ids         (ch/get-candidate-object-ids old-objects (:objects new-page) page-id changes)
+                  new-page    (update new-page :objects #(trim/retrim-objects old-objects % ids))
+                  new-objects (:objects new-page)
+                  ids         (into #{}
+                                    (filter #(changed-object? (get old-objects %) (get new-objects %)))
+                                    ids)
+                  guides?     (not (identical? (:guides old-page) (:guides new-page)))]
+              (swap! state #(cond-> (assoc-in % [:pages-index page-id] new-page)
+                              (or (seq ids) guides?)
+                              (update ::snap snap/update-page old-page new-page ids)
 
-                  ;; Update page objects with the text data
-                  new-page
-                  (reduce-kv
-                   (fn [page id data]
-                     (update-in page [:objects id] d/patch-object data))
-                   new-page
-                   text-rects)]
-
-              (swap! state update ::snap snap/update-page old-page new-page)
-              (swap! state update ::selection selection/update-page old-page new-page))))
+                              (seq ids)
+                              (update ::selection selection/update-page old-page new-page ids))))))
 
         ;; A later `:index/initialize` sends the whole page again
         (log/dbg :hint "page not indexed, skipping update" :id page-id ::log/sync? true))

frontend/src/app/worker/messages.cljs

@@ -28,9 +28,7 @@
         obj #js {:cmd (d/name (:cmd payload))
                  :senderId (when sender-id (str sender-id))
                  :replyTo (when reply-to (str reply-to))
-                 :payload (if (= :initialize-indices (:cmd payload))
-                            (:file-raw payload)
-                            (when (some? payload) (t/encode-str payload)))
+                 :payload (when (some? payload) (t/encode-str payload))
                  :buffer (when (some? buffer?) buffer?)
                  :completed (when completed true)}]
     (when (some? blob)
@@ -48,8 +46,7 @@
         (assoc :data nil)))))
 
 (defn decode [^js data]
-  (let [cmd (obj/get data "cmd")
-        sender-id (obj/get data "senderId")
+  (let [sender-id (obj/get data "senderId")
         reply-to (obj/get data "replyTo")
         payload (obj/get data "payload")
         buffer (obj/get data "buffer")
@@ -60,10 +57,7 @@
         (d/without-nils
          {:sender-id (when sender-id (uuid sender-id))
           :reply-to (when reply-to (uuid reply-to))
-          :payload (if (= cmd "initialize-indices")
-                     {:cmd :initialize-indices
-                      :file-raw payload}
-                     (when (some? payload) (t/decode-str payload)))
+          :payload (when (some? payload) (t/decode-str payload))
           :buffer? buffer
           :completed completed
           :error (js->error-map error)})]

frontend/src/app/worker/selection.cljs

@@ -16,8 +16,7 @@
    [app.common.geom.shapes.text :as gst]
    [app.common.types.modifiers :as ctm]
    [app.common.uuid :as uuid]
-   [app.util.quadtree :as qdt]
-   [clojure.set :as set]))
+   [app.util.quadtree :as qdt]))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; IMPL
@@ -107,22 +106,13 @@
                                  (dissoc objects uuid/zero))]
     {:index index :bounds bounds :parents-index parents-index :clip-index clip-index}))
 
-;; FIXME: optimize
 (defn- update-index
-  [{index :index :as data} old-objects new-objects]
-  (let [object-changed?
-        (fn [id]
-          (not= (get old-objects id)
-                (get new-objects id)))
-
-        changed-ids
+  [{index :index :as data} new-objects object-ids]
+  (let [changed-ids
         (into #{}
-              (comp (filter #(not= % uuid/zero))
-                    (filter object-changed?)
+              (comp (remove #(= % uuid/zero))
                     (mapcat #(into [%] (cfh/get-children-ids new-objects %))))
-
-              (set/union (set (keys old-objects))
-                         (set (keys new-objects))))
+              object-ids)
 
         shapes
         (->> changed-ids
@@ -272,13 +262,13 @@
   (assoc state id (create-index objects)))
 
 (defn update-page
-  "Update page index on the state"
-  [state old-page new-page]
+  "Update page index on the state. `object-ids` are the objects that
+  changed between `old-page` and `new-page`."
+  [state old-page new-page object-ids]
   (let [page-id (get old-page :id)]
     (update state page-id
             (fn [index]
-              (let [old-objects (:objects old-page)
-                    new-objects (:objects new-page)
+              (let [new-objects (:objects new-page)
                     old-bounds  (:bounds index)
                     new-bounds  (objects-bounds new-objects)]
 
@@ -287,7 +277,7 @@
                 ;; re-create it.
                 (if (and (some? index)
                          (grc/contains-rect? old-bounds new-bounds))
-                  (update-index index old-objects new-objects)
+                  (update-index index new-objects object-ids)
                   (create-index new-objects)))))))
 
 (defn query

frontend/src/app/worker/snap.cljs

@@ -226,8 +226,9 @@
     (assoc snap-data (:id page) page-data)))
 
 (defn update-page
-  "Updates a previously inserted page with new data"
-  [snap-data old-page page]
+  "Updates a previously inserted page with new data. Only the objects in
+  `object-ids` are checked for changes."
+  [snap-data old-page page object-ids]
 
   (if (contains? snap-data (:id page))
     ;; Update page
@@ -245,7 +246,7 @@
                             new-frames
                             new-shapes
                             new-guides]}
-                    (diff/calculate-page-diff old-page page snap-attrs)]
+                    (diff/calculate-page-diff old-page page snap-attrs object-ids)]
 
                 (as-> page-data $
                   (reduce (partial update-shape objects) $ change-frame-shapes)

frontend/src/app/worker/trim.cljs

@@ -0,0 +1,103 @@
+;; 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.worker.trim
+  "Keeps only the shape attributes the worker reads: its selection and
+  snap indexes, and the change replay of `process-changes`."
+  (:require
+   [app.common.transit :as t]
+   [app.common.types.objects-map :as omap]
+   [app.common.types.shape :as cts]))
+
+;; The attributes the worker keeps. Add one when the selection or snap index,
+;; or a change type in `app.worker.index/index-change-types`, reads it.
+(def ^:private shape-attrs
+  [:id :type :parent-id :frame-id :shapes
+   :x :y :width :height :rotation :selrect :points
+   :transform :transform-inverse :flip-x :flip-y
+   :hidden :blocked :show-content :masked-group
+   ;; The replay refuses to edit copies or to nest a component in itself.
+   :component-id :shape-ref
+   ;; The replay rebuilds bool paths from rounded rects.
+   :r1 :r2 :r3 :r4
+   :stroke-width :bool-type :grids :layout])
+
+(def ^:private stroke-attrs [:stroke-width :stroke-alignment])
+
+(def ^:private position-data-attrs [:x :y :width :height])
+
+;; Selection only asks whether a shape has fills.
+(def ^:private some-fills [{}])
+
+(defn- trim-svg-attrs
+  [svg-attrs]
+  (let [style (get svg-attrs :style)]
+    (cond-> {}
+      (contains? svg-attrs :fill)
+      (assoc :fill (get svg-attrs :fill))
+
+      (contains? style :fill)
+      (assoc :style {:fill (get style :fill)}))))
+
+(defn trim-shape
+  [shape]
+  (let [type      (get shape :type)
+        fills     (get shape :fills)
+        strokes   (get shape :strokes)
+        svg-attrs (some-> (get shape :svg-attrs) trim-svg-attrs not-empty)
+        content   (get shape :content)
+        pos-data  (get shape :position-data)]
+    (cts/map->Shape
+     (cond-> (select-keys shape shape-attrs)
+       (seq fills)
+       (assoc :fills some-fills)
+
+       (seq strokes)
+       (assoc :strokes (mapv #(select-keys % stroke-attrs) strokes))
+
+       (some? svg-attrs)
+       (assoc :svg-attrs svg-attrs)
+
+       (and (some? content) (or (= type :path) (= type :bool)))
+       (assoc :content content)
+
+       (and (some? pos-data) (= type :text))
+       (assoc :position-data (mapv #(select-keys % position-data-attrs) pos-data))))))
+
+(defn trim-objects
+  "Trims every object. An `ObjectsMap` is read from its encoded data, so
+  the decoded shapes are not kept in its cache."
+  [objects]
+  (if (omap/objects-map? objects)
+    (persistent!
+     (reduce-kv (fn [result id data]
+                  (assoc! result id (trim-shape (t/decode-str data))))
+                (transient {})
+                (omap/get-data objects)))
+    (persistent!
+     (reduce-kv (fn [result id shape]
+                  (assoc! result id (trim-shape shape)))
+                (transient {})
+                objects))))
+
+(defn retrim-objects
+  "Trims again the objects at `ids` that differ from `old-objects`: the
+  replay may have written attributes the worker does not keep."
+  [old-objects new-objects ids]
+  (reduce (fn [objects id]
+            (let [shape (get objects id)]
+              (cond-> objects
+                (and (some? shape) (not (identical? shape (get old-objects id))))
+                (assoc id (trim-shape shape)))))
+          new-objects
+          ids))
+
+(defn trim-page
+  [page]
+  (cond-> {:id (get page :id)
+           :objects (trim-objects (get page :objects))}
+    (contains? page :guides)
+    (assoc :guides (get page :guides))))

frontend/test/frontend_tests/runner.cljs

@@ -171,6 +171,7 @@
    [frontend-tests.worker-snap-test]
    [frontend-tests.worker.exports-test]
    [frontend-tests.worker.index-test]
+   [frontend-tests.worker.trim-test]
    [goog.object :as gobj]))
 
 (enable-console-print!)
@@ -207,6 +208,7 @@
    'frontend-tests.data.jobs-test
    'frontend-tests.worker.exports-test
    'frontend-tests.worker.index-test
+   'frontend-tests.worker.trim-test
    'frontend-tests.data.svg-upload-test
    'frontend-tests.data.uploads-test
    'frontend-tests.data.viewer-test

frontend/test/frontend_tests/worker/index_test.cljs

@@ -7,12 +7,14 @@
 (ns frontend-tests.worker.index-test
   (:require
    [app.common.files.builder :as fb]
+   [app.common.files.changes :as ch]
    [app.common.geom.rect :as grc]
    [app.common.types.shape :as cts]
    [app.common.uuid :as uuid]
    [app.worker.impl :as impl]
    [app.worker.index :as idx]
-   [cljs.test :as t :include-macros true]))
+   [cljs.test :as t :include-macros true]
+   [clojure.set :as set]))
 
 (t/use-fixtures :each
   {:before #(reset! idx/state {:pages-index {}})})
@@ -97,3 +99,62 @@
                                          :page-id page-id
                                          :rect (grc/make-rect 190 190 70 70)}))
                      shape-id))))
+
+(defn- get-stored-shape
+  [page-id shape-id]
+  (get-in @idx/state [:pages-index page-id :objects shape-id]))
+
+(t/deftest initialize-stores-a-trimmed-page
+  (let [page     (make-page "Page 1")
+        shape-id (-> page :objects (dissoc uuid/zero) keys first)]
+    (initialize page)
+    (t/is (some? (get-stored-shape (:id page) shape-id)))
+    (t/is (nil? (:name (get-stored-shape (:id page) shape-id))))))
+
+(t/deftest update-stores-trimmed-fills
+  (let [page     (make-page "Page 1")
+        page-id  (:id page)
+        shape-id (-> page :objects (dissoc uuid/zero) keys first)]
+    (initialize page)
+    (update-index page-id [{:type :mod-obj :id shape-id :page-id page-id
+                            :operations [{:type :set :attr :fills
+                                          :val [{:fill-color "#ff0000" :fill-opacity 1}]}]}])
+    (t/is (= [{}] (:fills (get-stored-shape page-id shape-id))))))
+
+(t/deftest update-renaming-a-shape-keeps-the-indexes
+  (let [page     (make-page "Page 1")
+        page-id  (:id page)
+        shape-id (-> page :objects (dissoc uuid/zero) keys first)]
+    (initialize page)
+    (let [before @idx/state]
+      (update-index page-id [{:type :mod-obj :id shape-id :page-id page-id
+                              :operations [{:type :set :attr :name :val "renamed"}]}])
+      (t/is (identical? (::idx/selection before) (::idx/selection @idx/state)))
+      (t/is (identical? (::idx/snap before) (::idx/snap @idx/state))))))
+
+(t/deftest update-skips-changes-the-indexes-do-not-read
+  (let [page     (make-page "Page 1")
+        page-id  (:id page)
+        shape-id (-> page :objects (dissoc uuid/zero) keys first)]
+    (initialize page)
+    (let [before (get-in @idx/state [:pages-index page-id])]
+      (update-index page-id [{:type :set-plugin-data :object-type :shape
+                              :object-id shape-id :page-id page-id
+                              :namespace "ns" :key "k" :value "v"}
+                             {:type :mod-page :id page-id :page-id page-id :name "Renamed"}])
+      (t/is (= before (get-in @idx/state [:pages-index page-id]))))))
+
+(t/deftest every-change-type-is-replayed-or-skipped
+  (let [known (set/union idx/index-change-types idx/skipped-change-types)]
+    (t/is (= #{} (set/difference (set (keys (methods ch/process-change))) known))
+          "Add the new change type to one set; replaying it may need attributes in `app.worker.trim`")
+    (t/is (= #{} (set/intersection idx/index-change-types idx/skipped-change-types)))))
+
+(t/deftest update-skips-unknown-change-types
+  (let [page     (make-page "Page 1")
+        page-id  (:id page)
+        shape-id (-> page :objects (dissoc uuid/zero) keys first)]
+    (initialize page)
+    (let [before (get-in @idx/state [:pages-index page-id])]
+      (update-index page-id [{:type :unknown-change :id shape-id :page-id page-id}])
+      (t/is (= before (get-in @idx/state [:pages-index page-id]))))))

frontend/test/frontend_tests/worker/trim_test.cljs

@@ -0,0 +1,316 @@
+;; 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 frontend-tests.worker.trim-test
+  (:require
+   [app.common.files.changes :as ch]
+   [app.common.geom.point :as gpt]
+   [app.common.geom.rect :as grc]
+   [app.common.geom.shapes :as gsh]
+   [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.objects-map :as omap]
+   [app.common.types.path :as path]
+   [app.common.types.text :as txt]
+   [app.common.uuid :as uuid]
+   [app.worker.selection :as selection]
+   [app.worker.snap :as snap]
+   [app.worker.trim :as trim]
+   [cljs.test :as t :include-macros true]
+   [clojure.set :as set]))
+
+(t/use-fixtures :each thi/test-fixture)
+
+(defn- register-bool
+  "Computes the content of `:bool` from its children."
+  [file]
+  (update file :data ch/process-changes
+          [{:type :reg-objects :page-id (thf/current-page-id file) :shapes [(thi/id :bool)]}]))
+
+(defn- make-file
+  "A component main and copy, a board with a styled group, a text, and a
+  bool of a rounded rect and a path."
+  []
+  (-> (thf/sample-file :file)
+      (tho/add-simple-component-with-copy :component :main-root :main-child :copy-root
+                                          :copy-root-params {:x 200})
+      (tho/add-frame :board :x 400 :y 0 :width 300 :height 300)
+      (tho/add-group :group :parent-label :board)
+      (tho/add-rect :rect :parent-label :group :x 420 :y 20 :width 50 :height 50
+                    :fills (ths/sample-fills-color :fill-color "#ff0000")
+                    :strokes [{:stroke-width 4 :stroke-alignment :outer
+                               :stroke-color "#000000" :stroke-opacity 1}])
+      (tho/add-text :text "Hello")
+      (ths/add-sample-shape :bool :type :bool :bool-type :union
+                            :x 0 :y 400 :width 100 :height 100)
+      (tho/add-rect :rounded :parent-label :bool :x 0 :y 400 :width 60 :height 60
+                    :r1 10 :r2 10 :r3 10 :r4 10)
+      (ths/add-sample-shape :path :parent-label :bool :type :path
+                            :content (path/content [{:command :move-to :params {:x 30 :y 430}}
+                                                    {:command :line-to :params {:x 100 :y 430}}
+                                                    {:command :line-to :params {:x 100 :y 500}}
+                                                    {:command :close-path :params {}}]))
+      (register-bool)))
+
+(defn- get-page-objects
+  [data page-id]
+  (get-in data [:pages-index page-id :objects]))
+
+(defn- replay-full
+  [data page-id changes]
+  (-> (ch/process-changes data changes false)
+      (get-page-objects page-id)
+      (trim/trim-objects)))
+
+(deftype ReadRecorder [inner dropped-keys reads-ref]
+  ;; A trimmed shape that notes each read of an attribute the trim dropped
+  ;; or reduced; writing an attribute makes later reads of it safe.
+  ILookup
+  (-lookup [this k]
+    (-lookup this k nil))
+  (-lookup [_ k not-found]
+    (when (contains? dropped-keys k)
+      (swap! reads-ref conj k))
+    (get inner k not-found))
+
+  IAssociative
+  (-contains-key? [_ k]
+    (when (contains? dropped-keys k)
+      (swap! reads-ref conj k))
+    (contains? inner k))
+  (-assoc [_ k v]
+    (ReadRecorder. (assoc inner k v) (disj dropped-keys k) reads-ref))
+
+  IMap
+  (-dissoc [_ k]
+    (ReadRecorder. (dissoc inner k) (disj dropped-keys k) reads-ref))
+
+  ICollection
+  (-conj [this entry]
+    (if (vector? entry)
+      (-assoc this (nth entry 0) (nth entry 1))
+      (reduce-kv -assoc this entry)))
+
+  IEmptyableCollection
+  (-empty [_]
+    (empty inner))
+
+  ICounted
+  (-count [_]
+    (count inner))
+
+  ISeqable
+  (-seq [_]
+    (seq inner))
+
+  IKVReduce
+  (-kv-reduce [_ f init]
+    (reduce-kv f init inner))
+
+  IMeta
+  (-meta [_]
+    (meta inner))
+
+  IWithMeta
+  (-with-meta [_ m]
+    (ReadRecorder. (with-meta inner m) dropped-keys reads-ref))
+
+  IEquiv
+  (-equiv [_ other]
+    (= inner (if (instance? ReadRecorder other) (.-inner ^js other) other)))
+
+  IHash
+  (-hash [_]
+    (hash inner))
+
+  IFn
+  (-invoke [this k]
+    (-lookup this k nil))
+  (-invoke [this k not-found]
+    (-lookup this k not-found)))
+
+(defn- record-reads
+  "Wraps each trimmed shape so reads of attributes that differ from the
+  full shape are noted in `reads-ref`."
+  [trimmed-objects full-objects reads-ref]
+  (reduce-kv (fn [objects id shape]
+               (let [full    (get full-objects id)
+                     dropped (into #{}
+                                   (filter #(and (some? (get full %))
+                                                 (not= (get full %) (get shape %))))
+                                   (keys full))]
+                 (assoc objects id (ReadRecorder. shape dropped reads-ref))))
+             {}
+             trimmed-objects))
+
+(defn- unwrap-objects
+  [objects]
+  (update-vals objects #(if (instance? ReadRecorder %) (.-inner ^js %) %)))
+
+(defn- replay-trimmed
+  "What the worker does: replay on the trimmed page, then trim the
+  candidate objects again. Reads of trimmed attributes go to `reads-ref`."
+  [data page-id changes reads-ref]
+  (let [page        (get-in data [:pages-index page-id])
+        trimmed     (trim/trim-page page)
+        old-objects (:objects trimmed)
+        recorded    (assoc trimmed :objects (record-reads old-objects (:objects page) reads-ref))
+        new-objects (-> (ch/process-changes {:pages-index {page-id recorded}} changes false)
+                        (get-page-objects page-id)
+                        (unwrap-objects))
+        ids         (ch/get-candidate-object-ids old-objects new-objects page-id changes)]
+    (trim/retrim-objects old-objects new-objects ids)))
+
+(defn- set-attrs-change
+  [page-id id attrs]
+  {:type :mod-obj :id id :page-id page-id
+   :operations (mapv (fn [[attr val]] {:type :set :attr attr :val val}) attrs)})
+
+(defn- move-change
+  [data page-id id delta]
+  (let [shape (get (get-page-objects data page-id) id)]
+    (set-attrs-change page-id id (-> (gsh/move shape delta)
+                                     (select-keys [:x :y :selrect :points])))))
+
+(defn- get-scenarios
+  [data page-id]
+  (let [objects    (get-page-objects data page-id)
+        copy-child (-> objects (get (thi/id :copy-root)) :shapes first)
+        text       (get objects (thi/id :text))]
+    {"add a shape into a board"
+     [{:type :add-obj :id (uuid/next) :page-id page-id
+       :parent-id (thi/id :board) :frame-id (thi/id :board)
+       :obj (ths/sample-shape nil :type :rect :name "new" :x 450 :y 50 :width 10 :height 10
+                              :frame-id (thi/id :board) :parent-id (thi/id :board))}]
+
+     "rename and recolor a shape"
+     [(set-attrs-change page-id (thi/id :rect)
+                        {:name "renamed"
+                         :fills (ths/sample-fills-color :fill-color "#00ff00")})]
+
+     "edit a copied child (touched)"
+     [(set-attrs-change page-id copy-child
+                        {:fills (ths/sample-fills-color :fill-color "#00ff00")})]
+
+     "change a text"
+     [(set-attrs-change page-id (thi/id :text)
+                        {:content (txt/change-text (:content text) "Bye")})]
+
+     "delete a group"
+     [{:type :del-obj :id (thi/id :group) :page-id page-id}]
+
+     "move a group into another board"
+     [{:type :mov-objects :page-id page-id
+       :parent-id (thi/id :main-root) :shapes [(thi/id :group)]}]
+
+     "move a shape into a copy (refused)"
+     [{:type :mov-objects :page-id page-id
+       :parent-id (thi/id :copy-root) :shapes [(thi/id :text)]}]
+
+     "move a child out of a copy (refused)"
+     [{:type :mov-objects :page-id page-id
+       :parent-id uuid/zero :shapes [copy-child]}]
+
+     "move a copy into its main (nesting loop, refused)"
+     [{:type :mov-objects :page-id page-id
+       :parent-id (thi/id :main-root) :shapes [(thi/id :copy-root)]}]
+
+     "reorder the children of a copy (refused)"
+     [{:type :reorder-children :page-id page-id
+       :parent-id (thi/id :copy-root) :shapes (reverse (get-in objects [(thi/id :copy-root) :shapes]))}]
+
+     "move a rect inside a group, then register the group"
+     [(move-change data page-id (thi/id :rect) (gpt/point 30 0))
+      {:type :reg-objects :page-id page-id :shapes [(thi/id :rect)]}]
+
+     "move a rounded rect inside a bool, then register the bool"
+     [(move-change data page-id (thi/id :rounded) (gpt/point 0 -40))
+      {:type :reg-objects :page-id page-id :shapes [(thi/id :rounded)]}]
+
+     "fix the children of a board"
+     [{:type :fix-obj :id (thi/id :board) :page-id page-id}]}))
+
+(t/deftest replay-on-trimmed-page-matches-full-replay
+  (let [file    (make-file)
+        data    (:data file)
+        page-id (thf/current-page-id file)]
+    (doseq [[label changes] (get-scenarios data page-id)]
+      (t/testing label
+        (t/is (= (replay-full data page-id changes)
+                 (replay-trimmed data page-id changes (atom #{}))))))))
+
+;; The touched pass looks for the component root, which only edits the
+;; file's components; the worker has none.
+(def ^:private touched-pass-reads #{:component-root :main-instance})
+
+(defn- get-set-attrs
+  "Attributes the `:mod-obj` changes set; `set-shape-attr` reads their old
+  value only to update `:touched`, which the trim drops."
+  [changes]
+  (into #{}
+        (comp (filter #(= :mod-obj (:type %)))
+              (mapcat :operations)
+              (keep :attr))
+        changes))
+
+(t/deftest replay-on-trimmed-page-reads-only-kept-attributes
+  (let [file    (make-file)
+        data    (:data file)
+        page-id (thf/current-page-id file)]
+    (doseq [[label changes] (get-scenarios data page-id)]
+      (t/testing label
+        (let [reads (atom #{})]
+          (replay-trimmed data page-id changes reads)
+          (t/is (= #{} (set/difference @reads touched-pass-reads (get-set-attrs changes)))))))))
+
+(t/deftest trim-keeps-only-what-the-worker-reads
+  (let [file    (make-file)
+        page    (thf/current-page file)
+        objects (trim/trim-objects (:objects page))]
+    (t/testing "fills only tell whether there are any"
+      (t/is (= [{}] (get-in objects [(thi/id :rect) :fills]))))
+    (t/testing "strokes keep width and alignment"
+      (t/is (= [{:stroke-width 4 :stroke-alignment :outer}]
+               (get-in objects [(thi/id :rect) :strokes]))))
+    (t/testing "names and text content are dropped"
+      (t/is (nil? (get-in objects [(thi/id :rect) :name])))
+      (t/is (nil? (get-in objects [(thi/id :text) :content]))))
+    (t/testing "path content is kept"
+      (t/is (some? (get-in objects [(thi/id :path) :content]))))))
+
+(t/deftest trim-reads-objects-maps
+  (let [file    (make-file)
+        objects (:objects (thf/current-page file))]
+    (t/is (= (trim/trim-objects objects)
+             (trim/trim-objects (omap/wrap objects))))))
+
+(t/deftest indexes-answer-the-same-on-a-trimmed-page
+  (let [file    (make-file)
+        page    (thf/current-page file)
+        page-id (:id page)
+        full    {:selection (selection/add-page {} page)
+                 :snap      (snap/add-page {} page)}
+        trimmed (let [page (trim/trim-page page)]
+                  {:selection (selection/add-page {} page)
+                   :snap      (snap/add-page {} page)})
+        rects   [(grc/make-rect 0 0 1000 1000)
+                 (grc/make-rect 440 40 1 1)
+                 (grc/make-rect 420 20 1 1)
+                 (grc/make-rect 90 420 1 1)
+                 (grc/make-rect 10 480 1 1)]]
+    (doseq [rect rects
+            opts [{} {:full-frame? true} {:include-frames? true :using-selrect? true}]]
+      (t/testing (str "selection " rect " " opts)
+        (let [query (merge {:page-id page-id :rect rect} opts)]
+          (t/is (= (selection/query (:selection full) query)
+                   (selection/query (:selection trimmed) query))))))
+    (doseq [frame-id [uuid/zero (thi/id :board)]
+            axis     [:x :y]]
+      (t/testing (str "snap " frame-id " " axis)
+        (t/is (= (snap/query (:snap full) page-id frame-id axis [0 1000])
+                 (snap/query (:snap trimmed) page-id frame-id axis [0 1000])))))))

frontend/test/frontend_tests/worker_snap_test.cljs

@@ -11,10 +11,16 @@
    [app.common.uuid :as uuid]
    [app.worker.snap :as snap]
    [cljs.pprint :refer [pprint]]
-   [cljs.test :as t :include-macros true]))
+   [cljs.test :as t :include-macros true]
+   [clojure.set :as set]))
 
 (def uuid-counter 1)
 
+(defn- get-object-ids
+  [old-page new-page]
+  (set/union (set (keys (:objects old-page)))
+             (set (keys (:objects new-page)))))
+
 (defn get-mocked-uuid
   []
   (let [counter (atom 0)]
@@ -207,7 +213,7 @@
                         (fb/delete-shape shape-id))
 
           new-page (fb/get-current-page state)
-          data     (snap/update-page data page new-page)
+          data     (snap/update-page data page new-page (get-object-ids page new-page))
 
           result-x (snap/query data (:id page) uuid/zero :x [0 100])
           result-y (snap/query data (:id page) uuid/zero :y [0 100])]
@@ -237,7 +243,7 @@
           state (fb/delete-shape state shape-id)
 
           new-page (fb/get-current-page state)
-          data (snap/update-page data page new-page)
+          data (snap/update-page data page new-page (get-object-ids page new-page))
 
           result-x (snap/query data (:id page) uuid/zero :x [0 100])
           result-y (snap/query data (:id page) uuid/zero :y [0 100])]
@@ -269,7 +275,7 @@
           state    (fb/delete-shape state shape-id)
           new-page (fb/get-current-page state)
 
-          data     (snap/update-page data page new-page)
+          data     (snap/update-page data page new-page (get-object-ids page new-page))
 
           result-zero-x  (snap/query data (:id page) uuid/zero :x [0 100])
           result-frame-x (snap/query data (:id page) frame-id :x [0 100])]
@@ -297,7 +303,7 @@
           new-page (-> (fb/delete-guide state guide-id)
                        (fb/get-current-page))
 
-          data     (snap/update-page data page new-page)
+          data     (snap/update-page data page new-page (get-object-ids page new-page))
 
           result-zero-x  (snap/query data (:id page) uuid/zero :x [0 100])
           result-zero-y  (snap/query data (:id page) uuid/zero :y [0 100])
@@ -330,7 +336,7 @@
           new-page (-> (fb/delete-guide file guide-id)
                        (fb/get-current-page))
 
-          data (snap/update-page data page new-page)
+          data (snap/update-page data page new-page (get-object-ids page new-page))
 
           result-zero-x (snap/query data (:id page) uuid/zero :x [0 100])
           result-zero-y (snap/query data (:id page) uuid/zero :y [0 100])
@@ -370,7 +376,7 @@
 
 
           new-page (fb/get-current-page state)
-          data     (snap/update-page data page new-page)
+          data     (snap/update-page data page new-page (get-object-ids page new-page))
 
           result-zero-x-1 (snap/query data (:id page) uuid/zero :x [0 100])
           result-frame-x-1 (snap/query data (:id page) frame-id :x [0 100])
@@ -408,7 +414,7 @@
 
           new-page (fb/get-current-page state)
           ;; FIXME: update
-          data     (snap/update-page data page new-page)
+          data     (snap/update-page data page new-page (get-object-ids page new-page))
 
           result-zero-x-1 (snap/query data (:id page) uuid/zero :x [0 100])
           result-zero-x-2 (snap/query data (:id page) uuid/zero :x [200 300])]
@@ -437,7 +443,7 @@
           new-page (-> (fb/update-guide state (assoc guide :position 150))
                        (fb/get-current-page))
 
-          data     (snap/update-page data page new-page)
+          data     (snap/update-page data page new-page (get-object-ids page new-page))
 
           result-zero-x-1 (snap/query data (:id page) uuid/zero :x [0 100])
           result-zero-y-1 (snap/query data (:id page) uuid/zero :y [0 100])