From 0fe4a430090dd80104fb72de97205cd30848355c Mon Sep 17 00:00:00 2001 From: "alonso.torres" Date: Sat, 10 Oct 2026 12:49:36 +0200 Subject: [PATCH] :sparkles: Test variant events, token sync and switch overrides The variant events had almost no frontend tests, and several switch, paste, token and restore paths never ran. - Variant property edits (AR) and adding a variant (AS), in both runners, through the common generators and the dwv events. - A frontend-only node for the variant management events: transform (AT), combine (AU), rename (AV), rename in layers, removal of empty properties and member errors (AW), and the shortcuts (AX). Each case has copies of the members; direct tests cover the remaining branches. AV and AT confirm F6: the copies' name sync lands in an undo entry of its own (pinned). - Tests for valid-components-for-variants? and valid-variant-switch?. - The WASM variant switch test is registered in the runner; it never ran. - Token apply and remove nodes and case AY. Its undo confirms F55, an empty :applied-tokens map after undo (pinned). The interpreter waits for the token, since apply-token opens no pending work (F54). - A paste-to-root node and case AZ: F17 does not show through paste. The frontend copy helper merges touched groups as the clipboard does. - Switches that carry real geometry, path and text-structure overrides, resized through a transform. - Restoring a component whose page was deleted. --- .../frontend/composable-component-tests.md | 25 +- .../test_helpers/composable/comp/cases.cljc | 491 ++++++++++++++++++ .../test_helpers/composable/comp/nodes.cljc | 489 ++++++++++++++++- .../logic/comp_creation_test.cljc | 54 ++ .../logic/composable_sync_test.cljc | 12 + .../logic/variants_switch_test.cljc | 129 +++++ .../composable_tests/comp/sync_test.cljs | 27 + .../composable_tests/interpreter.cljs | 155 +++++- .../data/workspace_variants_test.cljs | 207 ++++++++ frontend/test/frontend_tests/runner.cljs | 4 + 10 files changed, 1571 insertions(+), 22 deletions(-) create mode 100644 frontend/test/frontend_tests/data/workspace_variants_test.cljs diff --git a/.serena/memories/frontend/composable-component-tests.md b/.serena/memories/frontend/composable-component-tests.md index ded2b6ac1d..5b891d4448 100644 --- a/.serena/memories/frontend/composable-component-tests.md +++ b/.serena/memories/frontend/composable-component-tests.md @@ -162,13 +162,36 @@ Two pure runners (no store, JVM + CLJS): - General target-based nodes: `n/swap-shape target to` (`to` a lineage name or a component label), `n/move-to-cell board child row column`, `n/reset target` (`dwl/reset-component` in the interpreter). `n/swap-component name level to` is `swap-shape` on `n/nested-head-of`. `n/nested-head-in name` (and the general `n/nested-head-under parent-target`) finds a copy's nested head through its parent, so it survives swaps and switches (they keep the head id anyway). Careful: `n/lineage-component-id` is the OUTER component after nesting. +- Variant properties: `n/add-variant-property`, `remove-`, `rename-`, `reorder-variant-properties` + and `set-variant-property-value` are one node (`EditVariantProperty`); `n/variant-property-call` + resolves the edit to the arguments both the `clvp/generate-*` generator and the `dwv/*` event take. + A member is named by the value it was built with; read its current state from the file + (`n/member-properties`, `n/member-component`, `n/member-root`). `n/switch-variant` takes `:pos` + (a number or a `(situation -> pos)` fn) for sets with several properties. + `n/add-variant set member` duplicates a member (`clv/generate-add-new-variant`; `dwv/add-new-variant`, + whose delayed DOM focus `check` neutralises by stubbing `dom/get-element`); ask the node for the + new component (`n/added-variant-component-id`). + Frontend-only variant actions are one node, `n/VariantAction` (`n/transform-in-variant`, + `combine-as-variants`, `rename-variant`, `rename-variant-in-layers`, `remove-empty-properties`, + `set-variant-error`, `variant-shortcut`); the interpreter's `variant-action-events` sends them. + A set they build has no `variant-set` record: read it with `n/component-of` and + `n/variant-component-ids`; `switch-variant` takes the value as a fn for it. +- Tokens: `n/add-tokens` (assembly: an active set of border radius tokens), `n/apply-token`, + `n/unapply-token`, check `n/has-token?`. The interpreter sends `dwta/apply-token`, which resolves + tokens asynchronously and opens no pending work (F54), so `await-step` takes a `ready?` predicate + (`op-ready`: the token shows on the shape) that must hold before it awaits the pending work. +- `n/paste-to-root target`: the clipboard's copy (shape-refs of nested heads advanced, the skipped ref + chain's touched merged) and paste at the root; the interpreter pastes `thp/simulate-copy-shape`'s data. + That helper mirrors `copy-selected`'s advance; keep them in step. A duplicate inside a copy is + refused by `ctk/allow-duplicate?`, and an alt-duplication with no move makes the next edit join + its undo group (it expects the drag's move), so neither models a move out of a main. - `n/undo-before-sync` (frontend-only) emits an edit and `dwu/undo` in one step, so the undo commits while the watcher still holds the edit's sync. - Label map gotcha: running a second variant re-registers labels, so assert on a situation before running the next one (`thi/id` then points at the new run's shapes). Case letters B..Z, then AA..; the sweeps (K: depth × edit-precedence; L: swaps; M: variant switches; N: rotated-instance geometry, on the #10109 fix branch until merged; O: switch of an overridden copy, mains -agreeing or not; Q: detach at depth 0..2, nested copies stay linked; R: update-main at depth 0..2 with two copies; S: delete/restore with a copy on another page; T: duplicate a copy at depth 0..2; U: move a copy into a main with a copy; V: new edit after undo empties redo; W: `(n/undo 3)` over nested cascades; X: undo before the edit's sync, frontend only; AJ: F43, one undo after a nested sync reverts only the reflow, frontend only; Y: text override × main text change, per subgroup; Z: main child move, frontend only; AA..AE: swap outcomes asserted on values, not slot storage, so they survive the Phase 2b swap model; AF: grid cell move vs a swapped copy child, setup `grid-component-with-copy`; AG/AH/AI: ports of the plugin's slot-alignment cases, setup `component-with-sibling-instances`, check `setup/misaligned-sub-heads`; AK: update main into a grid main, F49 pinned; AL: update main renames the component (`change-property` takes `:name`); AM: update main of a swap inside a group, setup `grouped-component-with-copy`, F16 pinned; AN: flex child margin override through main edit, reset and update main, setup `flex-component-with-copy`; `change-property` takes `:margin`, which the interpreter sends as `dwsl/update-layout-child`; AO: a copy dropped into a grid cell of a main (`nest-copy` with `:cell`, sent as `dwt/move-shapes-to-frame`), F41 pinned; AP: a library main's middle child removal reaches a copy in another file (in one file, deleting a main child deletes the copies' children itself, so sync never meets the copy child), setup `cross-file-component-with-many-children`; AQ: main change reaches a copy nested in a sub-board, setup `component-nested-in-a-sub-board`) are the flagship pattern — read them before +agreeing or not; Q: detach at depth 0..2, nested copies stay linked; R: update-main at depth 0..2 with two copies; S: delete/restore with a copy on another page; T: duplicate a copy at depth 0..2; U: move a copy into a main with a copy; V: new edit after undo empties redo; W: `(n/undo 3)` over nested cascades; X: undo before the edit's sync, frontend only; AJ: F43, one undo after a nested sync reverts only the reflow, frontend only; Y: text override × main text change, per subgroup; Z: main child move, frontend only; AA..AE: swap outcomes asserted on values, not slot storage, so they survive the Phase 2b swap model; AF: grid cell move vs a swapped copy child, setup `grid-component-with-copy`; AG/AH/AI: ports of the plugin's slot-alignment cases, setup `component-with-sibling-instances`, check `setup/misaligned-sub-heads`; AK: update main into a grid main, F49 pinned; AL: update main renames the component (`change-property` takes `:name`); AM: update main of a swap inside a group, setup `grouped-component-with-copy`, F16 pinned; AN: flex child margin override through main edit, reset and update main, setup `flex-component-with-copy`; `change-property` takes `:margin`, which the interpreter sends as `dwsl/update-layout-child`; AO: a copy dropped into a grid cell of a main (`nest-copy` with `:cell`, sent as `dwt/move-shapes-to-frame`), F41 pinned; AP: a library main's middle child removal reaches a copy in another file (in one file, deleting a main child deletes the copies' children itself, so sync never meets the copy child), setup `cross-file-component-with-many-children`; AQ: main change reaches a copy nested in a sub-board, setup `component-nested-in-a-sub-board`; AR: variant property edits keep a member's copies as they are, then a switch finds its member by the edited properties; AS: an added variant joins the set and is a switch target; AT..AX, frontend only: transform into a variant, combine, rename a variant (F6 pinned: the transaction keeps the container commit's undo group, the copies' sync takes the main renames'), rename in layers + remove empty properties + member error, the shortcuts that add members; AY: a border radius token on a main reaches untouched copies and its removal too, F55 pinned; AZ: a nested copy pasted out of its main keeps the main's overrides) are the flagship pattern — read them before writing a new sweep. **Scenario lineage model** (behind the sweeps): scenario ops track named component lineages as diff --git a/common/src/app/common/test_helpers/composable/comp/cases.cljc b/common/src/app/common/test_helpers/composable/comp/cases.cljc index 61a109afcc..0996ffa311 100644 --- a/common/src/app/common/test_helpers/composable/comp/cases.cljc +++ b/common/src/app/common/test_helpers/composable/comp/cases.cljc @@ -55,6 +55,18 @@ AO — a copy dropped into a grid cell of a main reaches the main's copies. AP — a library main's middle child removal reaches a copy in another file. AQ — a main change reaches a copy nested in a sub-board of the outer main. + AR — variant property edits keep the copies of a member as they are; a + switch then finds its member by the edited properties. + AS — an added variant joins the set and is a switch target for copies. + AT..AX — variant management, frontend only: transform a component into a + variant (AT), combine components (AU), rename a variant (AV, F6), + rename a member in the layers panel and remove empty properties + (AW), the shortcuts that add members (AX). Copies of the members + keep their link and overrides. + AY — a border radius token on a main reaches untouched copies, and its + removal too; a copy's own token survives. + AZ — a nested copy pasted out of its main keeps the overrides the main + gave it (F17). N — main edits reach rotated copies (frontend only). Rotation — a touched copy child survives a main rotation (frontend only too)." (:require @@ -72,6 +84,7 @@ [app.common.types.components-list :as ctkl] [app.common.types.shape-tree :as ctst] [app.common.types.shape.layout :as ctl] + [app.common.uuid :as uuid] [clojure.test :as t])) (def ^:private red "#ff0000") @@ -1098,6 +1111,484 @@ (t/is (n/has-property-of change in-copy)) (t/is (empty? (:touched in-copy)))))))})) +;; --------------------------------------------------------------------------- +;; Variant management +;; +;; The design tab's edits of a variant set, with copies of its members +;; present. A variant's properties live in its components and in its mains' +;; `:variant-name`; copies hold neither, so an edit must leave them as they +;; are, while a later switch finds its member by the edited properties. +;; --------------------------------------------------------------------------- + +(defn- head-rect + "The rect inside the copy head bound to target fn `head`." + [s head] + (let [objects (:objects (thf/current-page (tm/file s)))] + (->> (cfh/get-children-ids objects (head s)) + (map #(get objects %)) + (d/seek #(= :rect (:type %)))))) + +(defn variant-property-edits-keep-copies + "Case AR. A copy nests member a of a variant set (a, b; their rects differ) + and overrides the fill of the variant's rect. The set gets a second + property, then one edit: rename the first property, set member a's value, + move the new property first, or remove it. The members' properties and + their mains' variant names follow the edit; the copy stays an instance of + member a with its override, touched only there. Then the copy switches to + member b by the first property, at its position after the edit: it becomes + an instance of b and, the mains differing on the fill, takes b's fill + untouched (decision a)." + [] + (let [m "main" + vset "vset" + nested (n/nested-head-in m) + rename (n/rename-variant-property vset 0 "Color") + set-value (n/set-variant-property-value vset "a" 0 "a2") + reorder (n/reorder-variant-properties vset 1 0) + remove (n/remove-variant-property vset 1) + ;; member a's properties and variant name after each edit + expected (fn [s] + (cond + (tm/applied? s rename) [[["Color" "a"] ["Size" "S"]] "a, S"] + (tm/applied? s set-value) [[["Property 1" "a2"] ["Size" "S"]] "a2, S"] + (tm/applied? s reorder) [[["Size" "S"] ["Property 1" "a"]] "S, a"] + (tm/applied? s remove) [[["Property 1" "a"]] "a"]))] + {:setup setup/empty-situation + :operation (tm/in-sequence + [(n/create-component m base-color :size 100) + (n/make-variant-container vset [["a" base-color] ["b" red]] :size 100) + (n/make-nested-component-with-variant m vset "a") + (n/instantiate-copy m) + (n/change-property #(:id (head-rect % nested)) :fills green) + (n/add-variant-property vset :name "Size" :value "S") + (tm/one-of [rename set-value reorder remove]) + (tm/test-that + (fn [s] + (let [[props variant-name] (expected s) + rect (head-rect s nested)] + (t/is (= props (n/member-properties s vset "a"))) + (t/is (= variant-name (:variant-name (n/member-root s vset "a")))) + (t/is (= (n/variant-member-component-id s vset "a") (head-component s nested))) + (t/is (= green (fill-color rect))) + (t/is (= #{:fill-group} (:touched rect))) + (t/is (empty? (:touched (tm/shape-by-id s (nested s)))))))) + (n/switch-variant nested "b" :pos #(if (tm/applied? % reorder) 1 0))]) + :asserter (fn [s] + (let [rect (head-rect s nested)] + (t/is (= (n/variant-member-component-id s vset "b") (head-component s nested))) + (t/is (= red (fill-color rect))) + (t/is (not (contains? (:touched rect) :fill-group)))))})) + +(defn added-variant-is-a-switch-target + "Case AS. A copy nests member a of a variant set (a, b; their rects differ) + and overrides the fill of the variant's rect. A member is added, a + duplicate of a or of b: it joins the set with the next value, its main in + the set's container, and the copy stays as it was. Then the copy switches + to the new member and becomes an instance of it. A duplicate of a agrees + with a on the fill, so the override is carried, touched; a duplicate of b + does not, so the rect takes b's fill untouched (decision a)." + [] + (let [m "main" + vset "vset" + nested (n/nested-head-in m) + from-a (n/add-variant vset "a") + from-b (n/add-variant vset "b") + added (fn [s] (n/added-variant-component-id s (if (tm/applied? s from-a) from-a from-b)))] + {:setup setup/empty-situation + :operation (tm/in-sequence + [(n/create-component m base-color :size 100) + (n/make-variant-container vset [["a" base-color] ["b" red]] :size 100) + (n/make-nested-component-with-variant m vset "a") + (n/instantiate-copy m) + (n/change-property #(:id (head-rect % nested)) :fills green) + (tm/one-of [from-a from-b]) + (tm/test-that + (fn [s] + (let [component (ctkl/get-component (:data (tm/file s)) (added s)) + main (tm/shape-by-id s (:main-instance-id component)) + rect (head-rect s nested)] + (t/is (= [["Property 1" "Value 3"]] (n/component-properties s (added s)))) + (t/is (= (n/variant-set-id s vset) (:variant-id component))) + (t/is (= (n/variant-set-id s vset) (:parent-id main))) + (t/is (= (n/variant-member-component-id s vset "a") (head-component s nested))) + (t/is (= green (fill-color rect))) + (t/is (= #{:fill-group} (:touched rect)))))) + (n/switch-variant nested "Value 3")]) + :asserter (fn [s] + (let [rect (head-rect s nested)] + (t/is (= (added s) (head-component s nested))) + (if (tm/applied? s from-a) + (do + (t/is (= green (fill-color rect))) + (t/is (contains? (:touched rect) :fill-group))) + (do + (t/is (= red (fill-color rect))) + (t/is (not (contains? (:touched rect) :fill-group)))))))})) + +(defn- variant-copy-checks + "Assert that the copy head bound to target fn `head` is still an instance of + `component-id`, its rect keeping the fill `color` override, touched only + there." + [s head component-id color] + (let [rect (head-rect s head)] + (t/is (= component-id (head-component s head))) + (t/is (= color (fill-color rect))) + (t/is (= #{:fill-group} (:touched rect))) + (t/is (empty? (:touched (tm/shape-by-id s (head s))))))) + +(defn transformed-component-keeps-its-copies + "Case AT (frontend only). A component has a copy that overrides its rect's + fill; optionally its main gets a path name. The main becomes a variant, + from the design tab or with the create-component shortcut on the + selected main. The component becomes the first member of a new set with + one property, valued after the path's last part if it has one, a second + member (a duplicate) joins it, and the copy stays an instance of the + component with its override. A switch of the copy to the second member + keeps the override, touched, the mains agreeing on the fill (decision + a)." + [] + (let [m "main" + head (n/copy-head-of m) + main (n/main-head-of m) + comp #(n/lineage-component-id % m) + path-name (n/change-property main :name "Button/Primary") + first-val #(if (tm/applied? % path-name) "Primary" "Value 1") + transform (n/transform-in-variant main) + shortcut (n/variant-shortcut :create-component [main]) + ;; renaming the main to the path's first part syncs the copy's name + ;; in an undo entry of its own: one undo reverts only that sync + f6 (fn [op] + {:bug "F6" + :fails {:undo #{[:object :sync-main-head :frame-id] + [:object :sync-main-head :parent-id] + [:object :sync-main-head :name] + [:object :sync-main-head :variant-id] + [:object :sync-main-head :variant-name] + [:object :sync-main-head :hide-in-viewer] + [:object :unlabelled :extra] + [:object :unlabelled :shapes] + [:component :sync-main-component :name] + [:component :sync-main-component :variant-id] + [:component :sync-main-component :variant-properties] + [:component :unlabelled :extra]} + :undo-index #{[:undo-index 1]}} + :op op + :runners #{:frontend} + :when #(tm/applied? % path-name)})] + {:setup setup/empty-situation + :undo-check {:known-failures [(f6 transform) (f6 shortcut)]} + :operation (tm/in-sequence + [(n/create-component m base-color :size 100) + (n/instantiate-copy m) + (n/change-property (n/copy-rect-of m) :fills green) + (tm/optional path-name) + (tm/one-of [transform shortcut]) + (tm/test-that + (fn [s] + (let [component (n/component-of s main) + variant-id (:variant-id component) + members (n/variant-component-ids s variant-id)] + (t/is (some? variant-id)) + (t/is (:is-variant-container (tm/shape-by-id s variant-id))) + (t/is (= variant-id (:parent-id (tm/shape-by-id s (main s))))) + (when (tm/applied? s path-name) + (t/is (= "Button" (:name component))) + (t/is (= "Button" (:name (tm/shape-by-id s variant-id))))) + (t/is (= 2 (count members))) + (t/is (= #{[["Property 1" (first-val s)]] [["Property 1" "Value 2"]]} + (set (map #(n/component-properties s %) members)))) + (t/is (= [["Property 1" (first-val s)]] (n/component-properties s (comp s)))) + (variant-copy-checks s head (comp s) green)))) + (n/switch-variant head "Value 2")]) + :asserter (fn [s] + (let [rect (head-rect s head) + second (->> (n/variant-component-ids s (:variant-id (n/component-of s main))) + (remove #{(comp s)}) + first)] + (t/is (= second (head-component s head))) + (t/is (= green (fill-color rect))) + (t/is (contains? (:touched rect) :fill-group))))})) + +(defn combined-components-keep-their-copies + "Case AU (frontend only). Two components, each with a copy; the first copy + overrides its rect's fill. Their mains are combined as variants, by ids or + as the selection. Both components become members of one new set, each + with its own value, and the copies stay instances of their components, + the override kept. The first copy then switches to the second member and + takes its fill untouched, the mains differing (decision a)." + [] + (let [m1 "first" + m2 "second" + head (n/copy-head-of m1) + mains [(n/main-head-of m1) (n/main-head-of m2)] + value (fn [s] (-> (n/component-properties s (n/lineage-component-id s m2)) first second))] + {:setup setup/empty-situation + :operation (tm/in-sequence + [(n/create-component m1 base-color :size 100) + (n/create-component m2 red :size 100) + (n/instantiate-copy m1) + (n/instantiate-copy m2) + (n/change-property (n/copy-rect-of m1) :fills green) + (tm/one-of [(n/combine-as-variants mains) + (n/combine-as-variants mains :selected? true)]) + (tm/test-that + (fn [s] + (let [c1 (n/lineage-component-id s m1) + c2 (n/lineage-component-id s m2) + variant-id (:variant-id (n/component-of s (first mains)))] + (t/is (some? variant-id)) + (t/is (= variant-id (:variant-id (n/component-of s (second mains))))) + (t/is (= #{c1 c2} (set (n/variant-component-ids s variant-id)))) + (t/is (not= (n/component-properties s c1) (n/component-properties s c2))) + (variant-copy-checks s head c1 green) + (t/is (= c2 (head-component s (n/copy-head-of m2)))) + (t/is (= red (head-rect-color s (n/copy-head-of m2))))))) + (n/switch-variant head value)]) + :asserter (fn [s] + (let [rect (head-rect s head)] + (t/is (= (n/lineage-component-id s m2) (head-component s head))) + (t/is (= red (fill-color rect))) + (t/is (not (contains? (:touched rect) :fill-group)))))})) + +(defn variant-rename-reaches-copy-names + "Case AV (frontend only). A copy nests member a of a variant set and + optionally renames its nested copy. The set is renamed from the design + tab. The container and every member's main take the new name, and so does + the nested copy in the outer main; the copy's nested copy takes it too + unless renamed, then it keeps its name, touched (decision d)." + [] + (let [m "main" + vset "vset" + nested (n/nested-head-in m) + in-main (n/nested-head-under (n/main-head-of m)) + rename-copy (n/change-property nested :name "Mine") + rename (n/rename-variant #(:id (n/member-root % vset "a")) "Renamed")] + {:setup setup/empty-situation + ;; the rename's transaction keeps the undo group of its first commit, the + ;; container's, while the copies' sync takes the group of the main + ;; renames: one undo reverts only the sync + :undo-check {:known-failures [{:bug "F6" + :fails {:undo #{[:object :sync-vset-vcontainer :name] + [:object :sync-vset-v0-root :name] + [:object :sync-vset-v1-root :name] + [:component :sync-vset-v0-component :name] + [:component :sync-vset-v1-component :name]} + :undo-index #{[:undo-index 1]}} + :op rename + :runners #{:frontend}}]} + :operation (tm/in-sequence + [(n/create-component m base-color :size 100) + (n/make-variant-container vset [["a" base-color] ["b" red]] :size 100) + (n/make-nested-component-with-variant m vset "a") + (n/instantiate-copy m) + (tm/optional rename-copy) + rename]) + :asserter (fn [s] + (let [copy (tm/shape-by-id s (nested s))] + (t/is (= "Renamed" (:name (tm/shape-by-id s (n/variant-set-id s vset))))) + (doseq [v ["a" "b"]] + (t/is (= "Renamed" (:name (n/member-root s vset v))) v)) + (t/is (= "Renamed" (:name (tm/shape-by-id s (in-main s))))) + (if (tm/applied? s rename-copy) + (do + (t/is (= "Mine" (:name copy))) + (t/is (contains? (:touched copy) :name-group))) + (do + (t/is (= "Renamed" (:name copy))) + (t/is (not (contains? (:touched copy) :name-group)))))))})) + +(defn variant-layer-rename-and-cleanup + "Case AW (frontend only). A copy nests member a of a variant set (a, b; their + rects differ) and overrides the fill of the variant's rect. Member a is + renamed in the layers panel: its value changes and a property Size is + added, empty on b. The set gets a property with no values and the empty + properties are removed: only that one goes, Size holding a value. A + second layers-panel rename drops Size from a, leaving it empty on every + member, and the empty properties are removed again: Size goes. Then + member b gets an error and loses it. The copy stays as it was through + every step, and a switch then finds member b." + [] + (let [m "main" + vset "vset" + nested (n/nested-head-in m) + a-id #(n/variant-member-component-id % vset "a") + b-root #(n/member-root % vset "b") + props (fn [s] + [(n/member-properties s vset "a") (n/member-properties s vset "b")]) + resized [[["Property 1" "a2"] ["Size" "S"]] [["Property 1" "b"] ["Size" ""]]]] + {:setup setup/empty-situation + :operation (tm/in-sequence + [(n/create-component m base-color :size 100) + (n/make-variant-container vset [["a" base-color] ["b" red]] :size 100) + (n/make-nested-component-with-variant m vset "a") + (n/instantiate-copy m) + (n/change-property #(:id (head-rect % nested)) :fills green) + (n/rename-variant-in-layers vset "a" [["Property 1" "a2"] ["Size" "S"]]) + (tm/test-that + (fn [s] + (t/is (= resized (props s))) + (t/is (= "a2, S" (:variant-name (n/member-root s vset "a")))) + (variant-copy-checks s nested (a-id s) green))) + (n/add-variant-property vset :name "Empty") + (n/remove-empty-properties vset) + (tm/test-that + (fn [s] + (t/is (= resized (props s))) + (variant-copy-checks s nested (a-id s) green))) + (n/rename-variant-in-layers vset "a" [["Property 1" "a2"]]) + (tm/test-that + (fn [s] + (t/is (= [[["Property 1" "a2"] ["Size" ""]] [["Property 1" "b"] ["Size" ""]]] + (props s))))) + (n/remove-empty-properties vset) + (tm/test-that + (fn [s] + (t/is (= [[["Property 1" "a2"]] [["Property 1" "b"]]] (props s))) + (t/is (= "a2" (:variant-name (n/member-root s vset "a")))) + (variant-copy-checks s nested (a-id s) green))) + (n/set-variant-error vset "b" "Duplicated") + (tm/test-that (fn [s] (t/is (= "Duplicated" (:variant-error (b-root s)))))) + (n/set-variant-error vset "b" nil) + (tm/test-that + (fn [s] + (t/is (nil? (:variant-error (b-root s)))) + (variant-copy-checks s nested (a-id s) green))) + (n/switch-variant nested "b")]) + :asserter (fn [s] + (let [rect (head-rect s nested)] + (t/is (= (n/variant-member-component-id s vset "b") (head-component s nested))) + (t/is (= red (fill-color rect))) + (t/is (not (contains? (:touched rect) :fill-group)))))})) + +(defn variant-shortcuts-add-members + "Case AX (frontend only). A copy nests member a of a variant set (a, b) and + overrides the fill of the variant's rect. With member a, or members a and + b, selected, the create-component or the duplicate shortcut adds one + member per selected one, each a duplicate with a value of its own. The + copy stays as it was." + [] + (let [m "main" + vset "vset" + nested (n/nested-head-in m) + a #(:id (n/member-root % vset "a")) + b #(:id (n/member-root % vset "b")) + sweep (tm/one-of [(n/variant-shortcut :create-component [a]) + (n/variant-shortcut :duplicate [a]) + (n/variant-shortcut :create-component [a b]) + (n/variant-shortcut :duplicate [a b])])] + {:setup setup/empty-situation + :operation (tm/in-sequence + [(n/create-component m base-color :size 100) + (n/make-variant-container vset [["a" base-color] ["b" red]] :size 100) + (n/make-nested-component-with-variant m vset "a") + (n/instantiate-copy m) + (n/change-property #(:id (head-rect % nested)) :fills green) + sweep]) + :asserter (fn [s] + (let [members (n/variant-component-ids s (n/variant-set-id s vset)) + added (count (get-in (tm/get-choice s sweep) [:params :targets]))] + (t/is (= (+ 2 added) (count members))) + (t/is (apply distinct? (map #(n/component-properties s %) members))) + (variant-copy-checks s nested (n/variant-member-component-id s vset "a") green)))})) + +(defn- subtree-rect + "The rect in the subtree of the shape bound to target fn `head`." + [s head] + (let [objects (:objects (thf/current-page (tm/file s)))] + (->> (cfh/get-children-ids objects (head s)) + (map #(get objects %)) + (d/seek #(= :rect (:type %)))))) + +(defn copy-moved-out-of-its-main-keeps-inherited-overrides + "Case AZ. A main nests a copy of another component and overrides the fill + of its rect; optionally a second main nests a copy of that main, whose + inner copy then inherits the override without holding it. The innermost + copy of the latest main is copied and pasted at the page root: the new + copy is a copy of the inner component and shows the overridden fill. + Then the inner main changes that fill. The new copy keeps the fill the + main gave it, as its own override, touched: the copy merges the touched + groups of the ref chain it skips, the way a detach keeps the near main's + overrides (F17 does not show through paste)." + [] + (let [m "main" + inner (fn [s] (:parent-id (tm/shape-by-id s ((n/main-rect-of m) s)))) + paste (n/paste-to-root inner) + head (n/duplicate-head-of paste)] + {:setup setup/empty-situation + :operation (tm/in-sequence + [(n/create-component m base-color :size 100) + (n/make-nested-component m) + (n/change-property (n/main-rect-of m) :fills green) + (tm/optional (n/make-nested-component m)) + paste + (tm/test-that + (fn [s] + (let [rect (subtree-rect s head)] + (t/is (= uuid/zero (:parent-id (tm/shape-by-id s (head s))))) + (t/is (= ((n/remote-rect-of m) s) (:shape-ref rect))) + (t/is (= green (fill-color rect)))))) + (n/change-property (n/remote-rect-of m) :fills red)]) + :asserter (fn [s] + (let [rect (subtree-rect s head)] + (t/is (= green (fill-color rect))) + (t/is (contains? (:touched rect) :fill-group))))})) + +;; --------------------------------------------------------------------------- +;; Tokens +;; --------------------------------------------------------------------------- + +(defn token-on-a-main-reaches-copies + "Case AY. The copy of a component optionally applies a border radius token + to its rect, then the main applies another one to its own. The main's + token and radius reach the copy unless it applied its own: then it keeps + its token and radius, touched. Then the main optionally removes its + token: a copy that followed loses it and keeps the radius; one with its + own token keeps it." + [] + (let [m "main" + own (n/apply-token (n/copy-rect-of m) "radius.s" 10) + applied (n/apply-token (n/main-rect-of m) "radius.l" 30) + removal (n/unapply-token (n/main-rect-of m) "radius.l") + rect (fn [s target] (tm/shape-by-id s (target s)))] + {:setup setup/empty-situation + ;; the undo of the sync gives the copy rect, which had no tokens, an + ;; empty `:applied-tokens` map + :undo-check {:known-failures [{:bug "F55" + :fails {:undo #{[:object :unlabelled :applied-tokens]} + :variant-undo #{[:object :unlabelled :applied-tokens]}} + :op applied + :when #(not (tm/applied? % own))}]} + :operation (tm/in-sequence + [(n/create-component m base-color :size 100) + (n/add-tokens [["radius.s" 10] ["radius.l" 30]]) + (n/instantiate-copy m) + (tm/optional own) + applied + (tm/test-that + (fn [s] + (let [copy (rect s (n/copy-rect-of m))] + (t/is (n/has-token? (rect s (n/main-rect-of m)) "radius.l" 30)) + (if (tm/applied? s own) + (do + (t/is (n/has-token? copy "radius.s" 10)) + (t/is (contains? (:touched copy) :radius-group))) + (do + (t/is (n/has-token? copy "radius.l" 30)) + (t/is (empty? (:touched copy)))))))) + (tm/optional removal)]) + :asserter (fn [s] + (when (tm/applied? s removal) + (let [main (rect s (n/main-rect-of m)) + copy (rect s (n/copy-rect-of m))] + (t/is (empty? (:applied-tokens main))) + (t/is (= 30 (:r1 main))) + (if (tm/applied? s own) + (t/is (n/has-token? copy "radius.s" 10)) + (do + (t/is (empty? (:applied-tokens copy))) + (t/is (= 30 (:r1 copy))) + (t/is (empty? (:touched copy))))))))})) + (defn geometry-sync-with-rotated-instances "Case N (frontend only). Optionally the copy rotates, optionally the main rotates, then the main child changes its fill or its height. The change diff --git a/common/src/app/common/test_helpers/composable/comp/nodes.cljc b/common/src/app/common/test_helpers/composable/comp/nodes.cljc index 56d4c43692..a9ac8d2665 100644 --- a/common/src/app/common/test_helpers/composable/comp/nodes.cljc +++ b/common/src/app/common/test_helpers/composable/comp/nodes.cljc @@ -14,10 +14,12 @@ [app.common.files.changes-builder :as pcb] [app.common.files.helpers :as cfh] [app.common.files.shapes-helpers :as cfsh] + [app.common.files.tokens :as cfo] [app.common.geom.point :as gpt] [app.common.geom.shapes :as gsh] [app.common.logic.libraries :as cll] [app.common.logic.shapes :as cls] + [app.common.logic.variant-properties :as clvp] [app.common.logic.variants :as clv] [app.common.math :as mth] [app.common.test-helpers.components :as thc] @@ -26,10 +28,18 @@ [app.common.test-helpers.files :as thf] [app.common.test-helpers.ids-map :as thi] [app.common.test-helpers.shapes :as ths] + [app.common.test-helpers.tokens :as tht] + [app.common.types.component :as ctk] + [app.common.types.components-list :as ctkl] [app.common.types.container :as ctn] + [app.common.types.file :as ctf] [app.common.types.modifiers :as ctm] [app.common.types.shape.layout :as ctl] - [app.common.types.text :as txt])) + [app.common.types.shape.radius :as ctsr] + [app.common.types.text :as txt] + [app.common.types.tokens-lib :as ctob] + [app.common.types.tokens-status :as ctos] + [app.common.uuid :as uuid])) ;; --------------------------------------------------------------------------- ;; Operation kinds: how a runner treats a node. @@ -955,6 +965,80 @@ [node] (fn [s] (:new-head (tm/node-data s node)))) +;; --------------------------------------------------------------------------- +;; paste-to-root — copy a shape and paste it at the page root +;; +;; As the clipboard does: the copy advances the shape refs of the nested copy +;; heads in the copied subtree by the copy levels they leave, merging the +;; touched groups of the ref chain they skip (`copy-selected`), and the paste +;; duplicates the copied subtree under the root (`paste-shapes`, through +;; `generate-duplicate-changes`). +;; --------------------------------------------------------------------------- + +(defn- copied-objects + "The subtree of `id` as the clipboard copies it." + [file page libraries id] + (let [objects (:objects page) + container (ctn/make-container page :page) + advance (fn [delta copied shape] + (let [new-ref (ctf/advance-shape-ref file page libraries shape delta + {:include-deleted? true})] + (cond-> copied + (and (some? new-ref) (not= new-ref (:shape-ref shape))) + (-> (assoc-in [(:id shape) :shape-ref] new-ref) + (assoc-in [(:id shape) :touched] + (ctf/get-touched-from-ref-chain-until-target-ref + container libraries shape new-ref)))))) + copied (into {} (map (juxt :id identity)) (cfh/get-children-with-self objects id))] + (reduce (fn [copied head] + (if (and (ctk/instance-head? head) (not (ctk/main-instance? head))) + (let [delta (if (nil? (ctk/get-swap-slot head)) + (ctn/get-nesting-level-delta objects head uuid/zero) + 0)] + (if (pos? delta) + (reduce (partial advance delta) copied (cfh/get-children-with-self objects (:id head))) + copied)) + copied)) + copied + (ctn/get-child-heads copied id)))) + +(defrecord PasteToRoot [target] + IComponentOperation + (op-kind [_] :user) + + IAppliedResult + (applied-result [_ file-before file-after] + {:new-head (new-subtree-head (thf/current-page file-before) + (thf/current-page file-after))}) + + tm/IOperation + (apply-to [this situation] + (let [the-file (tm/file situation) + page (thf/current-page the-file) + libs (libraries situation) + id (tm/target-shape-id situation target) + copied (-> (copied-objects the-file page libs id) + (update id assoc :parent-id uuid/zero :frame-id uuid/zero)) + changes (-> (pcb/empty-changes nil (:id page)) + (cll/generate-duplicate-changes (merge (:objects page) copied) + page + #{id} + (gpt/point 0 0) + libs + (:data the-file) + (:id the-file))) + file' (thf/apply-changes the-file changes :validate? false)] + (-> situation + (tm/with-file file') + (record-changes changes) + (tm/record-application this (merge {:target target} + (applied-result this the-file file'))))))) + +(defn paste-to-root + "Copy the shape `target` names and paste it at the page root." + [target] + (tm/assign-id (->PasteToRoot target))) + ;; --------------------------------------------------------------------------- ;; nest-copy — move an existing copy into a main ;; @@ -1243,13 +1327,24 @@ ;; switch-variant — switch a variant copy head to a sibling member ;; ;; Switches the variant copy head bound to `target` to the member whose -;; property has `value`, through `find-switch-target` and a keep-touched -;; `generate-component-swap-in-place` (`variants-switch` on the frontend). The +;; property at position `pos` has `value`, through `find-switch-target` and a +;; keep-touched `generate-component-swap-in-place` (`variants-switch` on the +;; frontend). The ;; event's follow-ups (token propagation, WASM text resize, layout update) are ;; frontend code, left out here. ;; --------------------------------------------------------------------------- -(defrecord SwitchVariant [target value] +(defn switch-pos + "The property position the `switch-variant` node `op` switches by." + [situation {:keys [pos]}] + (if (fn? pos) (pos situation) pos)) + +(defn switch-value + "The property value the `switch-variant` node `op` switches to." + [situation {:keys [value]}] + (if (fn? value) (value situation) value)) + +(defrecord SwitchVariant [target value pos] IComponentOperation (op-kind [_] :user) @@ -1260,7 +1355,9 @@ objects (:objects page) libraries (libraries situation) shape (get objects (tm/target-shape-id situation target)) - component (clv/find-switch-target libraries shape 0 value)] + component (clv/find-switch-target libraries shape + (switch-pos situation this) + (switch-value situation this))] (cond ;; the value is already `value`, or no sibling has it: nothing happens (nil? component) @@ -1290,9 +1387,269 @@ (defn switch-variant "Switch the variant copy head `target` names to the member whose property - has value `value`." - [target value] - (tm/assign-id (->SwitchVariant target value))) + at position `:pos` (default 0) has value `value`. Both may be + `(situation -> x)` fns, for sets an action built." + [target value & {:keys [pos] :or {pos 0}}] + (tm/assign-id (->SwitchVariant target value pos))) + +;; --------------------------------------------------------------------------- +;; Variant properties — add, remove, rename, reorder a property of a set, or +;; set the value of a member +;; +;; The edits of the design tab's variant properties, through the +;; `app.common.logic.variant-properties` generators (the `dwv` events on the +;; frontend). `variant-property-call` resolves an edit to the generator's +;; arguments, which the frontend events take too. A member is named by the +;; value it was built with (`variant-member`), whatever its value now. +;; --------------------------------------------------------------------------- + +(defn variant-set-id + "The variant id of set `set-name`." + [situation set-name] + (:variant-id (variant-set situation set-name))) + +(defn member-component + "The component of set `set-name`'s member built with value `value`, read + from the file." + [situation set-name value] + (ctkl/get-component (:data (tm/file situation)) + (variant-member-component-id situation set-name value))) + +(defn component-properties + "The variant properties of the component `component-id`, as + `[[name value] ...]`." + [situation component-id] + (->> (ctkl/get-component (:data (tm/file situation)) component-id) + :variant-properties + (mapv (juxt :name :value)))) + +(defn member-properties + "The variant properties of set `set-name`'s member built with value `value`, + as `[[name value] ...]`." + [situation set-name value] + (component-properties situation (variant-member-component-id situation set-name value))) + +(defn member-root + "The main root of set `set-name`'s member built with value `value`." + [situation set-name value] + (tm/shape-by-id situation (thi/id (:root-label (variant-member situation set-name value))))) + +(defn variant-property-call + "The edit of `op` as `[edit & args]`, the arguments the generator and the + frontend event of `edit` take after the changes." + [situation {:keys [set-name edit params]}] + (let [variant-id (variant-set-id situation set-name)] + (case edit + :add [:add variant-id (select-keys params [:property-name :property-value])] + :remove [:remove variant-id (:pos params)] + :rename [:rename variant-id (:pos params) (:name params)] + :reorder [:reorder variant-id (:from params) (:to params)] + :set-value [:set-value + (variant-member-component-id situation set-name (:member params)) + (:pos params) + (:value params)]))) + +(defn- variant-property-changes + [changes [edit & args]] + (case edit + :add (let [[variant-id opts] args] + (clvp/generate-add-new-property changes variant-id opts)) + :remove (apply clvp/generate-remove-property changes args) + :rename (apply clvp/generate-update-property-name changes args) + :reorder (apply clvp/generate-reorder-variant-poperties changes args) + :set-value (apply clvp/generate-update-property-value changes args))) + +(defrecord EditVariantProperty [set-name edit params] + IComponentOperation + (op-kind [_] :user) + + tm/IOperation + (apply-to [this situation] + (let [the-file (tm/file situation) + page (thf/current-page the-file) + changes (-> (pcb/empty-changes nil (:id page)) + (pcb/with-library-data (:data the-file)) + (pcb/with-objects (:objects page)) + (variant-property-changes (variant-property-call situation this))) + file' (thf/apply-changes the-file changes :validate? false)] + (-> situation + (tm/with-file file') + (record-changes (when (seq (:redo-changes changes)) changes)) + (tm/record-application this {:set-name set-name :edit edit :params params}))))) + +(defn add-variant-property + "Add a property `:name` to set `set-name`, with value `:value` on every + member (empty when not given)." + [set-name & {:keys [name value]}] + (tm/assign-id (->EditVariantProperty set-name :add (cond-> {} + name (assoc :property-name name) + value (assoc :property-value value))))) + +(defn remove-variant-property + "Remove the property at position `pos` from set `set-name`." + [set-name pos] + (tm/assign-id (->EditVariantProperty set-name :remove {:pos pos}))) + +(defn rename-variant-property + "Rename the property at position `pos` of set `set-name` to `name`." + [set-name pos name] + (tm/assign-id (->EditVariantProperty set-name :rename {:pos pos :name name}))) + +(defn reorder-variant-properties + "Move the property at position `from` of set `set-name` to the gap before + position `to`." + [set-name from to] + (tm/assign-id (->EditVariantProperty set-name :reorder {:from from :to to}))) + +(defn set-variant-property-value + "Set the value of the property at position `pos` of set `set-name`'s member + built with value `member` to `value`." + [set-name member pos value] + (tm/assign-id (->EditVariantProperty set-name :set-value + {:member member :pos pos :value value}))) + +;; --------------------------------------------------------------------------- +;; add-variant — add a member to a variant set +;; +;; The "add variant" action on a member: a duplicate of its component joins +;; the set, its last property set to the next "Value n", through +;; `clv/generate-add-new-variant` (`add-new-variant` on the frontend, which +;; also places the new main in the container and selects it). +;; --------------------------------------------------------------------------- + +(defn- new-component-id + "The id of the component that `file-after` has and `file-before` has not." + [file-before file-after] + (let [before (set (map :id (ctkl/components-seq (:data file-before))))] + (->> (ctkl/components-seq (:data file-after)) + (map :id) + (remove before) + (first)))) + +(defrecord AddVariant [set-name member] + IComponentOperation + (op-kind [_] :user) + + IAppliedResult + (applied-result [_ file-before file-after] + {:component-id (new-component-id file-before file-after)}) + + tm/IOperation + (apply-to [this situation] + (let [the-file (tm/file situation) + page (thf/current-page the-file) + root (member-root situation set-name member) + component (member-component situation set-name member) + changes (-> (pcb/empty-changes nil (:id page)) + (pcb/with-library-data (:data the-file)) + (pcb/with-objects (:objects page)) + (clv/generate-add-new-variant root + (:variant-id component) + (uuid/next) + (uuid/next) + (dec (count (:variant-properties component))))) + file' (thf/apply-changes the-file changes :validate? false)] + (-> situation + (tm/with-file file') + (record-changes changes) + (tm/record-application this (merge {:set-name set-name :member member} + (applied-result this the-file file'))))))) + +(defn add-variant + "Add a member to set `set-name`, a duplicate of its member built with value + `member`." + [set-name member] + (tm/assign-id (->AddVariant set-name member))) + +(defn added-variant-component-id + "The id of the component that the `add-variant` node `node` added." + [situation node] + (:component-id (tm/node-data situation node))) + +;; --------------------------------------------------------------------------- +;; Variant actions with no common generator (frontend only) +;; +;; Transform a component into a variant, combine components as variants, +;; rename a variant, rename a member in the layers panel, remove the empty +;; properties, set a member's error, and the shortcuts that add a variant to +;; selected members. Their logic is in the `dwv` events, so the frontend +;; interpreter sends them and the pure runner rejects them. A set these +;; actions build has no `variant-set` record: read it from the file +;; (`component-of`, `variant-component-ids`). +;; --------------------------------------------------------------------------- + +(defrecord VariantAction [action params] + IComponentOperation + (op-kind [_] :frontend-only) + + tm/IOperation + (apply-to [_ _] + (throw (ex-info (str "variant action " action " runs only in the frontend") + {:action action})))) + +(defn- variant-action + [action params] + (tm/assign-id (->VariantAction action params))) + +(defn transform-in-variant + "Turn the component whose main root `target` names into the first member of + a new variant set (`transform-in-variant`), which also adds a second + member." + [target] + (variant-action :transform {:target target})) + +(defn combine-as-variants + "Combine the components whose main roots `targets` name into a new variant + set (`combine-as-variants`), or with `:selected?`, select them and combine + the selection (`combine-selected-as-variants`)." + [targets & {:keys [selected?]}] + (variant-action :combine {:targets targets :selected? selected?})) + +(defn rename-variant + "Rename the variant set of the member whose main root `target` names, its + container and every member's main (`rename-comp-or-variant-and-main`)." + [target name] + (variant-action :rename {:target target :name name})) + +(defn rename-variant-in-layers + "Rename set `set-name`'s member built with value `member` in the layers + panel, to the properties `properties` (`[[name value] ...]`) + (`update-properties-names-and-values`)." + [set-name member properties] + (variant-action :rename-in-layers {:set-name set-name :member member :properties properties})) + +(defn remove-empty-properties + "Remove the properties of set `set-name` whose value is empty in every + member (`remove-empty-properties`)." + [set-name] + (variant-action :remove-empty {:set-name set-name})) + +(defn set-variant-error + "Set the error of set `set-name`'s member built with value `member` to + `value`, nil to clear it (`update-error`)." + [set-name member value] + (variant-action :error {:set-name set-name :member member :value value})) + +(defn variant-shortcut + "Select the shapes `targets` name and press the shortcut `kind`: + `:create-component` (`add-component-or-variant`) or `:duplicate` + (`duplicate-or-add-variant`)." + [kind targets] + (variant-action :shortcut {:kind kind :targets targets})) + +(defn component-of + "The component of the shape `target` names, read from the file." + [situation target] + (let [shape (tm/shape-by-id situation (tm/target-shape-id situation target))] + (ctkl/get-component (:data (tm/file situation)) (:component-id shape)))) + +(defn variant-component-ids + "The ids of the components of the variant set `variant-id`, in the order of + its container's children." + [situation variant-id] + (let [page (thf/current-page (tm/file situation))] + (->> (get-in page [:objects variant-id :shapes]) + (mapv #(get-in page [:objects % :component-id]))))) @@ -1551,3 +1908,119 @@ (->> (:shapes container-shape) (map #(ths/get-shape-by-id the-file %)) (d/seek #(= added-id (:shape-ref %))))))) + +;; =========================================================================== +;; Tokens +;; +;; A token applied to a shape is recorded in its `:applied-tokens` (attribute +;; -> token name) and sets the attribute to the token's value. Sync copies +;; both to an untouched copy (`update-tokens`). Only border radius tokens +;; (attributes :r1..:r4) are modelled. +;; =========================================================================== + +(def radius-attrs + "The attributes a border radius token applies to." + #{:r1 :r2 :r3 :r4}) + +(defrecord AddTokens [tokens] + IComponentOperation + (op-kind [_] :assembly) + + tm/IOperation + (apply-to [this situation] + (let [set-id (uuid/next) + theme-id (uuid/next) + add (fn [lib [name value]] + (ctob/add-token lib set-id (ctob/make-token :name name + :type :border-radius + :value value))) + file' (-> (tm/file situation) + (tht/add-tokens-lib) + (tht/update-tokens-lib + #(as-> % lib + (ctob/add-set lib (ctob/make-token-set :id set-id :name "composable")) + (ctob/add-theme lib (ctob/make-token-theme :id theme-id + :name "composable" + :sets #{"composable"})) + (reduce add lib tokens))) + (tht/update-tokens-status #(ctos/set-tokens-status % #{theme-id} #{set-id})))] + (-> situation + (tm/with-file file') + (tm/record-application this {:tokens tokens}))))) + +(defn add-tokens + "Give the file an active set of border radius tokens, `tokens` being + `[[name value] ...]`." + [tokens] + (tm/assign-id (->AddTokens tokens))) + +(defrecord ApplyToken [target token-name value] + IComponentOperation + (op-kind [_] :user) + + tm/IOperation + (apply-to [this situation] + ;; as `apply-token` commits them: the token, then its value without + ;; touching + (let [the-file (tm/file situation) + shape-id (tm/target-shape-id situation target) + page (thf/current-page the-file) + changes (-> (pcb/empty-changes nil (:id page)) + (cls/generate-update-shapes + #{shape-id} + #(update % :applied-tokens merge (zipmap radius-attrs (repeat token-name))) + (:objects page) + {}) + (cls/generate-update-shapes + #{shape-id} + #(ctsr/set-radius-for-corners % radius-attrs value) + (:objects page) + {:ignore-touched true :attrs radius-attrs})) + file' (thf/apply-changes the-file changes)] + (-> situation + (tm/with-file file') + (record-changes changes) + (tm/record-application this {:target target :token-name token-name :value value}))))) + +(defn apply-token + "Apply the border radius token `token-name`, of value `value`, to every + corner of the shape `target` names (`apply-token` on the frontend)." + [target token-name value] + (tm/assign-id (->ApplyToken target token-name value))) + +(defrecord UnapplyToken [target token-name] + IComponentOperation + (op-kind [_] :user) + + tm/IOperation + (apply-to [this situation] + (let [the-file (tm/file situation) + shape-id (tm/target-shape-id situation target) + page (thf/current-page the-file) + changes (cls/generate-update-shapes + (pcb/empty-changes nil (:id page)) + #{shape-id} + (fn [shape] + (update shape :applied-tokens + #(when % (cfo/remove-attributes-for-token radius-attrs token-name %)))) + (:objects page) + {}) + file' (thf/apply-changes the-file changes)] + (-> situation + (tm/with-file file') + (record-changes (when (seq (:redo-changes changes)) changes)) + (tm/record-application this {:target target :token-name token-name}))))) + +(defn unapply-token + "Remove the border radius token `token-name` from the shape `target` names, + keeping its radius (`unapply-token` on the frontend)." + [target token-name] + (tm/assign-id (->UnapplyToken target token-name))) + +(defn has-token? + "Whether `shape` has the border radius token `token-name` on every corner, + with radius `value`." + [shape token-name value] + (every? #(and (= token-name (get-in shape [:applied-tokens %])) + (= value (get shape %))) + radius-attrs)) diff --git a/common/test/common_tests/logic/comp_creation_test.cljc b/common/test/common_tests/logic/comp_creation_test.cljc index 95f158e2a3..a2ccbd971d 100644 --- a/common/test/common_tests/logic/comp_creation_test.cljc +++ b/common/test/common_tests/logic/comp_creation_test.cljc @@ -20,6 +20,7 @@ [app.common.types.component :as ctk] [app.common.types.components-list :as ctkl] [app.common.types.file :as ctf] + [app.common.types.pages-list :as ctpl] [app.common.types.shape-tree :as ctst] [app.common.uuid :as uuid] [clojure.test :as t])) @@ -459,6 +460,59 @@ (t/is (ctk/main-instance-of? (:id main1-root') (:id page) component1')) (t/is (nil? saved-objects')))) +(defn- restore-after-page-deletion + "Delete :component1, whose main lives on :page-2, then delete that page, + and restore the component from `current-page`. Returns the restored + file." + [file current-page] + (let [page2 (thf/get-page file :page-2) + root (ths/get-shape file :main1-root :page-label :page-2) + [_ changes] (cls/generate-delete-shapes (pcb/empty-changes) + file + page2 + (:objects page2) + #{(:id root)} + {:components-v2 true}) + file (-> (thf/apply-changes file changes) + (ctf/update-file-data #(ctpl/delete-page % (:id page2)))) + changes (cll/generate-restore-component (pcb/empty-changes) + (:data file) + (thi/id :component1) + (:id file) + current-page + (:objects current-page))] + (thf/apply-changes file changes))) + +(defn- three-page-file + "A file with pages :page-1, :page-2 (holding the main of :component1) and + :page-3." + [] + (-> (thf/sample-file :file1 :page-label :page-1) + (thf/add-sample-page :page-2) + (tho/add-simple-component :component1 :main1-root :main1-child) + (thf/add-sample-page :page-3) + (thf/switch-to-page :page-1))) + +(t/deftest test-restore-component-whose-page-was-deleted + (let [file (three-page-file) + file' (restore-after-page-deletion file (thf/get-page file :page-1)) + comp' (thc/get-component file' :component1 :include-deleted? false)] + ;; the current page belongs to the library, so the main goes there + (t/is (some? comp')) + (t/is (= (thi/id :page-1) (:main-instance-page comp'))) + (t/is (some? (get-in (thf/get-page file' :page-1) [:objects (:main-instance-id comp')]))))) + +(t/deftest test-restore-component-from-a-page-of-another-file + (let [file (three-page-file) + other (thf/sample-page :other-page) + file' (restore-after-page-deletion file other) + comp' (thc/get-component file' :component1 :include-deleted? false)] + ;; the current page is not one of the library's, so the main goes to + ;; the library's last page + (t/is (some? comp')) + (t/is (= (thi/id :page-3) (:main-instance-page comp'))) + (t/is (some? (get-in (thf/get-page file' :page-3) [:objects (:main-instance-id comp')]))))) + (t/deftest test-instantiate-component (let [;; ==== Setup file (-> (thf/sample-file :file1) diff --git a/common/test/common_tests/logic/composable_sync_test.cljc b/common/test/common_tests/logic/composable_sync_test.cljc index 21f5072884..11cb637dbb 100644 --- a/common/test/common_tests/logic/composable_sync_test.cljc +++ b/common/test/common_tests/logic/composable_sync_test.cljc @@ -133,3 +133,15 @@ (t/deftest case-aq-main-change-reaches-a-copy-nested-in-a-sub-board (check (cases/main-change-reaches-a-copy-nested-in-a-sub-board))) + +(t/deftest case-ar-variant-property-edits-keep-copies + (check (cases/variant-property-edits-keep-copies))) + +(t/deftest case-as-added-variant-is-a-switch-target + (check (cases/added-variant-is-a-switch-target))) + +(t/deftest case-ay-token-on-a-main-reaches-copies + (check (cases/token-on-a-main-reaches-copies))) + +(t/deftest case-az-copy-moved-out-of-its-main-keeps-inherited-overrides + (check (cases/copy-moved-out-of-its-main-keeps-inherited-overrides))) diff --git a/common/test/common_tests/logic/variants_switch_test.cljc b/common/test/common_tests/logic/variants_switch_test.cljc index de8fb76cb9..85a6a74af8 100644 --- a/common/test/common_tests/logic/variants_switch_test.cljc +++ b/common/test/common_tests/logic/variants_switch_test.cljc @@ -9,9 +9,11 @@ [app.common.files.changes-builder :as pcb] [app.common.files.helpers :as cfh] [app.common.geom.point :as gpt] + [app.common.geom.rect :as grc] [app.common.geom.shapes :as gsh] [app.common.logic.libraries :as cll] [app.common.logic.shapes :as cls] + [app.common.math :as mth] [app.common.test-helpers.components :as thc] [app.common.test-helpers.compositions :as tho] [app.common.test-helpers.files :as thf] @@ -19,6 +21,8 @@ [app.common.test-helpers.shapes :as ths] [app.common.test-helpers.variants :as thv] [app.common.types.component :as ctk] + [app.common.types.modifiers :as ctm] + [app.common.types.path.segment :as segment] [clojure.test :as t])) (t/use-fixtures :each thi/test-fixture) @@ -3152,3 +3156,128 @@ (t/is (= (get-in synced-t font-size-path-0) "30")) (t/is (contains? (:touched synced-t) :content-group)) (t/is (contains? (:touched synced-t) :text-content-text)))))) + +;; ============================================================ +;; GEOMETRY OVERRIDES FROM A REAL RESIZE +;; A transform updates :selrect and :points too, so the switch +;; carries them as well as :width and :height. +;; ============================================================ + +(defn- copy-child + [file label] + (let [page (thf/current-page file)] + (get-in page [:objects (-> (ths/get-shape file label) :shapes first)]))) + +(defn- resize-copy-child + "Resize the first child of the copy `label` by `sx`, `sy` from its top + left corner, as a transform does." + [file label sx sy] + (let [page (thf/current-page file) + child (copy-child file label) + origin (gpt/point (-> child :selrect :x) (-> child :selrect :y)) + changes (cls/generate-update-shapes + (pcb/empty-changes nil (:id page)) + #{(:id child)} + #(gsh/transform-shape % (ctm/resize-modifiers (gpt/point sx sy) origin)) + (:objects page) + {})] + (thf/apply-changes file changes))) + +(defn- size-is + "Assert that `shape`'s :selrect and :points both measure `width` x + `height`." + [shape width height] + (let [points (grc/points->rect (:points shape))] + (t/is (mth/close? width (-> shape :selrect :width))) + (t/is (mth/close? height (-> shape :selrect :height))) + (t/is (mth/close? width (:width points))) + (t/is (mth/close? height (:height points))))) + +(t/deftest test-switch-keeps-a-resized-child-of-same-size-variants + (let [file (-> (thf/sample-file :file1) + (thv/add-variant-with-child + :v01 :c01 :m01 :c02 :m02 :r01 :r02 + {:child1-params {:width 100 :height 50 :type :rect} + :child2-params {:width 100 :height 50 :type :rect}}) + (thc/instantiate-component :c01 :copy01 :children-labels [:copy-r01]) + (resize-copy-child :copy01 2 1)) + ;; the switch moves the labels, so read the copy before it + rect (copy-child file :copy01) + file' (tho/swap-component-in-shape file :copy01 :c02 {:new-shape-label :copy02 :keep-touched? true}) + rect' (copy-child file' :copy02)] + (size-is rect 200 50) + ;; the variants agree on the size, so the override is carried + (size-is rect' 200 50) + (t/is (contains? (:touched rect') :geometry-group)))) + +(t/deftest test-switch-with-h-sizing-fix-keeps-only-the-resized-height + (let [file (-> (thf/sample-file :file1) + (thv/add-variant-with-child + :v01 :c01 :m01 :c02 :m02 :r01 :r02 + {:child1-params {:width 100 :height 50 :type :rect :layout-item-h-sizing :fix} + :child2-params {:width 100 :height 50 :type :rect :layout-item-h-sizing :fix}}) + (thc/instantiate-component :c01 :copy01 :children-labels [:copy-r01]) + (resize-copy-child :copy01 2 2)) + rect (copy-child file :copy01) + file' (tho/swap-component-in-shape file :copy01 :c02 {:new-shape-label :copy02 :keep-touched? true})] + (size-is rect 200 100) + ;; the fixed width comes from the new variant; the height override stays + (size-is (copy-child file' :copy02) 100 100))) + +(t/deftest test-switch-keeps-a-resized-path-of-same-size-variants + (let [triangle (fn [x0 y0] + [{:command :move-to :params {:x x0 :y y0}} + {:command :line-to :params {:x (+ x0 24) :y y0}} + {:command :line-to :params {:x (+ x0 12) :y (+ y0 14)}} + {:command :close-path}]) + file (-> (thf/sample-file :file1) + (thv/add-variant :v01 :c01 :m01 :c02 :m02 + {:variant1-params {:width 100 :height 100} + :variant2-params {:width 100 :height 100}}) + (ths/add-sample-shape :path1 :type :path :parent-label :m01 + :content (triangle 0 10)) + (ths/add-sample-shape :path2 :type :path :parent-label :m02 + :content (triangle 0 30)) + (thc/instantiate-component :c01 :copy01) + (resize-copy-child :copy01 2 2)) + path (copy-child file :copy01) + file' (tho/swap-component-in-shape file :copy01 :c02 {:new-shape-label :copy02 :keep-touched? true}) + path' (copy-child file' :copy02) + content (segment/content->selrect (:content path'))] + (size-is path 48 28) + ;; the path keeps its size: its content is scaled like its box + (t/is (= :path (:type path'))) + (size-is path' 48 28) + (t/is (mth/close? 48 (:width content))) + (t/is (mth/close? 28 (:height content))))) + +(t/deftest test-switch-to-a-main-with-another-text-structure + ;; The second variant's text has two lines where the first has one, so + ;; the copy's text cannot keep its own structure. With uniform styles and + ;; mains that agree on them, a style override is carried onto the new + ;; variant's lines; when the mains disagree on the style, it is dropped. + (let [setup (fn [main-font-size] + (-> (thf/sample-file :file1) + (thv/add-variant-with-text + :v01 :c01 :m01 :c02 :m02 :t01 :t02 "hello world" "hello world") + (change-structure :t02) + (cond-> main-font-size + (-> (update-attr :t02 font-size-path-0 main-font-size) + (update-attr :t02 font-size-path-1 main-font-size))) + (thc/instantiate-component :c01 :copy01 :children-labels [:copy01-t]) + (update-attr :copy01-t font-size-path-0 "25"))) + switched (fn [file] + (-> (tho/swap-component-in-shape file :copy01 :c02 + {:new-shape-label :copy02 :keep-touched? true}) + (copy-child :copy02))) + agree (switched (setup nil)) + disagree (switched (setup "50"))] + (t/is (= "new line 1" (get-in agree text-path-0))) + (t/is (= "new line 2" (get-in agree text-path-1))) + (t/is (= "25" (get-in agree font-size-path-0))) + (t/is (= "25" (get-in agree font-size-path-1))) + + (t/is (= "new line 1" (get-in disagree text-path-0))) + (t/is (= "new line 2" (get-in disagree text-path-1))) + (t/is (= "50" (get-in disagree font-size-path-0))) + (t/is (= "50" (get-in disagree font-size-path-1))))) diff --git a/frontend/test/frontend_tests/composable_tests/comp/sync_test.cljs b/frontend/test/frontend_tests/composable_tests/comp/sync_test.cljs index 09a27e2ed9..ece9a39a76 100644 --- a/frontend/test/frontend_tests/composable_tests/comp/sync_test.cljs +++ b/frontend/test/frontend_tests/composable_tests/comp/sync_test.cljs @@ -137,3 +137,30 @@ (t/deftest case-aq-main-change-reaches-a-copy-nested-in-a-sub-board (t/async done (ftm/check done (cases/main-change-reaches-a-copy-nested-in-a-sub-board)))) + +(t/deftest case-ar-variant-property-edits-keep-copies + (t/async done (ftm/check done (cases/variant-property-edits-keep-copies)))) + +(t/deftest case-as-added-variant-is-a-switch-target + (t/async done (ftm/check done (cases/added-variant-is-a-switch-target)))) + +(t/deftest case-at-transformed-component-keeps-its-copies + (t/async done (ftm/check done (cases/transformed-component-keeps-its-copies)))) + +(t/deftest case-au-combined-components-keep-their-copies + (t/async done (ftm/check done (cases/combined-components-keep-their-copies)))) + +(t/deftest case-av-variant-rename-reaches-copy-names + (t/async done (ftm/check done (cases/variant-rename-reaches-copy-names)))) + +(t/deftest case-aw-variant-layer-rename-and-cleanup + (t/async done (ftm/check done (cases/variant-layer-rename-and-cleanup)))) + +(t/deftest case-ax-variant-shortcuts-add-members + (t/async done (ftm/check done (cases/variant-shortcuts-add-members)))) + +(t/deftest case-ay-token-on-a-main-reaches-copies + (t/async done (ftm/check done (cases/token-on-a-main-reaches-copies)))) + +(t/deftest case-az-copy-moved-out-of-its-main-keeps-inherited-overrides + (t/async done (ftm/check done (cases/copy-moved-out-of-its-main-keeps-inherited-overrides)))) diff --git a/frontend/test/frontend_tests/composable_tests/interpreter.cljs b/frontend/test/frontend_tests/composable_tests/interpreter.cljs index bbaf7d8952..f1178b6a1e 100644 --- a/frontend/test/frontend_tests/composable_tests/interpreter.cljs +++ b/frontend/test/frontend_tests/composable_tests/interpreter.cljs @@ -14,7 +14,9 @@ copies; only the library update of case H is an explicit `sync-file`, as in the app. `check` is the test entry point." (:require + [app.common.data :as d] [app.common.files.changes-builder :as pcb] + [app.common.files.tokens :as cfo] [app.common.logic.shapes :as cls] [app.common.test-helpers.composable.comp.nodes :as n] [app.common.test-helpers.composable.comp.undo-check :as uc] @@ -22,6 +24,7 @@ [app.common.test-helpers.files :as cthf] [app.common.test-helpers.ids-map :as cthi] [app.common.test-helpers.shapes :as cths] + [app.common.uuid :as uuid] [app.main.data.changes :as dch] [app.main.data.workspace :as dw] [app.main.data.workspace.libraries :as dwl] @@ -31,6 +34,7 @@ [app.main.data.workspace.shapes :as dwsh] [app.main.data.workspace.texts :as dwtx] [app.main.data.workspace.thumbnails :as dwth] + [app.main.data.workspace.tokens.application :as dwta] [app.main.data.workspace.transforms :as dwt] [app.main.data.workspace.undo :as dwu] [app.main.data.workspace.variants :as dwv] @@ -38,9 +42,11 @@ [app.main.repo :as rp] [app.main.store :as st] [app.plugins.reflow :as pwrf] + [app.util.dom :as dom] [beicon.v2.core :as rx] [cljs.test :as t] [frontend-tests.helpers.mock :as mock] + [frontend-tests.helpers.pages :as thp] [potok.v2.core :as ptk])) ;; -------------------------------------------------------------------------- @@ -84,6 +90,48 @@ ;; Operations as workspace events ;; -------------------------------------------------------------------------- +(declare current-file) + +(defn- variant-action-events + "The workspace events of the `n/VariantAction` `op`." + [{:keys [action params]} situation] + (let [id #(tm/target-shape-id situation %) + member #(n/member-component situation (:set-name params) (:member params)) + select #(dws/select-shapes (into (d/ordered-set) (map id) %))] + (case action + :transform + [(dwv/transform-in-variant (id (:target params)))] + + :combine + (if (:selected? params) + [(select (:targets params)) + (dwv/combine-selected-as-variants {:trigger "workspace:context-menu"})] + [(dwv/combine-as-variants (mapv id (:targets params)) {:trigger "workspace:context-menu"})]) + + :rename + [(dwv/rename-comp-or-variant-and-main (:id (n/component-of situation (:target params))) + (:name params))] + + :rename-in-layers + (let [{:keys [id variant-id variant-properties]} (member)] + [(dwv/update-properties-names-and-values + id variant-id variant-properties + (mapv (fn [[name value]] {:name name :value value}) (:properties params)))]) + + :remove-empty + [(dwv/remove-empty-properties (n/variant-set-id situation (:set-name params)))] + + :error + [(if-let [value (:value params)] + (dwv/update-error (:id (member)) value) + (dwv/update-error (:id (member))))] + + :shortcut + [(select (:targets params)) + (case (:kind params) + :create-component (dwv/add-component-or-variant) + :duplicate (dwv/duplicate-or-add-variant))]))) + (defn op->events "The workspace events a user action dispatches for the comp operation `op`, built from `situation` and from the same helpers the common node uses." @@ -144,10 +192,44 @@ {:with-objects? true})]) (instance? n/SwitchVariant op) - (let [{:keys [target value]} op - head-id (tm/target-shape-id situation target) + (let [head-id (tm/target-shape-id situation (:target op)) shape (tm/shape-by-id situation head-id)] - [(dwv/variants-switch {:shapes [shape] :pos 0 :val value})]) + [(dwv/variants-switch {:shapes [shape] + :pos (n/switch-pos situation op) + :val (n/switch-value situation op)})]) + + (instance? n/ApplyToken op) + (let [data (:data (current-file)) + token (-> (cfo/get-tokens-in-active-sets (cfo/get-tokens-status data) + (cfo/get-tokens-lib data)) + (get (:token-name op)))] + [(dwta/apply-token {:shape-ids [(tm/target-shape-id situation (:target op))] + :attributes n/radius-attrs + :token token + :on-update-shape dwta/update-shape-radius})]) + + (instance? n/UnapplyToken op) + [(dwta/unapply-token {:shape-ids [(tm/target-shape-id situation (:target op))] + :attributes n/radius-attrs + :token-name (:token-name op)})] + + (instance? n/VariantAction op) + (variant-action-events op situation) + + (instance? n/AddVariant op) + [(dwv/add-new-variant (:id (n/member-root situation (:set-name op) (:member op))))] + + (instance? n/EditVariantProperty op) + ;; the design tab's variant property edits + (let [[edit & args] (n/variant-property-call situation op)] + [(case edit + :add (let [[variant-id opts] args] + (dwv/add-new-property variant-id opts)) + :remove (apply dwv/remove-property args) + :rename (let [[variant-id pos name] args] + (dwv/update-property-name variant-id pos name {:trigger "workspace:design-tab"})) + :reorder (apply dwv/reorder-variant-poperties args) + :set-value (apply dwv/update-property-value args))]) (instance? n/Detach op) [(dwl/detach-component (tm/target-shape-id situation (:target op)))] @@ -167,6 +249,16 @@ [(dws/duplicate-shapes #{(tm/target-shape-id situation (:target op))} :change-selection? false)] + (instance? n/PasteToRoot op) + ;; the clipboard's copy of the shape, pasted with the root selected + (let [file (current-file) + page (get-in file [:data :pages-index (:current-page-id @st/state)]) + data (thp/simulate-copy-shape #{(tm/target-shape-id situation (:target op))} + (:objects page) {(:id file) file} page file + #{"components/v2"} 46)] + [(dws/select-shape uuid/zero) + (dw/paste-shapes data)]) + (instance? n/NestCopy op) (let [parent-id (tm/target-shape-id situation (:into op)) copy-id (tm/target-shape-id situation (:copy op)) @@ -268,18 +360,39 @@ :undo-changes (:undo-changes changes)} opts)))) +(defn- await-ready + "A promise that resolves with true once `ready?` holds, polling, or with + false after `timeout-ms`." + [ready? timeout-ms] + (let [start (js/Date.now)] + (js/Promise. + (fn [resolve] + (letfn [(poll [] + (cond + (ready?) (resolve true) + (> (- (js/Date.now) start) timeout-ms) (resolve false) + :else (js/setTimeout poll 5)))] + (poll)))))) + (defn await-step "Emit `events` and return a promise of `:settled` once the pending work of `app.main.data.workspace.reflow` drains (component sync, layout and text reflow), as the plugin `waitForLayoutUpdate` waits; or of `{:timeout pending}` after `timeout-ms` (default `step-timeout-ms`). Work - must be opened while the events are processed." + must be opened while the events are processed; for events that commit + only after asynchronous work that opens none (token resolution), pass + `ready?`, which must hold before the pending work is awaited." ([events] (await-step events step-timeout-ms)) - ([events timeout-ms] + ([events timeout-ms] (await-step events timeout-ms nil)) + ([events timeout-ms ready?] (doseq [e events] (st/emit! e)) - (-> (pwrf/wait-for-layout-update nil timeout-ms) - (.then (constantly :settled)) - (.catch (fn [_] {:timeout (wrf/pending)}))))) + (-> (if ready? (await-ready ready? timeout-ms) (js/Promise.resolve true)) + (.then (fn [ready] + (if ready + (-> (pwrf/wait-for-layout-update nil timeout-ms) + (.then (constantly :settled)) + (.catch (fn [_] {:timeout (wrf/pending)}))) + {:timeout {:not-ready (wrf/pending)}})))))) (defn- describe-pending "The pending work map with the ids replaced by their test labels, if any." @@ -321,6 +434,20 @@ [op situation] (op->events (unwrap op) situation)) +(defn- live-shape + "The shape `id` of the current page of the live file." + [id] + (get-in (current-file) [:data :pages-index (:current-page-id @st/state) :objects id])) + +(defn- op-ready + "For the op unit `op` whose events commit only after asynchronous work that + opens no pending work, a predicate of when they have committed; else nil." + [op situation] + (let [op (unwrap op)] + (when (instance? n/ApplyToken op) + (let [id (tm/target-shape-id situation (:target op))] + #(= (:token-name op) (get-in (live-shape id) [:applied-tokens :r1])))))) + (defn- install-file-event "An event that makes `file` the current file in the store, the result of a `sync-op?` operation." @@ -475,7 +602,7 @@ index-before (undo-index)] (if (sync-op? op) (run-ops (run-sync-op situation op) (rest ops) k) - (.then (await-step (op-events op situation)) + (.then (await-step (op-events op situation) step-timeout-ms (op-ready op situation)) (fn [result] (if (= :settled result) (let [situation (record-op situation op)] @@ -575,13 +702,15 @@ "Run every variant of `case-map` through the frontend, apply `asserter` (default the case map's `:asserter`) to each result and check its undo/redo round trip (`app.common.test-helpers.composable.comp.undo-check`). Calls the - async test's `done` at the end. RPC calls are mocked and `rx/timer` fires - at once, for the delayed RPC of the library update." + async test's `done` at the end. RPC calls are mocked, `rx/timer` fires at + once, for the delayed RPC of the library update, and DOM lookups find + nothing, for the delayed focus after adding a variant." ([done case-map] (check done case-map (:asserter case-map))) ([done {:keys [setup operation] :as case-map} asserter] (mock/with-mocks - {rp/cmd! mock/rpc-cmd-mock - rx/timer mock/timer-mock} + {rp/cmd! mock/rpc-cmd-mock + rx/timer mock/timer-mock + dom/get-element (constantly nil)} (fn [inner-done] (let [variants (tm/enumerate operation)] (letfn [(run-next [vs] diff --git a/frontend/test/frontend_tests/data/workspace_variants_test.cljs b/frontend/test/frontend_tests/data/workspace_variants_test.cljs new file mode 100644 index 0000000000..f1f607bc21 --- /dev/null +++ b/frontend/test/frontend_tests/data/workspace_variants_test.cljs @@ -0,0 +1,207 @@ +;; 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.data.workspace-variants-test + "The checks the workspace runs before combining components as variants + and before a variant switch, and the branches of the variant events that + the composable cases (`frontend-tests.composable-tests.comp.sync-test`) + do not reach: a combine on another page, a switch that would nest a + component in itself, the shortcuts with no variant selected and the + rename of a plain component." + (:require + [app.common.data :as d] + [app.common.test-helpers.components :as cthc] + [app.common.test-helpers.compositions :as ctho] + [app.common.test-helpers.files :as cthf] + [app.common.test-helpers.ids-map :as cthi] + [app.common.test-helpers.shapes :as cths] + [app.common.test-helpers.variants :as cthv] + [app.common.types.components-list :as ctkl] + [app.common.uuid :as uuid] + [app.main.data.common :as dcm] + [app.main.data.workspace.selection :as dws] + [app.main.data.workspace.undo :as dwu] + [app.main.data.workspace.variants :as dwv] + [beicon.v2.core :as rx] + [cljs.test :as t :include-macros true] + [frontend-tests.helpers.mock :as mock] + [frontend-tests.helpers.state :as ths] + [potok.v2.core :as ptk])) + +(t/use-fixtures :each {:before cthi/reset-idmap!}) + +(defn- setup-file + "A variant set (members :m01 and :m02, each with a child), a copy of :m01, + two plain components and a copy of the first." + [] + (-> (cthf/sample-file :file1) + (cthv/add-variant-with-child :v01 :c01 :m01 :c02 :m02 :m01-child :m02-child) + (cthc/instantiate-component :c01 :copy01 :children-labels [:copy01-child]) + (ctho/add-simple-component :plain1 :plain1-root :plain1-child) + (ctho/add-simple-component :plain2 :plain2-root :plain2-child) + (cthc/instantiate-component :plain1 :plain1-copy))) + +(defn- state-of + [file] + @(ths/setup-store file)) + +(t/deftest valid-components-for-variants + (let [file (setup-file) + state (state-of file) + page-id (:current-page-id state) + valid? #(dwv/valid-components-for-variants? state page-id (mapv cthi/id %))] + (t/testing "two plain main roots" + (t/is (valid? [:plain1-root :plain2-root]))) + (t/testing "fewer than two distinct components" + (t/is (not (valid? [:plain1-root]))) + (t/is (not (valid? [:plain1-root :plain1-root])))) + (t/testing "a variant main" + (t/is (not (valid? [:plain1-root :m01])))) + (t/testing "a copy" + (t/is (not (valid? [:plain1-root :plain1-copy])))) + (t/testing "a page that is not the current one" + (t/is (not (dwv/valid-components-for-variants? + state (uuid/next) [(cthi/id :plain1-root) (cthi/id :plain2-root)])))))) + +(t/deftest valid-variant-switch + (let [file (setup-file) + state (state-of file) + valid? (fn [label pos val] + (dwv/valid-variant-switch? state (cths/get-shape file label) pos val))] + (t/testing "a variant copy head and a value some member holds" + (t/is (valid? :copy01 0 "Value2")) + (t/is (valid? :copy01 0 "Value1"))) + (t/testing "a value no member holds" + (t/is (not (valid? :copy01 0 "Value3")))) + (t/testing "a position outside the properties" + (t/is (not (valid? :copy01 1 "Value2"))) + (t/is (not (valid? :copy01 -1 "Value2")))) + (t/testing "a value that is not a string" + (t/is (not (valid? :copy01 0 2)))) + (t/testing "not a variant copy head" + (t/is (not (valid? :m01 0 "Value2"))) + (t/is (not (valid? :copy01-child 0 "Value2"))) + (t/is (not (valid? :plain1-copy 0 "Value2")))))) + +(defn- all-transactions-committed + "A `run-store` stopper: the first undo commit after which no transaction + is pending, for events that commit their transaction asynchronously." + [store] + (fn [stream] + (->> stream + (rx/filter (ptk/type? ::dwu/commit-undo-transaction)) + (rx/filter #(empty? (get-in @store [:workspace-undo :transactions-pending])))))) + +(defn- go-to-page + "Stands in for `dcm/go-to-workspace`, which needs the router: makes + `page-id` the current page and announces it as initialized." + [& {:keys [page-id]}] + (ptk/reify ::go-to-page + ptk/UpdateEvent + (update [_ state] + (assoc state :current-page-id page-id)) + + ptk/WatchEvent + (watch [_ _ _] + (rx/of (ptk/data-event :app.main.data.workspace.pages/initialize-page {}))))) + +(t/deftest combine-on-another-page + (t/async + done + (mock/with-mocks + {dcm/go-to-workspace go-to-page} + (fn [inner-done] + (let [file (cthf/sample-file :file1) + page-1 (cthf/current-page-id file) + file (-> file + (cthf/add-sample-page :page2) + (ctho/add-simple-component :plain1 :plain1-root :plain1-child) + (ctho/add-simple-component :plain2 :plain2-root :plain2-child) + (vary-meta assoc :current-page-id page-1)) + store (ths/setup-store file) + ids [(cthi/id :plain1-root) (cthi/id :plain2-root)]] + (ths/run-store + store inner-done + [(dwv/combine-as-variants ids {:page-id (cthi/id :page2) + :trigger "plugin:combine-as-variants"})] + (fn [state] + (let [data (:data (ths/get-file-from-state state)) + c1 (ctkl/get-component data (cthi/id :plain1)) + c2 (ctkl/get-component data (cthi/id :plain2))] + (t/is (= (cthi/id :page2) (:current-page-id state))) + (t/is (some? (:variant-id c1))) + (t/is (= (:variant-id c1) (:variant-id c2))))) + (all-transactions-committed store)))) + done))) + +(t/deftest switch-into-a-nesting-loop + (t/async + done + (let [file (-> (cthf/sample-file :file1) + (cthv/add-variant :v01 :c01 :m01 :c02 :m02) + (cthc/instantiate-component :c01 :nested :parent-label :m02)) + store (ths/setup-store file) + errors (atom 0) + params (with-meta {:shapes [(cths/get-shape file :nested)] :pos 0 :val "Value2"} + {:on-error #(swap! errors inc)})] + (ths/run-store + store done + [(dwv/variants-switch params)] + (fn [state] + (t/is (= 1 @errors)) + (t/is (= (cthi/id :c01) + (:component-id (cths/get-shape (ths/get-file-from-state state) :nested))))))))) + +(defn- object-count + [file] + (count (:objects (cthf/current-page file)))) + +(defn- run-selected + "Run `event` on a store for `file` with the shapes `labels` selected, then + `check` the resulting file." + [done file labels event check] + (ths/run-store + (ths/setup-store file) done + [(dws/select-shapes (into (d/ordered-set) (map cthi/id) labels)) event] + #(check (ths/get-file-from-state %)))) + +(defn- file-with-a-rect + [] + (-> (cthf/sample-file :file1) + (cths/add-sample-shape :rect))) + +(t/deftest duplicate-shortcut-with-nothing-selected + (t/async + done + (let [file (file-with-a-rect)] + (run-selected done file [] (dwv/duplicate-or-add-variant) + #(t/is (= (object-count file) (object-count %))))))) + +(t/deftest duplicate-shortcut-on-a-plain-shape + (t/async + done + (let [file (file-with-a-rect)] + (run-selected done file [:rect] (dwv/duplicate-or-add-variant) + #(t/is (= (inc (object-count file)) (object-count %))))))) + +(t/deftest create-component-shortcut-on-a-plain-shape + (t/async + done + (run-selected done (file-with-a-rect) [:rect] (dwv/add-component-or-variant) + #(t/is (= 1 (count (ctkl/components-seq (:data %)))))))) + +(t/deftest rename-of-a-plain-component + (t/async + done + (let [file (-> (cthf/sample-file :file1) + (ctho/add-simple-component :plain1 :plain1-root :plain1-child))] + (ths/run-store + (ths/setup-store file) done + [(dwv/rename-comp-or-variant-and-main (cthi/id :plain1) "Renamed")] + (fn [state] + (let [file' (ths/get-file-from-state state)] + (t/is (= "Renamed" (:name (ctkl/get-component (:data file') (cthi/id :plain1))))) + (t/is (= "Renamed" (:name (cths/get-shape file' :plain1-root)))))))))) diff --git a/frontend/test/frontend_tests/runner.cljs b/frontend/test/frontend_tests/runner.cljs index d043d166f1..b3d5c4c2b6 100644 --- a/frontend/test/frontend_tests/runner.cljs +++ b/frontend/test/frontend_tests/runner.cljs @@ -45,6 +45,8 @@ [frontend-tests.data.workspace-thumbnails-test] [frontend-tests.data.workspace-undo-test] [frontend-tests.data.workspace-variant-rename-test] + [frontend-tests.data.workspace-variant-switch-wasm-test] + [frontend-tests.data.workspace-variants-test] [frontend-tests.data.workspace-versions-test] [frontend-tests.debug-logging-test] [frontend-tests.errors-governor-test] @@ -218,6 +220,8 @@ 'frontend-tests.data.workspace-thumbnails-test 'frontend-tests.data.workspace-undo-test 'frontend-tests.data.workspace-variant-rename-test + 'frontend-tests.data.workspace-variant-switch-wasm-test + 'frontend-tests.data.workspace-variants-test 'frontend-tests.data.workspace-versions-test 'frontend-tests.debug-logging-test 'frontend-tests.errors-governor-test