diff --git a/common/src/app/common/logic/override_scan.cljc b/common/src/app/common/logic/override_scan.cljc new file mode 100644 index 0000000000..b3a1db8731 --- /dev/null +++ b/common/src/app/common/logic/override_scan.cljc @@ -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)))) diff --git a/common/test/common_tests/logic/override_scan_test.cljc b/common/test/common_tests/logic/override_scan_test.cljc new file mode 100644 index 0000000000..aa586ea3c6 --- /dev/null +++ b/common/test/common_tests/logic/override_scan_test.cljc @@ -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})))))) diff --git a/common/test/common_tests/runner.cljc b/common/test/common_tests/runner.cljc index 745fa4ed97..4a5850a11c 100644 --- a/common/test/common_tests/runner.cljc +++ b/common/test/common_tests/runner.cljc @@ -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 diff --git a/frontend/src/debug.cljs b/frontend/src/debug.cljs index 7d71812c19..0d614c6c9c 100644 --- a/frontend/src/debug.cljs +++ b/frontend/src/debug.cljs @@ -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