✨ Add a scanner of copies that differ from their mains

A copy keeps a value of its own only in a touched group, so a value
that differs from its main's in an untouched group is lost
propagation. app.common.logic.override-scan runs the sync of every
component a file uses in memory and lists the copy shapes it would
change, with the attributes and groups, or :structure for children
that differ. The size of a text that grows with its content and the
place of a layout child are left out: they are not the main's to
give. Copies of components a predicate names are skipped.

debug.scan_overrides() lists them for the current file in the browser
console, skipping copies of library components changed since the file
last synced with the library.

override-scan-test: a synced copy and an override give nothing; an
untouched difference, in a local or a library copy, is found; a
skipped component is not scanned.

AI-assisted-by: claude-opus-5-5
This commit is contained in:
alonso.torres 2026-10-15 15:11:36 +02:00
parent 5da4793d2a
commit 69bf2da97f
4 changed files with 195 additions and 0 deletions

View File

@ -0,0 +1,106 @@
;; 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.logic.override-scan
"Finds the copy shapes that differ from their mains without an override.
A copy keeps a value of its own only in a touched group, so a value that
differs in an untouched group is lost propagation: a sync would change
it. The scan runs that sync in memory and reports what it would write.
For debugging real files (`mem:common/component-sync-contract`)."
(:require
[app.common.files.changes-builder :as pcb]
[app.common.files.helpers :as cfh]
[app.common.logic.libraries :as cll]
[app.common.types.component :as ctk]
[app.common.types.components-list :as ctkl]
[app.common.types.shape.layout :as ctl]))
(defn- derived-geometry?
"Whether the geometry of `shape` is not the main's to give: the size of a
text that grows with its content, or the place of a layout child."
[objects shape]
(or (and (cfh/text-shape? shape)
(not= :fixed (:grow-type shape)))
(and (ctl/any-layout-immediate-child? objects shape)
(not (ctl/position-absolute? shape)))))
(defn- change-findings
"The findings of a change of a sync of the file `data`: for a change of
attributes, the shape with the attributes and groups it writes; for a
change of the shape tree, the shape with `:structure`."
[data {:keys [type page-id id operations parent-id]}]
(let [objects (get-in data [:pages-index page-id :objects])]
(case type
:mod-obj
(let [shape (get objects id)
attrs (into #{}
(comp (filter #(= :set (:type %)))
(map :attr)
(remove #{:position-data})
(filter #(some? (ctk/resolve-sync-group (:type shape) %)))
(remove #(and (= :geometry-group (ctk/resolve-sync-group (:type shape) %))
(derived-geometry? objects shape))))
operations)]
(when (seq attrs)
[{:page-id page-id
:id id
:name (:name shape)
:attrs attrs
:groups (into #{} (map #(ctk/resolve-sync-group (:type shape) %)) attrs)}]))
(:add-obj :mov-objects)
(let [parent (get objects parent-id)]
[{:page-id page-id :id parent-id :name (:name parent) :groups #{:structure}}])
:del-obj
(let [shape (get objects id)]
[{:page-id page-id :id (:parent-id shape) :name (:name (get objects (:parent-id shape)))
:groups #{:structure}}])
nil)))
(defn- merge-findings
[findings]
(->> findings
(group-by (juxt :page-id :id))
(map (fn [[_ items]]
(reduce (fn [a b]
(-> a
(update :attrs into (:attrs b))
(update :groups into (:groups b))))
(update (first items) :attrs set)
(rest items))))
(map #(cond-> % (empty? (:attrs %)) (dissoc :attrs)))))
(defn scan
"The copy shapes of the pages of `file` that differ from their mains
without an override, as `{:page-id :id :name :groups :attrs}`, one per
shape; `:structure` among the groups means children that differ.
`libraries` are the other files by id. `skip-component?`, given a
library and a component, leaves out the copies of that component (those
of a library update not taken yet may differ)."
[file libraries & {:keys [skip-component?] :or {skip-component? (constantly false)}}]
(let [file-id (:id file)
libraries (assoc libraries file-id file)
data (:data file)]
(->> (vals libraries)
(mapcat (fn [library]
(->> (ctkl/components-seq (:data library))
(remove #(skip-component? library %))
(map #(vector library %)))))
(mapcat (fn [[library component]]
(:redo-changes
(cll/generate-sync-file-changes (pcb/empty-changes)
nil
:components
file-id
(:id component)
(:id library)
libraries
file-id))))
(filter :page-id)
(mapcat #(change-findings data %))
(merge-findings))))

View File

@ -0,0 +1,64 @@
;; 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.logic.override-scan-test
(:require
[app.common.logic.override-scan :as clos]
[app.common.test-helpers.components :as thc]
[app.common.test-helpers.compositions :as tho]
[app.common.test-helpers.files :as thf]
[app.common.test-helpers.ids-map :as thi]
[app.common.test-helpers.shapes :as ths]
[clojure.test :as t]))
(t/use-fixtures :each thi/test-fixture)
(defn- file-with-copy
[]
(-> (thf/sample-file :file1)
(tho/add-simple-component-with-copy :component1 :main-root :main-child :copy-root
:copy-root-params {:children-labels [:copy-child]})))
(defn- red-fills
[]
(ths/sample-fills-color :fill-color "#ff0000"))
(t/deftest a-synced-copy-differs-in-nothing
(t/is (empty? (clos/scan (file-with-copy) {}))))
(t/deftest an-untouched-difference-is-found
(let [file (-> (file-with-copy)
(ths/update-shape :copy-child :fills (red-fills))
(ths/update-shape :copy-child :touched nil))
findings (clos/scan file {})]
(t/is (= [{:id (thi/id :copy-child)
:groups #{:fill-group}
:attrs #{:fills}}]
(map #(select-keys % [:id :groups :attrs]) findings)))))
(t/deftest an-override-is-not-a-difference
(let [file (-> (file-with-copy)
(ths/update-shape :copy-child :fills (red-fills)))]
(t/is (= #{:fill-group} (:touched (ths/get-shape file :copy-child))))
(t/is (empty? (clos/scan file {})))))
(t/deftest a-skipped-component-is-not-scanned
(let [file (-> (file-with-copy)
(ths/update-shape :copy-child :fills (red-fills))
(ths/update-shape :copy-child :touched nil))]
(t/is (empty? (clos/scan file {} :skip-component? (constantly true))))))
(t/deftest a-copy-of-a-library-component-is-scanned
(let [library (-> (thf/sample-file :library :is-shared true)
(tho/add-simple-component :component1 :main-root :main-child))
file (-> (thf/sample-file :file1)
(thc/instantiate-component :component1 :copy-root
:library library
:children-labels [:copy-child])
(ths/update-shape :copy-child :fills (red-fills))
(ths/update-shape :copy-child :touched nil))]
(t/is (= [(thi/id :copy-child)]
(map :id (clos/scan file {(:id library) library}))))))

View File

@ -74,6 +74,7 @@
[common-tests.logic.library-asset-sync-test]
[common-tests.logic.move-shapes-test]
[common-tests.logic.multiple-nesting-levels-test]
[common-tests.logic.override-scan-test]
[common-tests.logic.placement-test]
[common-tests.logic.swap-and-reset-test]
[common-tests.logic.swap-as-override-test]
@ -194,6 +195,7 @@
'common-tests.logic.library-asset-sync-test
'common-tests.logic.move-shapes-test
'common-tests.logic.multiple-nesting-levels-test
'common-tests.logic.override-scan-test
'common-tests.logic.placement-test
'common-tests.logic.swap-and-reset-test
'common-tests.logic.swap-as-override-test

View File

@ -14,6 +14,7 @@
[app.common.files.validate :as cfv]
[app.common.json :as json]
[app.common.logging :as l]
[app.common.logic.override-scan :as clos]
[app.common.pprint :as pp]
[app.common.render-wasm.helpers :as wasm.h]
[app.common.render-wasm.mem :as wasm.mem]
@ -553,6 +554,28 @@
(catch :default cause
(ex/print-throwable cause))))))
(defn ^:export scan-overrides
"List the copy shapes of the current file that differ from their mains
without an override (`app.common.logic.override-scan`). Copies of
library components changed since the file last synced are skipped."
[]
(let [state @st/state
file (dsh/lookup-file state)
libraries (dissoc (get state :files) (:id file))
outdated? (fn [library component]
(and (not= (:id library) (:id file))
(> (:modified-at component) (:synced-at library))))]
(try
(let [findings (clos/scan file libraries :skip-component? outdated?)]
(js/console.table
(clj->js (map #(-> %
(update :groups (comp vec sort))
(update :attrs (comp vec sort)))
findings)))
(count findings))
(catch :default cause
(ex/print-throwable cause)))))
(defn ^:export validate-schema
[]
(try