github/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2026-10-29 14:00:37 +00:00
Code Issues Packages Projects Releases Wiki Activity

✨ Test variant events, token sync and switch overrides

Browse Source 
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.
This commit is contained in:
alonso.torres 2026-10-10 12:49:36 +02:00
parent 356890a182
commit 0fe4a43009
10 changed files with 1571 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
.serena/memories/frontend/composable-component-tests.md
View File

@ -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

491
common/src/app/common/test_helpers/composable/comp/cases.cljc
View File

@ -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

489
common/src/app/common/test_helpers/composable/comp/nodes.cljc
View File

@ -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))

54
common/test/common_tests/logic/comp_creation_test.cljc
View File

@ -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)

12
common/test/common_tests/logic/composable_sync_test.cljc
View File

@ -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)))

129
common/test/common_tests/logic/variants_switch_test.cljc
View File

@ -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)))))

27
frontend/test/frontend_tests/composable_tests/comp/sync_test.cljs
View File

@ -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))))

155
frontend/test/frontend_tests/composable_tests/interpreter.cljs
View File

@ -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]

207
frontend/test/frontend_tests/data/workspace_variants_test.cljs Normal file
View File

@ -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))))))))))

4
frontend/test/frontend_tests/runner.cljs
View File

@ -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