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

✨ Add operations and cases to the composable component suites

Browse Source 
The composable runners could edit, add, remove and move children, swap
and switch, but not run the other component operations. New nodes run
each one through the production generator in the pure runner and the
real event in the frontend interpreter:
- Detach, UpdateMain, DeleteComponent and RestoreComponent;
- Duplicate, and NestCopy (a copy moved into a main);
- EditText, with the automatic rename the text editor applies;
- MoveShape (frontend only, through the sidebar) and MoveToCell;
- swap-shape and reset on any copy head;
- Undo with a step count, and an edit undone before its sync (frontend
  only).

New cases, all with the undo/redo round trip:
- Q, R, S, T, U: detach, update main, delete and restore, duplicate
  and nest, at nesting depths 0 to 2;
- V, W, X: a new edit after undo, three undos over nested cascades, an
  undo before the edit's sync;
- Y: text overrides against main text edits;
- Z: a main child move;
- AA to AF: swap outcomes on values and structure, and the grid cell
  of a swapped child;
- AG, AH, AI: the plugin suite's slot alignment cases.

The plugin suite gets OpDetach, OpSwap and OpReset, names that keep
the roles of two nestable components apart, Assert.knownFailure, and
ports of cases Q, AA, AB and K's reset.

Supporting changes: nodes can record what they created
(IAppliedResult); create-component takes a size, since with 0.01
frames the frontend reflows split undo entries at points that depend
on timing (F43); the interpreter ends the text measurement headless,
so text steps settle; tm/known-failure pins the wrong value a known
bug gives in a case assertion; the interpreter no longer moves its
undo baseline after a skipped optional, which cut the end-of-variant
round trip short.

Confirmed and pinned: F12 (resetting a nested swap clears the top
copy's overrides), F27 (the automatic text rename touches
:name-group), F29 (a second switch loses an override) and F44 (a
swapped grid child misses the main's cell changes). F43 also shows
through a plain sync at depth 2 (case Q).
This commit is contained in:
alonso.torres 2026-10-09 16:07:59 +02:00
parent 820cbfee38
commit 2cae81f588
22 changed files with 2225 additions and 72 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -93,14 +93,14 @@ Two pure runners (no store, JVM + CLJS):
throws if a `:user` op records nothing or another kind records changes. After a user op the
runner syncs to a fixpoint (`ch/components-changed` + `generate-sync-file-changes`, one pass
per cascade level, like the frontend watcher) and pushes op + syncs as one undo group.
`n/undo` reverts the latest group and moves it to a redo stack; `n/redo` applies it again
`n/undo` (`(n/undo k)` for k groups) reverts the latest group and moves it to a redo stack; `n/redo` applies it again
(interpreter: `dwu/redo`); neither re-syncs. A user op that pushes a group empties the redo
stack; one that changed nothing keeps it. The runner validates the file (against the
situation's files) once settled: after the sync fixpoint and after an undo group; never
between cascade passes, where an outer copy still points at the component its main dropped
(`:component-id-mismatch`), nor with `{:sync? false}`. Assembly ops (create/instantiate/nest/variant
container): no sync, no undo group. `ResetCopyInstance` is a user op here (sync + undo),
unlike the interpreter (file install). `{:sync? false}` disables sync. `Rotate`/`ChangeHeight`
unlike the interpreter (file install). `{:sync? false}` disables sync. `Rotate`/`ChangeHeight`/`MoveShape`
are `:frontend-only` and throw `::runner/frontend-only` (the placement step is frontend code). Swap and switch nodes use the production
`clv/generate-component-swap-in-place` (+ `clv/find-switch-target` for switch), the same code the
frontend events call. Not modelled: the `:modified-at` bump, and the swap/switch event follow-ups
@ -126,18 +126,44 @@ Two pure runners (no store, JVM + CLJS):
changes only when the failure is understood, and the mark goes only in the fix commit. The interpreter runs the same round trip on every `:user` and
`:frontend-only` event step through the real `dwu/undo`/`dwu/redo`, and also checks the
workspace undo index (`:undo-index`/`:redo-index` phases): a step must add exactly one undo
entry or group. File installs (assembly ops, reset) are its baselines. The interpreter
entry or group. File installs (assembly ops, reset) are its baselines; a skipped optional and an inline `Test` are not. The interpreter
empties `:workspace-undo` per variant. Frontend snapshots drop `:position-data` under WASM.
Undo groups get lost in derived work: `initialize-shape-layout` buffers `:layout/update`
without its `:undo-group` (F43), so a swap's reflow lands in entries of its own. Match
steps by node identity, never by record type or rendered name: `n/MoveChild` does not resolve
through an alias on the JVM, and the JS test build strips record names (transcripts show
`node`).
- The interpreter records an event op's application as the op's own fields, not what its
`apply-to` would record, so an accessor that must work in both runners reads the file
structure (e.g. `level-rect`, `n/deleted-component-id`), never the node's recorded data.
Shapes off the current page: `tm/find-shape`, `tm/role-shape-in-file` (setup
`simple-component-with-copies-on-two-pages`). When an accessor needs what an op created
(e.g. the duplicate's head), the node implements `n/IAppliedResult` (read from the file
before and after); the pure node and the interpreter's `record-op` both record it.
- `n/create-component` builds 0.01-sized frames unless given `:size`. The transform math
writes float noise into those sizes, so frontend syncs emit reflows whose commits lose
their undo group (F43) at timing-dependent points (`initialize-shape-layout` buffers
`:layout/update` in 100 ms windows): undo pins over such reflows can be nondeterministic.
New cases that are not about geometry pass `:size` (nesting sizes the outer frames too).
- Case assertions a known bug breaks use `tm/known-failure bug expected pinned actual`: a
strict expected failure at assertion level (passes only while `actual` is the pinned wrong
value). The undo-check marks cover only round-trip failures.
- Text: `n/edit-text` (`:text`/`:font-size` of the first span) with `n/text-edit-commit`, which
includes the editor's automatic rename when the name was generated from the old content;
setup `simple-text-component-with-copy` (text named after its content).
- The interpreter unwraps nested choices (`(tm/optional (tm/one-of …))`); `(optional
(in-sequence …))` is still not flattened.
- 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` (a file install
in the interpreter, like `reset-copy-instance`). `n/nested-head-in name` 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.
- `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..P;
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) 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; 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`) are the flagship pattern — read them before
writing a new sweep.
**Scenario lineage model** (behind the sweeps): scenario ops track named component lineages as
@ -155,9 +181,9 @@ nestings do not propagate between each other.
(undo stack, layout, text reflow, WASM text measurement; stopped by `dw/finalize-edit-watchers`,
replaced when started again) and `dwl/watch-library-changes` (component + token watchers;
replaced when started again) — then maps
event-ops to REAL workspace events (`dwsh/update-shapes`, `dwl/component-swap`,
event-ops to REAL workspace events (`dwsh/update-shapes`, `dwl/component-swap` (also `n/swap-shape`, any copy head),
`dwv/variants-switch`, `dwt/increase-rotation` — which runs the `check-delta` placement
classification — `dwt/update-dimensions`, `dwu/undo`, `dwl/sync-file`, …) and runs sync-ops'
classification — `dwt/update-dimensions`, `dwl/detach-component`, `dwl/update-component-sync`, `dwl/delete-component`, `dwl/restore-component`, `dws/duplicate-shapes`, `dwsh/relocate-shapes` (nest-copy), `dwtx/v2-update-text-shape-content` (edit-text, the editor's on-blur commit with its automatic rename), `dwu/undo`, `dwl/sync-file`, …) and runs sync-ops'
`apply-to` against the live store file; each event step goes through `ftm/await-step`, which
resolves once `wrf/settled nil` (the watcher's `:sync-file` wait, opened for EVERY local commit,
plus the sync and layout/text reflow it starts) or reports `{:timeout pending}` after 2s; a
@ -180,11 +206,14 @@ Running (frontend): `cd frontend && pnpm run build:test`, then
persistence, no viewport. Edit-reacting subscriptions come from the shared events above; a NEW
edit-reacting subscription belongs inside `initialize-edit-watchers` (or
`watch-library-changes`), never wired inline in `initialize-workspace`, or the harness silently
misses it. Headless there is no DOM text measurement, so `:text/reflow` work never drains.
misses it. Headless there is no DOM text measurement: `install!` starts
`headless-text-measurement`, a stand-in that opens and closes a `:text-measure` task for each
`:text/reflow` (geometry and `:position-data` unchanged), so text steps settle. It does not
reproduce what the real measurement commits (F37: `commit-position-data`).
**Caveats:** inline `Test` exceptions are UNCAUGHT on the frontend (crash the runner — assert in
the trailing asserter). `(optional (in-sequence …))` is not flattened for the interpreter — use
independent optionals. The Serena/clj-kondo cache for `nodes.cljc` goes stale (phantom symbols) —
independent optionals (nested choices are fine). The Serena/clj-kondo cache for `nodes.cljc` goes stale (phantom symbols) —
trust the build. Cross-namespace global-state leaks land in this suite first; suspect them before
the framework on inexplicable full-run-only failures. Case H's `sync-file` schedules a delayed RPC
that fails headless (benign; absorbed by per-op grace).
@ -215,6 +244,14 @@ Distinguishing abstractions (the OOP articulation of the shared principles):
(CI adapter) are three thin consumers.
- Cases live in `src/composable-tests/cases/` as `case<Identifier>.ts` (e.g. `MainEditSyncs` — the
sweep that found #10109).
- Roles are bound BY NAME in the situation: two foundation ops with the same role names overwrite
each other. `OpCreateNestableComponent(strategy, name)` prefixes its roles with `name`; give
every extra lineage in a case a name.
- `OpDetach`/`OpSwap`/`OpReset` wait for pending propagation before acting (a script could
otherwise act inside the sync window, which no user can). `swapComponent` keeps touched (F33).
The suite pins published `@penpot/plugin-types` 1.4.2, which lacks `resetOverrides` (typed cast).
- Known bugs: `Assert.knownFailure(bug, actual, expected, pinned, equals)`, the counterpart of
`tm/known-failure`.
- Panel checkboxes carry stable DOM ids (case identifier / `Identifier-N` composites) for remote
control via Playwright; recipe in the README.

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

@ -33,10 +33,29 @@
L — the swap sweep: swaps at any subset of nesting levels.
M — the variant-switch sweep: case L with variant switches.
O — a variant switch keeps a copy override only where the mains agree.
Q — a detached copy's nested copies stay linked, one level up.
R — update main pushes a copy override; the other copies follow.
S — copies of a deleted component keep their data; restore syncs again.
T — a duplicated copy keeps the source's overrides and stays linked.
U — a copy moved into a main reaches that main's copies.
V — a new edit after an undo empties the redo stack.
W — one undo node undoes several steps over nested cascades.
X — an undo committed before the edit's sync leaves copies unchanged
(frontend only).
Y — a text override merges with a main text change per subgroup.
Z — a move of a main child reaches the copies (frontend only).
AA..AE — swap outcomes: a copy's swap survives main changes; reset of a
nested swap; switching twice; update main with a swapped child;
detach or duplicate of a swapped copy.
AF — a grid cell move in the main reaches a swapped copy child (F44).
AG — a main reorder keeps the copy's nested copies aligned.
AH, AI — a copy deleting a nested copy keeps the others aligned (AI also
reflows, frontend only).
N — geometry sync with rotated instances (needs the frontend placement step).
Rotation — a touched copy child survives a main rotation (frontend only too)."
(:require
[app.common.data :as d]
[app.common.files.helpers :as cfh]
[app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt]
[app.common.geom.rect :as grc]
@ -47,6 +66,7 @@
[app.common.test-helpers.files :as thf]
[app.common.types.component :as ctk]
[app.common.types.shape-tree :as ctst]
[app.common.types.shape.layout :as ctl]
[clojure.test :as t]))
(def ^:private red "#ff0000")
@ -427,6 +447,563 @@
(t/is (= red (-> rect :fills first :fill-color)))
(t/is (not (contains? (:touched rect) :fill-group)))))))}))
(defn detach-keeps-nested-copies-linked
"Case Q. A copy at nesting depth 0, 1 or 2 is detached, then the remote
(deepest) main changes. Optionally the copy's near main overrides the rect
before the detach. At depth 0 the rect is detached: it keeps the value it
had and loses its links. Deeper, the rect lies in a first-level nested
copy, which stays a copy one level up and inherits the near main's touched
groups (`mem:common/component-sync-contract`): with the near main's
override it keeps that value and is touched; otherwise it follows the
remote main."
[]
(let [m "main"
nest-1 (n/make-nested-component m)
nest-2 (n/make-nested-component m)
change-main (n/change-property (n/main-rect-of m) :fills green)
change-remote (n/change-property (n/remote-rect-of m) :fills blue)
;; at depth 2 the sync of the remote change reflows the nested
;; frames, and the reflow lands in an undo entry of its own (F43)
reflow-mark (fn [main? left entries]
{:bug "F43"
:fails {:undo left
:undo-index #{[:undo-index entries]}}
:op change-remote
:runners #{:frontend}
:when #(and (tm/applied? % nest-1)
(tm/applied? % nest-2)
(= main? (tm/applied? % change-main)))})]
{:setup setup/empty-situation
:undo-check {:known-failures
[(reflow-mark true
#{[:object :sync-main-innercopy-0 :width]
[:object :sync-main-innercopy-0 :height]
[:object :sync-main-innercopy-0 :selrect]
[:object :sync-main-rect :fills]
[:object :unlabelled :fills]}
2)
(reflow-mark false
#{[:object :sync-main-innercopy-0 :width]
[:object :sync-main-innercopy-0 :height]
[:object :sync-main-innercopy-0 :selrect]
[:object :sync-main-innercopy-1 :width]
[:object :sync-main-innercopy-1 :height]
[:object :sync-main-innercopy-1 :selrect]
[:object :sync-main-copyhead-0 :width]
[:object :sync-main-copyhead-0 :height]
[:object :sync-main-copyhead-0 :selrect]
[:object :sync-main-rect :fills]
[:object :unlabelled :fills]}
3)]}
:operation (tm/in-sequence
[(n/create-component m red)
(tm/optional nest-1)
(tm/optional nest-2)
(n/instantiate-copy m)
(tm/optional change-main)
(n/detach (n/copy-head-of m))
change-remote])
:asserter (fn [s]
(let [rect (tm/shape-by-id s (n/lineage-copy-rect s m))
color (-> rect :fills first :fill-color)
nested? (or (tm/applied? s nest-1) (tm/applied? s nest-2))
main? (tm/applied? s change-main)]
(if nested?
(do
(t/is (some? (:shape-ref rect)))
(t/is (= (if main? green blue) color))
(t/is (= main? (contains? (:touched rect) :fill-group))))
(do
(t/is (nil? (:shape-ref rect)))
(t/is (nil? (:touched rect)))
(t/is (= (if main? green red) color))))))}))
(defn update-main-reaches-other-copies
"Case R. A component at nesting depth 0, 1 or 2 has two copies. The first
copy overrides its rect and pushes the override to the main (update
main); optionally the second copy overrides its rect first. The main rect
takes the pushed value, touched when it lies in a nested copy (it then
differs from its own near main). The first copy keeps the value with its
touched group cleared. The second copy keeps its own override, or follows
the main when it had none."
[]
(let [m "main"
nest-1 (n/make-nested-component m)
nest-2 (n/make-nested-component m)
other-override (n/change-property (n/nth-copy-rect-of m 1) :fills blue)]
{:setup setup/empty-situation
:operation (tm/in-sequence
[(n/create-component m red)
(tm/optional nest-1)
(tm/optional nest-2)
(n/instantiate-copy m)
(n/instantiate-copy m)
(tm/optional other-override)
(n/change-property (n/nth-copy-rect-of m 0) :fills green)
(n/update-main (n/nth-copy-head-of m 0))])
:asserter (fn [s]
(let [rect (fn [id] (tm/shape-by-id s id))
color (fn [shape] (-> shape :fills first :fill-color))
fill? (fn [shape] (contains? (:touched shape) :fill-group))
nested? (or (tm/applied? s nest-1) (tm/applied? s nest-2))
other? (tm/applied? s other-override)
main (rect (n/lineage-rect s m))
copy-0 (rect (n/lineage-nth-copy-rect s m 0))
copy-1 (rect (n/lineage-nth-copy-rect s m 1))]
(t/is (= green (color main)))
(t/is (= nested? (fill? main)))
(t/is (= green (color copy-0)))
(t/is (not (fill? copy-0)))
(t/is (= (if other? blue green) (color copy-1)))
(t/is (= other? (fill? copy-1)))))}))
(defn deleted-component-copies-sync-again-after-restore
"Case S. A component has a copy on its main's page and another on a second
page; optionally the first copy overrides its child. The main changes, the
component is deleted, then restored, and the main changes again. While it
is deleted, both copies keep their links and the values the first change
gave them. After the restore, the second change reaches both copies, except
where the first copy overrode its child."
[]
(let [override (n/change-property :copy-instance :fills green)
first-change (n/change-property :main-instance :fills red)
deletion (n/delete-component :main-root)
second-change (n/change-property :main-instance :fills blue)
color (fn [shape] (-> shape :fills first :fill-color))]
{:setup setup/simple-component-with-copies-on-two-pages
:operation (tm/in-sequence
[(tm/optional override)
first-change
deletion
(tm/test-that
(fn [s]
(let [copy (setup/copy-instance s)
other (setup/other-page-copy-instance s)]
(t/is (some? (:shape-ref copy)))
(t/is (some? (:shape-ref other)))
(t/is (= (if (tm/applied? s override) green red) (color copy)))
(t/is (= red (color other))))))
(n/restore-component deletion)
second-change])
:asserter (fn [s]
(let [copy (setup/copy-instance s)
other (setup/other-page-copy-instance s)]
(t/is (= blue (color (setup/main-instance s))))
(t/is (= (if (tm/applied? s override) green blue) (color copy)))
(t/is (= blue (color other)))
(t/is (nil? (:touched other)))))}))
(defn duplicated-copy-keeps-overrides-and-link
"Case T. A copy at nesting depth 0, 1 or 2 is duplicated, optionally after
overriding its rect, and then the main changes. The duplicate keeps the
source's values and touched groups (`mem:common/component-sync-contract`)
and stays linked: the main change reaches it unless the rect was
overridden, exactly as it reaches the source copy."
[]
(let [m "main"
override (n/change-property (n/copy-rect-of m) :fills green)
duplication (n/duplicate (n/copy-head-of m))
change-main (n/change-property (n/main-rect-of m) :fills blue)]
{:setup setup/empty-situation
:operation (tm/in-sequence
[(n/create-component m red)
(tm/optional (n/make-nested-component m))
(tm/optional (n/make-nested-component m))
(n/instantiate-copy m)
(tm/optional override)
duplication
change-main])
:asserter (fn [s]
(let [head ((n/duplicate-head-of duplication) s)
dup-rect (tm/shape-by-id s (n/corresponding-shape-id s head (n/lineage-rect s m)))
copy-rect (tm/shape-by-id s (n/lineage-copy-rect s m))
expected (if (tm/applied? s override) green blue)]
(t/is (some? (:shape-ref dup-rect)))
(t/is (= expected (-> dup-rect :fills first :fill-color)))
(t/is (= (:touched copy-rect) (:touched dup-rect)))
(t/is (= expected (-> copy-rect :fills first :fill-color)))))}))
(defn nested-copy-reaches-copies-of-the-receiving-main
"Case U. A copy of an inner component is moved into the main of an outer
component that already has a copy (nest copy, a user action). The outer
copy gets a nested copy of the inner component. Optionally that nested
copy overrides its rect; then the inner main changes. The moved copy
follows the inner main, and so does the outer copy's nested copy, unless
it overrode the rect."
[]
(let [outer "outer"
inner "inner"
;; the image, in the outer copy, of the inner copy moved into the main
nested-rect (fn [s]
(n/corresponding-shape-id s
((n/copy-head-of outer) s)
(n/lineage-copy-rect s inner)))
override (n/change-property nested-rect :fills green)
change-inner (n/change-property (n/main-rect-of inner) :fills blue)]
{:setup setup/empty-situation
:operation (tm/in-sequence
[(n/create-component outer red :size 100)
(n/create-component inner base-color :size 40)
(n/instantiate-copy outer)
(n/instantiate-copy inner)
(n/nest-copy (n/copy-head-of inner) (n/main-head-of outer))
(tm/optional override)
change-inner])
:asserter (fn [s]
(let [moved (tm/shape-by-id s (n/lineage-copy-rect s inner))
nested (tm/shape-by-id s (nested-rect s))]
(t/is (= blue (-> moved :fills first :fill-color)))
(t/is (nil? (:touched moved)))
(if (tm/applied? s override)
(do
(t/is (= green (-> nested :fills first :fill-color)))
(t/is (contains? (:touched nested) :fill-group)))
(do
(t/is (= blue (-> nested :fills first :fill-color)))
(t/is (nil? (:touched nested)))))))}))
(defn new-edit-after-undo-clears-redo
"Case V. An edit to the main is undone, a second edit is made and undone
too, and then redo runs twice. The second edit emptied the redo stack, so
the first redo applies the second edit with its propagation and the second
redo has nothing left to apply: main and copy show the second edit, and
the copy is untouched."
[]
(let [first-edit (n/change-property :main-instance :fills red)
second-edit (n/change-property :main-instance :fills green)]
{:setup setup/simple-component-with-labeled-copy
:operation (tm/in-sequence [first-edit (n/undo) second-edit (n/undo) (n/redo) (n/redo)])
:asserter (fn [s]
(let [copy (setup/copy-instance s)]
(t/is (n/has-property-of second-edit (setup/main-instance s)))
(t/is (n/has-property-of second-edit copy))
(t/is (nil? (:touched copy)))))}))
(defn undo-several-steps-over-nested-cascades
"Case W. At nesting depth 0, 1 or 2, the remote main, the main and the copy
each change their rect (the remote change cascades through every level),
then a single undo node undoes the three steps. Every rect is back to its
first colour and no rect is touched. The components have a real size:
with the minimal one, the frontend reflows after the remote change land in
undo entries of their own (F43), so three undos stop short."
[]
(let [m "main"
rect (fn [s id] (tm/shape-by-id s id))
colour (fn [shape] (-> shape :fills first :fill-color))]
{:setup setup/empty-situation
:operation (tm/in-sequence
[(n/create-component m red :size 100)
(tm/optional (n/make-nested-component m))
(tm/optional (n/make-nested-component m))
(n/instantiate-copy m)
(n/change-property (n/remote-rect-of m) :fills blue)
(n/change-property (n/main-rect-of m) :fills green)
(n/change-property (n/copy-rect-of m) :fills base-color)
(n/undo 3)])
:asserter (fn [s]
(doseq [id [((n/remote-rect-of m) s)
((n/main-rect-of m) s)
(n/lineage-copy-rect s m)]]
(t/is (= red (colour (rect s id))))
(t/is (empty? (:touched (rect s id))))))}))
(defn undo-before-sync-leaves-copies-unchanged
"Case X (frontend only). An edit to the main is undone in the same step, so
the undo commits while the edit's sync is still pending. The file is back
to its state before the edit: the main and its copy show the first value
and the copy is untouched."
[]
(let [original (n/change-property :main-instance :fills "#abcdef")]
{:setup setup/simple-component-with-labeled-copy
:operation (tm/in-sequence [(n/undo-before-sync :main-instance :fills red)])
:asserter (fn [s]
(let [copy (setup/copy-instance s)]
(t/is (n/has-property-of original (setup/main-instance s)))
(t/is (n/has-property-of original copy))
(t/is (nil? (:touched copy)))))}))
(defn text-override-merges-with-main-text-change
"Case Y. A main text changes its characters or its font size; before that,
optionally, its copy changes one of them. Sync merges per text subgroup: the
copy keeps what it edited and takes the rest from the main. So the copy
shows its own characters if it edited them, else the main's, and the same
for the font size. An edited copy has `:content-group` and the subgroup of
its edit touched; an unedited one has nothing touched. The text starts with
the name generated from its content, so an edit of its characters renames
it, an automatic rename that must not touch `:name-group` (decision (d))."
[]
(let [copy-edit (tm/one-of [(n/edit-text :copy-instance :text "copy text")
(n/edit-text :copy-instance :font-size "32")])
main-edit (tm/one-of [(n/edit-text :main-instance :text "main text")
(n/edit-text :main-instance :font-size "24")])
subgroup {:text :text-content-text :font-size :text-content-attribute}]
{:setup setup/simple-text-component-with-copy
:operation (tm/in-sequence [(tm/optional copy-edit) main-edit])
:asserter (fn [s]
(let [copy (setup/copy-instance s)
main (setup/main-instance s)
edited (tm/get-choice s copy-edit)]
(doseq [edit [:text :font-size]]
(t/is (= (if (= edit (:edit edited))
(:value edited)
(n/text-span-value main edit))
(n/text-span-value copy edit))
(str (name edit))))
(cond
(nil? edited)
(t/is (empty? (:touched copy)))
;; the automatic rename touches the name
(= :text (:edit edited))
(tm/known-failure "F27"
#{:content-group :text-content-text}
#{:content-group :text-content-text :name-group}
(:touched copy))
:else
(t/is (= #{:content-group (subgroup (:edit edited))}
(:touched copy))))))}))
;; ---------------------------------------------------------------------------
;; Swap outcomes
;;
;; What a swap must give, asserted on values and structure rather than on how
;; the swap is stored, so the cases hold across the swap model change of the
;; plan's Phase 2b. Each builds a component "main" whose main nests a copy of
;; it once (level 0), and a copy of that, whose nested head the case swaps.
;; Real sizes keep the frontend reflows out of the undo entries (F43).
;; ---------------------------------------------------------------------------
(defn- head-component
"The component id of the copy head bound to target fn `head`."
[s head]
(:component-id (tm/shape-by-id s (head s))))
(defn- head-rect-color
"The fill of 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 %)))
:fills first :fill-color)))
(defn copy-swap-survives-main-changes
"Case AA. A copy swaps its nested copy for another component. Optionally the
main then swaps its own nested copy for a third component, and optionally
the nested component's main changes. The copy's swap survives both: its
nested head stays an instance of the component it swapped to and shows its
rect."
[]
(let [m "main"
nested (n/nested-head-in m)
main-swap (n/swap-component m 0 "s2")
main-edit (n/change-property (n/remote-rect-of m) :fills blue)]
{:setup setup/empty-situation
:operation (tm/in-sequence
[(n/create-component m base-color :size 100)
(n/create-component "s1" red :size 100)
(n/create-component "s2" green :size 100)
(n/make-nested-component m)
(n/instantiate-copy m)
(n/swap-shape nested "s1")
(tm/optional main-swap)
(tm/optional main-edit)])
:asserter (fn [s]
(t/is (= (n/lineage-component-id s "s1") (head-component s nested)))
(t/is (= red (head-rect-color s nested))))}))
(defn reset-of-nested-swap-keeps-top-copy-overrides
"Case AB. A copy overrides its own root's opacity and swaps its nested copy;
then the nested copy is reset. The reset undoes the swap (the nested head
is an instance of the original component again) and changes nothing
outside the nested copy: the root keeps its opacity override and its
touched group (`mem:common/component-sync-contract`)."
[]
(let [m "main"
nested (n/nested-head-in m)]
{:setup setup/empty-situation
:operation (tm/in-sequence
[(n/create-component m base-color :size 100)
(n/create-component "s1" red :size 100)
(n/make-nested-component m)
(n/instantiate-copy m)
(n/change-property (n/copy-head-of m) :opacity 0.5)
(n/swap-shape nested "s1")
(n/reset nested)])
:asserter (fn [s]
(let [root (tm/shape-by-id s ((n/copy-head-of m) s))
;; the component the main's own nested copy instantiates
original (:component-id (tm/shape-by-id s (:nested-head (n/lineage-nesting s m 0))))]
(t/is (= original (head-component s nested)))
(t/is (= base-color (head-rect-color s nested)))
;; the reset climbs to the top copy and clears its overrides
(tm/known-failure "F12" 0.5 nil (:opacity root))
(tm/known-failure "F12" #{:layer-effects-group} nil (:touched root))))}))
(defn second-variant-switch-keeps-root-overrides
"Case AC. A copy nests a variant; the copy overrides the opacity of the
variant's root and switches it to a second member, then to a third. All
members agree on that opacity, so each switch carries the override
(decision (a)): the root ends as an instance of the third member with the
opacity override, touched."
[]
(let [m "main"
nested (n/nested-head-in m)
root (fn [s] (tm/shape-by-id s (nested s)))]
{: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] ["c" green]]
:size 100)
(n/make-nested-component-with-variant m "vset" "a")
(n/instantiate-copy m)
(n/change-property nested :opacity 0.5)
(n/switch-variant nested "b")
(tm/test-that (fn [s] (t/is (= 0.5 (:opacity (root s))) "after the first switch")))
(n/switch-variant nested "c")])
:asserter (fn [s]
(t/is (= (n/variant-member-component-id s "vset" "c") (head-component s nested)))
(t/is (= green (head-rect-color s nested)))
;; the second switch of a head with a swap slot loses its overrides
(tm/known-failure "F29" 0.5 nil (:opacity (root s)))
(tm/known-failure "F29" true false
(contains? (:touched (root s)) :layer-effects-group)))}))
(defn update-main-pushes-a-swapped-child
"Case AD. Of two copies, the first swaps its nested copy and pushes that to
the main (update main). Per the swap model of decision (h), update main
pushes the copy's component: the main's nested copy becomes an instance of
it, and so does the second copy's."
[]
(let [m "main"
main-nst (fn [s] (:nested-head (n/lineage-nesting s m 0)))
second (fn [s]
(let [objects (:objects (thf/current-page (tm/file s)))
head ((n/nth-copy-head-of m 1) s)]
(->> (cfh/get-immediate-children objects head)
(d/seek :component-id)
:id)))
nested (fn [s]
(let [objects (:objects (thf/current-page (tm/file s)))
head ((n/nth-copy-head-of m 0) s)]
(->> (cfh/get-immediate-children objects head)
(d/seek :component-id)
:id)))]
{:setup setup/empty-situation
:operation (tm/in-sequence
[(n/create-component m base-color :size 100)
(n/create-component "s1" red :size 100)
(n/make-nested-component m)
(n/instantiate-copy m)
(n/instantiate-copy m)
(n/swap-shape nested "s1")
(n/update-main (n/nth-copy-head-of m 0))])
:asserter (fn [s]
(let [s1 (n/lineage-component-id s "s1")
main-head (fn [s]
(let [objects (:objects (thf/current-page (tm/file s)))
outer (:main-head (n/lineage-nesting s m 0))]
(->> (cfh/get-immediate-children objects outer)
(d/seek :component-id)
:id)))]
(t/is (some? (main-nst s)))
(t/is (= s1 (head-component s main-head)))
(t/is (= s1 (head-component s second)))
(t/is (= red (head-rect-color s second)))))}))
(defn detached-or-duplicated-swapped-copy-follows-its-component
"Case AE. A copy swaps its nested copy; then the copy is detached, or
duplicated; then the main of the component it swapped to changes. Detached,
the nested copy becomes a top-level copy of that component; duplicated, the
duplicate's nested copy is one too. Either way it follows the change."
[]
(let [m "main"
nested (n/nested-head-in m)
duplication (n/duplicate (n/copy-head-of m))
dup-nested (fn [s]
(let [objects (:objects (thf/current-page (tm/file s)))]
(->> (cfh/get-immediate-children objects ((n/duplicate-head-of duplication) s))
(d/seek :component-id)
:id)))]
{:setup setup/empty-situation
:operation (tm/in-sequence
[(n/create-component m base-color :size 100)
(n/create-component "s1" red :size 100)
(n/make-nested-component m)
(n/instantiate-copy m)
(n/swap-shape nested "s1")
(tm/one-of [(n/detach (n/copy-head-of m)) duplication])
(n/change-property (n/main-rect-of "s1") :fills blue)])
:asserter (fn [s]
(let [s1 (n/lineage-component-id s "s1")]
(t/is (= s1 (head-component s nested)))
(t/is (= blue (head-rect-color s nested)))
(when (tm/applied? s duplication)
(t/is (= s1 (head-component s dup-nested)))
(t/is (= blue (head-rect-color s dup-nested))))))}))
(defn grid-cell-move-reaches-a-swapped-copy-child
"Case AF. A component's main is a grid board holding two nested copies;
optionally its copy swaps the first of them. Then the main moves that child
to the free third column. The copy's child at that position, swapped or
not, moves to the third column too."
[]
(let [swap (n/swap-shape :copy-child :other)
column (fn [s board child]
(:column (ctl/get-cell-by-shape-id (tm/role-shape s board)
(:id (tm/role-shape s child)))))]
{:setup setup/grid-component-with-copy
:operation (tm/in-sequence [(tm/optional swap)
(n/move-to-cell :main-root :main-child 1 3)])
:asserter (fn [s]
(t/is (= 3 (column s :main-root :main-child)))
(if (tm/applied? s swap)
;; the grid sync pairs a slotted child only by its raw slot
(tm/known-failure "F44" 3 1 (column s :copy-root :copy-child))
(t/is (= 3 (column s :copy-root :copy-child)))))}))
(defn main-reorder-keeps-copy-sub-heads-aligned
"Case AG (port of the plugin's MainReorderKeepsCopySlots). A main holds three
nested copies side by side; it moves the first to the end. The copy follows:
each of its children references the main's child at the same position."
[]
(let [move (n/move-child :sub1 :row-root 3)]
{:setup setup/component-with-sibling-instances
;; the undo of the sync's move leaves the copy children reordered
:undo-check {:known-failures [{:bug "F41"
:fails {:undo #{[:object :row-copy :shapes]}
:variant-undo #{[:object :row-copy :shapes]}}
:op move}]}
:operation (tm/in-sequence [move])
:asserter (fn [s]
(t/is (= [] (setup/misaligned-sub-heads s))))}))
(defn copy-sub-head-delete-keeps-others-aligned
"Case AH (port of the plugin's CopySubheadDeletePreservesSlots, without its
reflow). A grid main holds three nested copies; its copy optionally deletes
its first or its last one. The copy's remaining children still reference
the main's children at the same positions."
[]
{:setup #(setup/component-with-sibling-instances :grid)
:operation (tm/in-sequence [(tm/optional (tm/one-of [(n/remove-child :copy-sub1)
(n/remove-child :copy-sub3)]))])
:asserter (fn [s]
(t/is (= [] (setup/misaligned-sub-heads s))))})
(defn copy-sub-head-delete-and-reflow-keeps-others-aligned
"Case AI (frontend only; port of the plugin's CopySubheadDeletePreservesSlots
with its reflow). As case AH, then the copy root optionally changes height,
which reflows its grid. The copy's remaining children still reference the
main's children at the same positions."
[]
{:setup #(setup/component-with-sibling-instances :grid)
:operation (tm/in-sequence [(tm/optional (tm/one-of [(n/remove-child :copy-sub1)
(n/remove-child :copy-sub3)]))
(tm/optional (n/change-height :copy-root 500))])
:asserter (fn [s]
(t/is (= [] (setup/misaligned-sub-heads s))))})
(defn geometry-sync-with-rotated-instances
"Case N. Regression sweep for #10109, with #13267's semantics as its
complement: an instance root's transformation is inherited, overridable
@ -470,6 +1047,33 @@
(:touched copy-root)))
(t/is (nil? (:touched copy-child)))))}))
(defn main-child-move-reaches-copies
"Case Z (frontend only, like the other geometry operations). A child of the
main moves; optionally the copy moved its own child before. The copy child
keeps its offset from the copy root equal to the main child's from the main
root, so it follows the move, unless it moved itself: then it keeps its own
offset and its touched `:geometry-group`. The copy root stays untouched."
[]
(let [copy-move (n/move-shape :copy-instance 7 3)
main-move (n/move-shape :main-instance 10 5)
offset (fn [child root]
[(- (-> child :selrect :x) (-> root :selrect :x))
(- (-> child :selrect :y) (-> root :selrect :y))])]
{:setup setup/simple-component-with-labeled-copy
:operation (tm/in-sequence [(tm/optional copy-move) main-move])
:asserter (fn [s]
(let [main-offset (offset (setup/main-instance s) (setup/main-root s))
copy-offset (offset (setup/copy-instance s) (setup/copy-root s))
moved? (tm/applied? s copy-move)]
(if moved?
(do
(t/is (= (mapv - main-offset [10 5]) (mapv - copy-offset [7 3])))
(t/is (contains? (:touched (setup/copy-instance s)) :geometry-group)))
(do
(t/is (= main-offset copy-offset))
(t/is (empty? (:touched (setup/copy-instance s))))))
(t/is (empty? (:touched (setup/copy-root s))))))}))
(defn touched-copy-child-survives-main-rotation
"A copy whose ROOT is rotated (a geometry override) AND whose CHILD has its
own geometry override (resized) must keep the child exactly in place when

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

@ -40,7 +40,9 @@
[app.common.test-helpers.ids-map :as thi]
[app.common.test-helpers.shapes :as ths]
[app.common.types.container :as ctn]
[app.common.types.modifiers :as ctm]))
[app.common.types.modifiers :as ctm]
[app.common.types.shape.layout :as ctl]
[app.common.types.text :as txt]))
;; ---------------------------------------------------------------------------
;; Operation kinds and the production changes of user operations
@ -75,6 +77,13 @@
[situation changes]
(assoc situation ::changes changes))
(defprotocol IAppliedResult
(applied-result [op file-before file-after]
"A map of what `op` did that its accessors need, read from the file before
and after it. Both runners record it with the op's application: the pure
node in `apply-to`, the frontend interpreter after the op's event
settles."))
(defn take-changes
"The changes recorded by the last operation and the situation without them,
as `[recorded? changes situation]`. `recorded?` is false when the operation
@ -178,6 +187,79 @@
(def ^{:doc "Alias of `has-property-of`."} has-attr? has-property-of)
(def ^{:doc "Alias of `applied-property`."} applied-attr applied-property)
;; ---------------------------------------------------------------------------
;; edit-text — edit the content of a text shape
;;
;; An edit of the first span of a text, either its characters (`:text`) or its
;; font size (`:font-size`), as the text editor commits it when the edit ends:
;; a new `:content`, and a new name when the text still has the name generated
;; from its old content, written through `generate-update-shapes`. On a copy
;; the content touches `:content-group` plus the text subgroup of the change
;; (`:text-content-text` or `:text-content-attribute`). The frontend
;; interpreter commits the same edit through the real
;; `v2-update-text-shape-content` event, as the editor does on blur.
;; ---------------------------------------------------------------------------
(def ^:private first-span [:content :children 0 :children 0 :children 0])
(defn- generated-name
"The name the text editor gives a text after its `content`."
[content]
(txt/generate-shape-name (txt/content->text content)))
(defn text-edit-commit
"What the text editor commits when the `edit` (`:text` or `:font-size`) of
the first span of `shape` becomes `value`: `:content`, and `:name` when the
editor renames the shape after its text, which it does when the shape still
has the name generated from its old content. Public so the frontend
interpreter commits the same edit."
[shape edit value]
(when-not (contains? #{:text :font-size} edit)
(throw (ex-info (str "text-edit-commit: unsupported edit " (pr-str edit)
" (supported: :text, :font-size)")
{:edit edit})))
(let [content (assoc-in (:content shape) (conj (subvec first-span 1) edit) value)]
(cond-> {:content content}
(= (:name shape) (generated-name (:content shape)))
(assoc :name (generated-name content)))))
(defn edit-text-content
"`shape` after the text editor's commit of `text-edit-commit`."
[shape edit value]
(merge shape (text-edit-commit shape edit value)))
(defn text-span-value
"The `edit` (`:text` or `:font-size`) of `shape`'s first span."
[shape edit]
(get-in shape (conj first-span edit)))
(defrecord EditText [target edit value]
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}
#(edit-text-content % edit value)
(:objects page)
{})
file' (thf/apply-changes the-file changes)]
(-> situation
(tm/with-file file')
(record-changes changes)
(tm/record-application this {:target target :edit edit :value value})))))
(defn edit-text
"Constructor for the text edit operation: set the `edit` (`:text` or
`:font-size`) of the first span of the text bound to `target` to `value`.
On the frontend it dispatches the real `v2-update-text-shape-content`."
[target edit value]
(tm/assign-id (->EditText target edit value)))
;; ---------------------------------------------------------------------------
;; Geometry operations
;;
@ -252,6 +334,33 @@
(record-changes changes)
(tm/record-application this {:target target :value value})))))
(defrecord MoveShape [target dx dy]
IComponentOperation
(op-kind [_] :frontend-only)
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}
#(gsh/move % (gpt/point dx dy))
(:objects page)
{})
file' (thf/apply-changes the-file changes)]
(-> situation
(tm/with-file file')
(record-changes changes)
(tm/record-application this {:target target :dx dx :dy dy})))))
(defn move-shape
"Constructor for the move operation: move the shape named by `target` by
(`dx`, `dy`). On the frontend this dispatches the real sidebar
`dwt/update-position` event."
[target dx dy]
(tm/assign-id (->MoveShape target dx dy)))
(defn change-height
"Constructor for the height-change operation: resize the shape named by `target`
to height `value` (width unchanged). On the frontend this dispatches the real
@ -267,6 +376,13 @@
(has-property-of [node shape]
(mth/close? (:value node) (:height shape))))
(extend-type EditText
IPropertyCheck
(applied-property [node] (:edit node))
(applied-value [node] (:value node))
(has-property-of [node shape]
(= (:value node) (text-span-value shape (:edit node)))))
;; ===========================================================================
;; Synchronisation-scenario building blocks
;;
@ -343,6 +459,7 @@
;; (advances to the new OUTER component on make-nested-component)
;; :remote-head/:remote-rect - the fixed deepest origin (NEVER re-pointed)
;; :main-head/:main-rect - the current main (advances inward on make-nested-component)
;; :size - the size `create-component` gave the root (nil: minimal)
;; :nesting-count
;; :nesting-data - vector, one entry per nesting level i, each:
;; {:main-head <id of that level's outer main>
@ -407,11 +524,57 @@
[name]
(fn [s] (:copy-rect (get-component-obj s name))))
(defn copy-head-of
"Target: lineage `name`'s current copy head (from the latest instantiate-copy)."
[name]
(fn [s] (:copy-head (get-component-obj s name))))
(defn main-head-of
"Target: lineage `name`'s current main head."
[name]
(fn [s] (:main-head (get-component-obj s name))))
(defn nested-head-in
"Target: the nested copy head directly inside lineage `name`'s current copy
head (the copy of a level-0 nesting). Found through its parent, so it
still names the head after a swap or switch replaced it in place."
[name]
(fn [s]
(let [objects (:objects (thf/current-page (tm/file s)))
head ((copy-head-of name) s)]
(->> (cfh/get-immediate-children objects head)
(filter :component-id)
(first)
(:id)))))
(defn corresponding-shape-id
"The id of the shape in `head-id`'s subtree (the head included) whose
:shape-ref chain passes through `target-id`: its image in that copy."
[situation head-id target-id]
(self-or-descendant-corresponding-to (:objects (thf/current-page (tm/file situation)))
head-id
target-id))
(defn lineage-copy-rect
"The id of lineage `name`'s current copy rect (for assertions)."
[situation name]
(:copy-rect (get-component-obj situation name)))
(defn lineage-nth-copy-rect
"The id of the rect of lineage `name`'s `i`-th copy, in instantiation order."
[situation name i]
(get-in (get-component-obj situation name) [:copies i :copy-rect]))
(defn nth-copy-rect-of
"Target: the rect of lineage `name`'s `i`-th copy, in instantiation order."
[name i]
(fn [s] (lineage-nth-copy-rect s name i)))
(defn nth-copy-head-of
"Target: the head of lineage `name`'s `i`-th copy, in instantiation order."
[name i]
(fn [s] (get-in (get-component-obj s name) [:copies i :copy-head])))
(defn level-rect
"The id of the rect currently at lineage `name`'s nesting level `level`,
re-resolved from the swap-stable :nested-head-parent: parent -> current
@ -443,7 +606,7 @@
;; create-component — the starting operation: a component with a rect child
;; ---------------------------------------------------------------------------
(defrecord CreateComponent [name color]
(defrecord CreateComponent [name color size]
IComponentOperation
(op-kind [_] :assembly)
@ -455,9 +618,13 @@
comp-label (keyword (str "sync-" name "-component"))
file' (-> (tm/file situation)
(tho/add-simple-component comp-label head-label rect-label
:root-params
(when size {:width size :height size})
:child-params
{:fills (ths/sample-fills-color
:fill-color color)}))
(cond-> {:fills (ths/sample-fills-color
:fill-color color)}
size (assoc :width (/ size 2)
:height (/ size 2)))))
head-id (thi/id head-label)
rect-id (thi/id rect-label)
comp-id (thi/id comp-label)]
@ -468,6 +635,7 @@
{:main-component-id comp-id
:remote-head head-id :remote-rect rect-id
:main-head head-id :main-rect rect-id
:size size
:nesting-count 0
:nesting-data []})
(tm/record-application this {:component name :id comp-id})))))
@ -476,9 +644,12 @@
"Starting operation: create a component lineage named `name` (root frame + one
rect child of fill `color`) and track it as a component OBJECT. Sets
remote==main head+rect, :main-component-id, nesting-count 0. Begin a scenario
with this; create more lineages (e.g. swap targets) with further calls."
[name color]
(tm/assign-id (->CreateComponent name color)))
with this; create more lineages (e.g. swap targets) with further calls.
`:size` gives the root that width and height, and the rect half of it
(nesting gives the outer frames that size too); without it they all have
the minimal default size."
[name color & {:keys [size]}]
(tm/assign-id (->CreateComponent name color size)))
;; ---------------------------------------------------------------------------
;; make-nested-component — wrap the tracked component in a NEW OUTER component
@ -522,8 +693,10 @@
outer-frame (keyword (str "sync-" name "-outer-" level))
inner-copy (keyword (str "sync-" name "-innercopy-" level))
outer-comp (keyword (str "sync-" name "-outercomp-" level))
size (:size obj)
file' (-> the-file
(tho/add-frame outer-frame {:name "OuterFrame"})
(tho/add-frame outer-frame (cond-> {:name "OuterFrame"}
size (assoc :width size :height size)))
(instantiate-inner-fn outer-frame inner-copy)
(thc/make-component outer-comp outer-frame))
objects (:objects (thf/current-page file'))
@ -661,6 +834,41 @@
[name]
(tm/assign-id (->ResetCopyInstance name)))
;; ---------------------------------------------------------------------------
;; reset — reset the overrides of any copy head
;;
;; The "Reset overrides" action on the copy head bound to `target`, a nested
;; head included. Same production path as `reset-copy-instance`
;; (`generate-reset-component`), which is tied to a lineage's latest copy; the
;; frontend interpreter runs it as a file install for the same reason.
;; ---------------------------------------------------------------------------
(defrecord ResetOverrides [target]
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 (-> (pcb/empty-changes)
(cll/generate-reset-component the-file
{(:id the-file) the-file}
(ctn/make-container page :page)
shape-id))
file' (thf/apply-changes the-file changes :validate? false)]
(-> situation
(tm/with-file file')
(record-changes changes)
(tm/record-application this {:target target :reset shape-id})))))
(defn reset
"Reset the overrides of the copy head bound to `target` (a role, a label or
a `(situation -> id)` fn)."
[target]
(tm/assign-id (->ResetOverrides target)))
(defn- libraries
"The situation's files by id, as the production code expects them: the
current file and any auxiliary (library) files."
@ -668,6 +876,298 @@
(let [the-file (tm/file situation)]
(assoc (tm/aux-files situation) (:id the-file) the-file)))
;; ---------------------------------------------------------------------------
;; detach — break the link between a copy and its component
;;
;; The "Detach instance" action on the copy head bound to `target`. Drives the
;; production `generate-detach-component`, the changes the frontend
;; `detach-component` event commits. The copy's shapes lose their component
;; links and touched groups; its first-level nested copies stay copies, one
;; nesting level up, and inherit the touched groups of the shapes they
;; referenced (see `mem:common/component-sync-contract`).
;; ---------------------------------------------------------------------------
(defrecord Detach [target]
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 (cll/generate-detach-component (pcb/empty-changes)
shape-id
(:data the-file)
(:id page)
(libraries situation))
file' (thf/apply-changes the-file changes :validate? false)]
(-> situation
(tm/with-file file')
(record-changes changes)
(tm/record-application this {:target target :detached shape-id})))))
(defn detach
"Constructor for the detach operation: detach the copy head bound to
`target` (a role, a label or a `(situation -> id)` fn, e.g.
`copy-head-of`) from its component. On the frontend it dispatches the real
`detach-component` event."
[target]
(tm/assign-id (->Detach target)))
;; ---------------------------------------------------------------------------
;; update-main — push a copy's overrides to its main
;;
;; The "Update main component" action on the copy head bound to `target`.
;; Drives the production `generate-sync-shape-inverse`, the changes the
;; frontend `update-component` event commits (in two commits, the copy's and
;; the main's, which it tells apart by `:local-change?`; one changes here).
;; The main then differs from its other copies, so the runner syncs them.
;; ---------------------------------------------------------------------------
(defn- strip-local-change
[changes]
(let [strip (partial mapv #(dissoc % :local-change?))]
(-> changes
(update :redo-changes strip)
(update :undo-changes strip))))
(defrecord UpdateMain [target]
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)
container (ctn/make-container page :page)
changes (-> (pcb/empty-changes)
(pcb/with-container container)
(cll/generate-sync-shape-inverse (:data the-file)
(libraries situation)
container
shape-id)
(strip-local-change))
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 {:target target :updated shape-id})))))
(defn update-main
"Constructor for the update-main operation: push the overrides of the copy
head bound to `target` (a role, a label or a `(situation -> id)` fn, e.g.
`nth-copy-head-of`) to its main. On the frontend it dispatches the real
`update-component-sync` event."
[target]
(tm/assign-id (->UpdateMain target)))
;; ---------------------------------------------------------------------------
;; delete-component / restore-component
;;
;; Deleting a component deletes its main; the component stays in the file,
;; marked deleted, and its copies keep their data. Restoring it brings the
;; main back. `delete-component` drives `generate-delete-shapes` on the main
;; root, the changes the frontend `delete-component` event commits;
;; `restore-component` drives `generate-restore-component`, as the
;; frontend `restore-component` event does. The restore node asks the delete
;; node which component it deleted.
;; ---------------------------------------------------------------------------
(defrecord DeleteComponent [target]
IComponentOperation
(op-kind [_] :user)
tm/IOperation
(apply-to [this situation]
(let [the-file (tm/file situation)
root-id (tm/target-shape-id situation target)
page (thf/current-page the-file)
component-id (:component-id (get (:objects page) root-id))
[_ changes] (cls/generate-delete-shapes (pcb/empty-changes nil (:id page))
(:data the-file)
page
(:objects page)
#{root-id}
{})
file' (thf/apply-changes the-file changes :validate? false)]
(-> situation
(tm/with-file file')
(record-changes changes)
(tm/record-application this {:target target :component-id component-id})))))
(defn delete-component
"Constructor for the delete-component operation: delete the component whose
main root is bound to `target` (a role, a label or a `(situation -> id)`
fn). On the frontend it dispatches the real `delete-component` event."
[target]
(tm/assign-id (->DeleteComponent target)))
(defn- target-id
"The shape id `target` names, whether or not the shape still exists."
[situation target]
(cond
(fn? target) (target situation)
(tm/has-role? situation target) (get-in situation [:roles target])
:else (thi/id target)))
(defn deleted-component-id
"The id of the component that the `delete-component` node `node` deleted:
the one whose main root is the node's target. Read from the file, so it
holds in both runners."
[situation node]
(let [root-id (target-id situation (:target node))]
(or (->> (get-in (tm/file situation) [:data :components])
(vals)
(d/seek #(= root-id (:main-instance-id %)))
(:id))
(throw (ex-info "deleted-component-id: no component has that main root"
{:type ::no-component
:root root-id})))))
(defrecord RestoreComponent [deletion]
IComponentOperation
(op-kind [_] :user)
tm/IOperation
(apply-to [this situation]
(let [the-file (tm/file situation)
data (:data the-file)
component-id (deleted-component-id situation deletion)
component (get-in data [:components component-id])
page (get-in data [:pages-index (:main-instance-page component)])
changes (cll/generate-restore-component (pcb/empty-changes)
data
component-id
(:id the-file)
page
(:objects page))
file' (thf/apply-changes the-file changes :validate? false)]
(-> situation
(tm/with-file file')
(record-changes changes)
(tm/record-application this {:component-id component-id})))))
(defn restore-component
"Constructor for the restore-component operation: restore the component
that the `delete-component` node `deletion` deleted. On the frontend it
dispatches the real `restore-component` event."
[deletion]
(tm/assign-id (->RestoreComponent deletion)))
;; ---------------------------------------------------------------------------
;; duplicate — duplicate a shape in place
;;
;; The "Duplicate" action on the shape bound to `target`, with no offset.
;; Drives the production `generate-duplicate-changes`, the changes the
;; frontend `duplicate-shapes` event commits. The new subtree's head is read
;; from the file (the new shape whose parent existed before), so
;; `duplicate-head-of` works in both runners.
;; ---------------------------------------------------------------------------
(defn- new-subtree-head
"The id of the shape in `page-after` that is not in `page-before` but whose
parent is: the head of the one subtree added between them."
[page-before page-after]
(let [before (:objects page-before)]
(->> (vals (:objects page-after))
(filter #(and (not (contains? before (:id %)))
(contains? before (:parent-id %))))
(map :id)
(first))))
(defrecord Duplicate [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)
shape-id (tm/target-shape-id situation target)
page (thf/current-page the-file)
objects (:objects page)
changes (-> (pcb/empty-changes nil)
(cll/generate-duplicate-changes objects
page
#{shape-id}
(gpt/point 0 0)
(libraries situation)
(:data the-file)
(:id the-file))
(cll/generate-duplicate-changes-update-indices objects #{shape-id}))
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 duplicate
"Constructor for the duplicate operation: duplicate the shape bound to
`target` (a role, a label or a `(situation -> id)` fn) in place. On the
frontend it dispatches the real `duplicate-shapes` event."
[target]
(tm/assign-id (->Duplicate target)))
(defn duplicate-head-of
"Target: the head of the subtree that the `duplicate` node `node` added."
[node]
(fn [s] (:new-head (tm/node-data s node))))
;; ---------------------------------------------------------------------------
;; nest-copy — move an existing copy into a main
;;
;; Nests a copy in a component by moving it there: the copy head bound to
;; `copy` is relocated, as the last child, under the shape bound to `into`
;; (e.g. another lineage's main head). Drives the production
;; `generate-relocate`, the changes the frontend `relocate-shapes` event
;; commits (dragging the copy into the main in the layers panel). Unlike
;; `make-nested-component`, an assembly step, it is a user action, so the
;; copies of the receiving main sync and the step goes through undo.
;; ---------------------------------------------------------------------------
(defn nest-target-index
"The index `nest-copy` moves a copy to under the shape `parent-id`: after
its last child."
[situation parent-id]
(count (:shapes (tm/shape-by-id situation parent-id))))
(defrecord NestCopy [copy into]
IComponentOperation
(op-kind [_] :user)
tm/IOperation
(apply-to [this situation]
(let [the-file (tm/file situation)
copy-id (tm/target-shape-id situation copy)
parent-id (tm/target-shape-id situation into)
page (thf/current-page the-file)
changes (cls/generate-relocate (-> (pcb/empty-changes nil)
(pcb/with-page-id (:id page))
(pcb/with-objects (:objects page)))
parent-id
(nest-target-index situation parent-id)
#{copy-id})
file' (thf/apply-changes the-file changes :validate? false)]
(-> situation
(tm/with-file file')
(record-changes changes)
(tm/record-application this {:copy copy :into into})))))
(defn nest-copy
"Constructor for the nest-copy operation: move the copy head bound to `copy`
under the shape bound to `into`, as its last child (both a role, a label
or a `(situation -> id)` fn). On the frontend it dispatches the real
`relocate-shapes` event."
[copy into]
(tm/assign-id (->NestCopy copy into)))
;; ---------------------------------------------------------------------------
;; swap-component — replace a nested subinstance head with an instance of a
;; different component (the general "Swap component" action), in place.
@ -724,6 +1224,101 @@
[name level target & {:keys [keep-touched?] :or {keep-touched? false}}]
(tm/assign-id (->SwapComponent name level target keep-touched?)))
;; ---------------------------------------------------------------------------
;; swap-shape — swap any copy head for another lineage's component
;;
;; The general Swap-component action on the copy head bound to `target` (a
;; role, a label or a `(situation -> id)` fn, e.g. a copy's nested head found
;; with `corresponding-shape-id`), replacing it with an instance of lineage
;; `to`'s component. Same production path as `swap-component`
;; (`generate-component-swap-in-place`; frontend `component-swap`), which is
;; tied to a lineage's main-side nested heads. The swap keeps the head's id,
;; so a target that named it keeps naming the new head.
;; ---------------------------------------------------------------------------
(defn swap-target-id
"The component id `swap-shape`'s `to` names: a lineage name (a string) or a
component label (a keyword)."
[situation to]
(if (keyword? to)
(thi/id to)
(lineage-component-id situation to)))
(defrecord SwapShape [target to keep-touched?]
IComponentOperation
(op-kind [_] :user)
tm/IOperation
(apply-to [this situation]
(let [the-file (tm/file situation)
page (thf/current-page the-file)
shape (get (:objects page) (tm/target-shape-id situation target))
[_ changes _] (clv/generate-component-swap-in-place (pcb/empty-changes nil (:id page))
page
(libraries situation)
(:data the-file)
shape
(swap-target-id situation to)
(boolean keep-touched?))
file' (thf/apply-changes the-file changes :validate? false)]
(-> situation
(tm/with-file file')
(record-changes changes)
(tm/record-application this {:target target :to to :keep-touched? keep-touched?})))))
(defn swap-shape
"Swap the copy head bound to `target` for the component `to` names, a
lineage name or a component label (the general Swap-component action).
`keep-touched?` (default false) keeps the head's overrides."
[target to & {:keys [keep-touched?] :or {keep-touched? false}}]
(tm/assign-id (->SwapShape target to keep-touched?)))
;; ---------------------------------------------------------------------------
;; move-to-cell — move a child of a grid board to another cell
;;
;; Drops the child bound to `child` into the cell at `row`, `column` of its
;; grid board `board`: the board's cells change, as the commit of a canvas
;; drop does (the modifiers end in a new `:layout-grid-cells`). Both runners
;; write it with `update-shapes` on the board (`move-to-cell-fn`).
;; ---------------------------------------------------------------------------
(defn move-to-cell-fn
"The update of a grid board that moves its child `child-id` to the cell at
`row`, `column`. Public so the frontend interpreter makes the same update."
[child-id row column]
(fn [board objects]
(-> board
(ctl/free-cell-shapes [child-id])
(ctl/push-into-cell [child-id] row column)
(ctl/assign-cells objects))))
(defrecord MoveToCell [board child row column]
IComponentOperation
(op-kind [_] :user)
tm/IOperation
(apply-to [this situation]
(let [the-file (tm/file situation)
board-id (tm/target-shape-id situation board)
child-id (tm/target-shape-id situation child)
page (thf/current-page the-file)
changes (cls/generate-update-shapes (pcb/empty-changes nil (:id page))
#{board-id}
(move-to-cell-fn child-id row column)
(:objects page)
{:with-objects? true})
file' (thf/apply-changes the-file changes)]
(-> situation
(tm/with-file file')
(record-changes changes)
(tm/record-application this {:board board :child child :row row :column column})))))
(defn move-to-cell
"Constructor for the grid cell move: move the child bound to `child` to the
cell at `row`, `column` of the grid board bound to `board`."
[board child row column]
(tm/assign-id (->MoveToCell board child row column)))
;; ===========================================================================
;; VARIANT operations (case M) — the variant-switch flavour of the swap sweep.
;;
@ -808,7 +1403,7 @@
;; under `name` (variant-id + per-member component labels/ids).
;; ---------------------------------------------------------------------------
(defrecord MakeVariantContainer [name members]
(defrecord MakeVariantContainer [name members size]
IComponentOperation
(op-kind [_] :assembly)
@ -838,13 +1433,15 @@
;; member root as a child of the container, with variant id/name
;; (mirrors add-variant's `add-sample-shape :type :frame ...`)
(ths/add-sample-shape root-label
:type :frame
:parent-label container-label
:variant-id variant-id
:variant-name value)
(cond-> {:type :frame
:parent-label container-label
:variant-id variant-id
:variant-name value}
size (assoc :width size :height size)))
(ths/add-sample-shape rect-label
:parent-label root-label
:fills (ths/sample-fills-color :fill-color color))
(cond-> {:parent-label root-label
:fills (ths/sample-fills-color :fill-color color)}
size (assoc :width (/ size 2) :height (/ size 2))))
;; make it a component, then stamp variant metadata ON THE COMPONENT
(thc/make-component comp-label root-label)
(thc/update-component
@ -874,9 +1471,10 @@
each with the shared variant-id and an EXPLICIT selector value. `members` is a
vector of [value color]. Members are addressed by `value` in
`make-nested-component-with-variant` / `switch-variant`; `color` distinguishes
them for the asserter."
[name members]
(tm/assign-id (->MakeVariantContainer name members)))
them for the asserter. `:size` gives each member root that width and height,
and its rect half of it, as in `create-component`."
[name members & {:keys [size]}]
(tm/assign-id (->MakeVariantContainer name members size)))
;; ---------------------------------------------------------------------------
;; make-nested-component-with-variant — nest a chosen VARIANT, deeply
@ -1062,7 +1660,7 @@
;; pretending.
;; ---------------------------------------------------------------------------
(defrecord Undo []
(defrecord Undo [times]
IComponentOperation
(op-kind [_] :undo)
@ -1074,10 +1672,12 @@
{:type ::undo-is-event-op}))))
(defn undo
"Constructor for the undo node (case I). Takes no parameters; on the frontend it
dispatches the real undo, reversing the immediately preceding operation(s)."
[]
(tm/assign-id (->Undo)))
"Constructor for the undo node (case I): undo the latest `times` (default 1)
user operations, each with the syncs it caused. On the frontend it
dispatches the real undo `times` times."
([] (undo 1))
([times]
(tm/assign-id (->Undo times))))
;; ---------------------------------------------------------------------------
;; redo — apply again the latest undone operation(s)
@ -1104,6 +1704,32 @@
[]
(tm/assign-id (->Redo)))
;; ---------------------------------------------------------------------------
;; undo-before-sync — undo an edit before its sync runs
;;
;; Changes `property` of the shape bound to `target` and undoes it at once, in
;; one step, so the undo commits while the component watcher still holds the
;; edit's sync (it inspects commits in batches, a timer turn later). Only the
;; frontend has that window, so the node is frontend-only.
;; ---------------------------------------------------------------------------
(defrecord UndoBeforeSync [target property value]
IComponentOperation
(op-kind [_] :frontend-only)
tm/IOperation
(apply-to [_ _]
(throw (ex-info (str "UndoBeforeSync has no `apply-to` realisation: only the "
"frontend interpreter has a pending sync to undo before.")
{:type ::undo-before-sync-is-frontend-only}))))
(defn undo-before-sync
"Constructor for the undo-before-sync node: change `property` of the shape
bound to `target` to `value` and undo it while its sync is still pending.
The frontend interpreter dispatches the edit and the real undo together."
[target property value]
(tm/assign-id (->UndoBeforeSync target property value)))
;; ---------------------------------------------------------------------------
;; add-child — add a new shape into a (main) component, structurally

12
common/src/app/common/test_helpers/composable/comp/runner.cljc
View File

@ -15,7 +15,7 @@
until none is left. The frontend component watcher does the same, one
pass per sync commit.
- Undo and redo. A user operation and the syncs it caused form one undo
group. `n/undo` reverts the latest group and `n/redo` applies again the
group. `n/undo` reverts the latest groups and `n/redo` applies again the
latest reverted one; neither syncs, as in the frontend, where an undo
or redo commit only bumps the component's `:modified-at`. A user
operation that pushes a group empties the redo stack.
@ -168,9 +168,15 @@
(move-group situation ::redo-stack ::undo-stack :redo-changes seq))
(defn- run-undo
"Undo the latest `(:times op)` groups, one at a time."
[situation op]
(let [[situation group] (undo-group situation)]
(tm/record-application situation op {:undone (count group)})))
(let [[situation undone]
(reduce (fn [[situation undone] _]
(let [[situation group] (undo-group situation)]
[situation (+ undone (count group))]))
[situation 0]
(range (:times op)))]
(tm/record-application situation op {:undone undone})))
(defn- run-redo
[situation op]

164
common/src/app/common/test_helpers/composable/comp/setups.cljc
View File

@ -22,6 +22,7 @@
child and :copy-instance is the copy's child (this makes a test read like
`(has-attr? change-attr (copy-instance situation))`)."
(:require
[app.common.data :as d]
[app.common.files.changes-builder :as pcb]
[app.common.logic.shapes :as cls]
[app.common.test-helpers.components :as thc]
@ -29,7 +30,8 @@
[app.common.test-helpers.compositions :as tho]
[app.common.test-helpers.files :as thf]
[app.common.test-helpers.ids-map :as thi]
[app.common.test-helpers.shapes :as ths]))
[app.common.test-helpers.shapes :as ths]
[app.common.types.shape.layout :as ctl]))
(defn simple-component-with-copy
"A situation with a simple component (root + one child) and one clean copy.
@ -68,6 +70,155 @@
:main-root :main-root
:copy-root :copy-root})))
(defn simple-component-with-copies-on-two-pages
"Like `simple-component-with-labeled-copy`, plus a second copy on another
page. The main and the first copy live on the current page `:page1`; the
second copy on `:page2`. Labels: :main-root :main-child :copy-root
:copy-child :copy2-root :copy2-child. Roles as in the labeled setup, plus
:other-page-copy-instance -> :copy2-child (read it with
`other-page-copy-instance`, since it is not on the current page)."
[]
(let [file (-> (thf/sample-file :file1 :page-label :page1)
(tho/add-simple-component-with-copy
:component1 :main-root :main-child :copy-root
:main-child-params {:fills (ths/sample-fills-color :fill-color "#abcdef")}
:copy-root-params {:children-labels [:copy-child]})
(thf/add-sample-page :page2)
(thc/instantiate-component :component1 :copy2-root
:children-labels [:copy2-child])
(thf/switch-to-page :page1))]
(tm/make-situation file {:main-instance :main-child
:copy-instance :copy-child
:main-root :main-root
:copy-root :copy-root
:other-page-copy-instance :copy2-child})))
(defn other-page-copy-instance
"The copy child on the other page (role :other-page-copy-instance), live."
[situation]
(tm/role-shape-in-file situation :other-page-copy-instance))
(defn simple-text-component-with-copy
"A component whose root (100x100) holds one text, \"hello world\", and a
clean copy. Labels: :main-root :main-text :copy-root :copy-text. Roles:
:main-instance -> the main text, :copy-instance -> the copy text, plus
:main-root and :copy-root."
[]
(let [file (-> (thf/sample-file :file1)
(tho/add-frame-with-text :main-root :main-text "hello world"
:frame-params {:width 100 :height 100}
;; the name a new text gets from its content
:child-params {:name "hello world"})
(thc/make-component :component1 :main-root)
(thc/instantiate-component :component1 :copy-root
:children-labels [:copy-text]))]
(tm/make-situation file {:main-instance :main-text
:copy-instance :copy-text
:main-root :main-root
:copy-root :copy-root})))
(defn- place-in-columns
"The grid board `board` with a row and three columns, holding the shapes of
`labels` in its first columns, in order."
[board labels]
(let [board (-> board
(ctl/add-grid-row {:type :flex :value 1})
(ctl/add-grid-column {:type :flex :value 1})
(ctl/add-grid-column {:type :flex :value 1})
(ctl/add-grid-column {:type :flex :value 1}))
cells (reduce (fn [cells [column label]]
(let [[id _] (d/seek #(= column (:column (val %))) cells)]
(assoc-in cells [id :shapes] [(thi/id label)])))
(:layout-grid-cells board)
(map vector (iterate inc 1) labels))]
(assoc board :layout-grid-cells cells)))
(defn grid-component-with-copy
"A component whose main is a grid board (one row, three columns, 300x100)
holding two copies of an `:item` component in its first two columns, the
third free, and a copy of it. A second component, `:other`, has a red rect
(a swap target). Labels: :grid-root :child1 :child2 (main side),
:grid-copy :copy-child1 :copy-child2 (copy side), :item, :other. Roles:
:main-root, :copy-root, :main-child -> :child1, :copy-child -> :copy-child1."
[]
(let [file (-> (thf/sample-file :file1)
(tho/add-simple-component :item :item-root :item-rect
:root-params {:width 100 :height 100}
:child-params {:width 50 :height 50})
(tho/add-simple-component :other :other-root :other-rect
:root-params {:width 100 :height 100}
:child-params {:width 50 :height 50
:fills (ths/sample-fills-color
:fill-color "#ff0000")})
(ths/add-sample-shape :grid-root
:type :frame
:width 300
:height 100
:layout :grid
:layout-grid-dir :row
:layout-grid-rows []
:layout-grid-columns []
:layout-grid-cells {})
(thc/instantiate-component :item :child1 :parent-label :grid-root)
(thc/instantiate-component :item :child2 :parent-label :grid-root))
board (place-in-columns (ths/get-shape file :grid-root) [:child1 :child2])
file (-> file
(ths/update-shape :grid-root :layout-grid-rows (:layout-grid-rows board))
(ths/update-shape :grid-root :layout-grid-columns (:layout-grid-columns board))
(ths/update-shape :grid-root :layout-grid-cells (:layout-grid-cells board))
(thc/make-component :grid :grid-root)
(thc/instantiate-component :grid :grid-copy))
objects (:objects (thf/current-page file))]
;; the copy's children are the copies of the main's, by :shape-ref
(doseq [[main-label copy-label] [[:child1 :copy-child1] [:child2 :copy-child2]]]
(thi/set-id! copy-label
(->> (get-in objects [(thi/id :grid-copy) :shapes])
(d/seek #(= (thi/id main-label) (get-in objects [% :shape-ref]))))))
(tm/make-situation file {:main-root :grid-root
:copy-root :grid-copy
:main-child :child1
:copy-child :copy-child1})))
(defn component-with-sibling-instances
"A component whose main (300x100) holds three copies of an `:icon`
component side by side, and a copy of it. With `:grid` layout the main is a
one-row, three-column grid with each copy in its own cell. Labels: :row-root
:sub1 :sub2 :sub3 (main side), :row-copy :copy-sub1 :copy-sub2 :copy-sub3
(copy side, matched by :shape-ref). Roles: :main-root, :copy-root."
([] (component-with-sibling-instances :none))
([layout]
(let [grid? (= :grid layout)
subs [:sub1 :sub2 :sub3]
file (-> (thf/sample-file :file1)
(tho/add-simple-component :icon :icon-root :icon-rect
:root-params {:width 24 :height 24}
:child-params {:width 24 :height 24})
(ths/add-sample-shape :row-root
(cond-> {:type :frame :width 300 :height 100}
grid? (assoc :layout :grid
:layout-grid-dir :row
:layout-grid-rows []
:layout-grid-columns []
:layout-grid-cells {}))))
file (reduce #(thc/instantiate-component %1 :icon %2 :parent-label :row-root) file subs)
file (cond-> file
grid?
(as-> f (let [board (place-in-columns (ths/get-shape f :row-root) subs)]
(-> f
(ths/update-shape :row-root :layout-grid-rows (:layout-grid-rows board))
(ths/update-shape :row-root :layout-grid-columns (:layout-grid-columns board))
(ths/update-shape :row-root :layout-grid-cells (:layout-grid-cells board))))))
file (-> file
(thc/make-component :row :row-root)
(thc/instantiate-component :row :row-copy))
objects (:objects (thf/current-page file))]
(doseq [[main-label copy-label] (map vector subs [:copy-sub1 :copy-sub2 :copy-sub3])]
(thi/set-id! copy-label
(->> (get-in objects [(thi/id :row-copy) :shapes])
(d/seek #(= (thi/id main-label) (get-in objects [% :shape-ref]))))))
(tm/make-situation file {:main-root :row-root
:copy-root :row-copy}))))
(defn main-instance
"The main child shape of the configuration (role :main-instance), live."
[situation]
@ -88,6 +239,17 @@
[situation]
(tm/role-shape situation :copy-root))
(defn misaligned-sub-heads
"The indices of the copy root's children whose :shape-ref is not the main
root's child at the same index (positional alignment)."
[situation]
(let [main (:shapes (main-root situation))
copy (:shapes (copy-root situation))
ref #(:shape-ref (tm/shape-by-id situation %))]
(->> (map vector (range) copy main)
(remove (fn [[_ c m]] (= m (ref c))))
(mapv first))))
(defn component-with-many-children
"A situation with a component whose main has three children and one clean copy.

46
common/src/app/common/test_helpers/composable/core.cljc
View File

@ -32,9 +32,11 @@
(:require
[app.common.test-helpers.files :as thf]
[app.common.test-helpers.ids-map :as thi]
[app.common.types.pages-list :as ctpl]
[app.common.types.shape-tree :as ctst]
[app.common.uuid :as uuid]
[clojure.string :as str]))
[clojure.string :as str]
[clojure.test :as t]))
;; ---------------------------------------------------------------------------
;; Situation
@ -258,6 +260,27 @@
[situation id]
(ctst/get-shape (thf/current-page (file situation)) id))
(defn find-shape
"The live shape with `id` in any page of the situation's file (nil if
absent). For shapes outside the current page."
[situation id]
(some #(ctst/get-shape % id) (ctpl/pages-seq (:data (file situation)))))
(defn role-shape-in-file
"Like `role-shape`, but finds the role's shape in any page of the file."
[situation role-key]
(let [id (get-in situation [:roles role-key])]
(when (nil? id)
(throw (ex-info (str "Unbound role: " (pr-str role-key))
{:type ::unbound-role
:role role-key})))
(or (find-shape situation id)
(throw (ex-info (str "Role " (pr-str role-key) " resolves to a shape no longer "
"present in the file (id " (pr-str id) ").")
{:type ::role-shape-absent
:role role-key
:id id})))))
(defn rebind-role
"Re-point `role-key` to the current id of shape `label` (resolved via the global
label map now, while it is valid). Used by state-building operations that move
@ -635,3 +658,24 @@
(assoc-in [:node-data (choice-one-of-id recorded-choice)]
{:chosen (choice-of recorded-choice)})
(update :applied conj (choice-one-of-id recorded-choice))))
;; ---------------------------------------------------------------------------
;; Known failures
;;
;; A case assertion that a known bug breaks stays in the case as a strict
;; expected failure: it pins the wrong value the bug gives, so the case fails
;; when the failure changes or stops. Only the commit that fixes the bug
;; turns it back into a plain assertion.
;; ---------------------------------------------------------------------------
(defn known-failure
"Assert a strict expected failure for `bug` (its row in the plan's suspected
bugs): `expected` is the value that should hold and `actual` the value
found. While the bug is open, `actual` must be exactly `pinned`, the wrong
value the bug gives; any other value fails, `expected` included."
[bug expected pinned actual]
(t/is (= pinned actual)
(str "Known failure " bug ": expected " (pr-str expected)
", pinned to the bug's " (pr-str pinned)
(when (= expected actual)
". The expected value now holds: drop the pin in the fix commit"))))

10
common/test/common_tests/logic/composable_runner_test.cljc
View File

@ -460,3 +460,13 @@
(t/testing "a mark must pin its failures"
(t/is (thrown? #?(:clj Exception :cljs :default)
(verdict [(dissoc known :fails)]))))))
(t/deftest known-failure-holds-only-the-pinned-value
(let [reports (fn [actual]
(let [types (atom [])]
(binding [t/report #(swap! types conj (:type %))]
(tm/known-failure "F0" :right :wrong actual))
@types))]
(t/is (= [:pass] (reports :wrong)))
(t/is (= [:fail] (reports :right)))
(t/is (= [:fail] (reports :other)))))

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

@ -7,7 +7,8 @@
(ns common-tests.logic.composable-sync-test
"Runs the shared composable component cases through the pure runner, on the
JVM and in JS. Case N and the rotation case need the frontend placement
step, so only the frontend interpreter runs them."
step, and case X a pending frontend sync, so only the frontend interpreter
runs them."
(:require
[app.common.test-helpers.composable.comp.cases :as cases]
[app.common.test-helpers.composable.comp.runner :as r]
@ -63,3 +64,51 @@
(t/deftest case-o-variant-switch-keeps-override-only-where-mains-agree
(check (cases/variant-switch-keeps-override-only-where-mains-agree)))
(t/deftest case-q-detach-keeps-nested-copies-linked
(check (cases/detach-keeps-nested-copies-linked)))
(t/deftest case-r-update-main-reaches-other-copies
(check (cases/update-main-reaches-other-copies)))
(t/deftest case-s-deleted-component-copies-sync-again-after-restore
(check (cases/deleted-component-copies-sync-again-after-restore)))
(t/deftest case-t-duplicated-copy-keeps-overrides-and-link
(check (cases/duplicated-copy-keeps-overrides-and-link)))
(t/deftest case-u-nested-copy-reaches-copies-of-the-receiving-main
(check (cases/nested-copy-reaches-copies-of-the-receiving-main)))
(t/deftest case-v-new-edit-after-undo-clears-redo
(check (cases/new-edit-after-undo-clears-redo)))
(t/deftest case-w-undo-several-steps-over-nested-cascades
(check (cases/undo-several-steps-over-nested-cascades)))
(t/deftest case-y-text-override-merges-with-main-text-change
(check (cases/text-override-merges-with-main-text-change)))
(t/deftest case-aa-copy-swap-survives-main-changes
(check (cases/copy-swap-survives-main-changes)))
(t/deftest case-ab-reset-of-nested-swap-keeps-top-copy-overrides
(check (cases/reset-of-nested-swap-keeps-top-copy-overrides)))
(t/deftest case-ac-second-variant-switch-keeps-root-overrides
(check (cases/second-variant-switch-keeps-root-overrides)))
(t/deftest case-ad-update-main-pushes-a-swapped-child
(check (cases/update-main-pushes-a-swapped-child)))
(t/deftest case-ae-detached-or-duplicated-swapped-copy-follows-its-component
(check (cases/detached-or-duplicated-swapped-copy-follows-its-component)))
(t/deftest case-af-grid-cell-move-reaches-a-swapped-copy-child
(check (cases/grid-cell-move-reaches-a-swapped-copy-child)))
(t/deftest case-ag-main-reorder-keeps-copy-sub-heads-aligned
(check (cases/main-reorder-keeps-copy-sub-heads-aligned)))
(t/deftest case-ah-copy-sub-head-delete-keeps-others-aligned
(check (cases/copy-sub-head-delete-keeps-others-aligned)))

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

@ -63,8 +63,65 @@
(t/deftest case-o-variant-switch-keeps-override-only-where-mains-agree
(t/async done (ftm/check done (cases/variant-switch-keeps-override-only-where-mains-agree))))
(t/deftest case-q-detach-keeps-nested-copies-linked
(t/async done (ftm/check done (cases/detach-keeps-nested-copies-linked))))
(t/deftest case-r-update-main-reaches-other-copies
(t/async done (ftm/check done (cases/update-main-reaches-other-copies))))
(t/deftest case-s-deleted-component-copies-sync-again-after-restore
(t/async done (ftm/check done (cases/deleted-component-copies-sync-again-after-restore))))
(t/deftest case-t-duplicated-copy-keeps-overrides-and-link
(t/async done (ftm/check done (cases/duplicated-copy-keeps-overrides-and-link))))
(t/deftest case-u-nested-copy-reaches-copies-of-the-receiving-main
(t/async done (ftm/check done (cases/nested-copy-reaches-copies-of-the-receiving-main))))
(t/deftest case-v-new-edit-after-undo-clears-redo
(t/async done (ftm/check done (cases/new-edit-after-undo-clears-redo))))
(t/deftest case-w-undo-several-steps-over-nested-cascades
(t/async done (ftm/check done (cases/undo-several-steps-over-nested-cascades))))
(t/deftest case-x-undo-before-sync-leaves-copies-unchanged
(t/async done (ftm/check done (cases/undo-before-sync-leaves-copies-unchanged))))
(t/deftest case-y-text-override-merges-with-main-text-change
(t/async done (ftm/check done (cases/text-override-merges-with-main-text-change))))
(t/deftest case-n-geometry-sync-with-rotated-instances
(t/async done (ftm/check done (cases/geometry-sync-with-rotated-instances))))
(t/deftest case-touched-copy-child-survives-main-rotation
(t/async done (ftm/check done (cases/touched-copy-child-survives-main-rotation))))
(t/deftest case-z-main-child-move-reaches-copies
(t/async done (ftm/check done (cases/main-child-move-reaches-copies))))
(t/deftest case-aa-copy-swap-survives-main-changes
(t/async done (ftm/check done (cases/copy-swap-survives-main-changes))))
(t/deftest case-ab-reset-of-nested-swap-keeps-top-copy-overrides
(t/async done (ftm/check done (cases/reset-of-nested-swap-keeps-top-copy-overrides))))
(t/deftest case-ac-second-variant-switch-keeps-root-overrides
(t/async done (ftm/check done (cases/second-variant-switch-keeps-root-overrides))))
(t/deftest case-ad-update-main-pushes-a-swapped-child
(t/async done (ftm/check done (cases/update-main-pushes-a-swapped-child))))
(t/deftest case-ae-detached-or-duplicated-swapped-copy-follows-its-component
(t/async done (ftm/check done (cases/detached-or-duplicated-swapped-copy-follows-its-component))))
(t/deftest case-af-grid-cell-move-reaches-a-swapped-copy-child
(t/async done (ftm/check done (cases/grid-cell-move-reaches-a-swapped-copy-child))))
(t/deftest case-ag-main-reorder-keeps-copy-sub-heads-aligned
(t/async done (ftm/check done (cases/main-reorder-keeps-copy-sub-heads-aligned))))
(t/deftest case-ah-copy-sub-head-delete-keeps-others-aligned
(t/async done (ftm/check done (cases/copy-sub-head-delete-keeps-others-aligned))))
(t/deftest case-ai-copy-sub-head-delete-and-reflow-keeps-others-aligned
(t/async done (ftm/check done (cases/copy-sub-head-delete-and-reflow-keeps-others-aligned))))

17
frontend/test/frontend_tests/composable_tests/completion_contract_test.cljs
View File

@ -13,7 +13,10 @@
(:require
[app.common.files.changes-builder :as pcb]
[app.common.logic.shapes :as cls]
[app.common.test-helpers.composable.comp.nodes :as n]
[app.common.test-helpers.composable.comp.setups :as setup]
[app.common.test-helpers.composable.comp.undo-check :as uc]
[app.common.test-helpers.composable.core :as tm]
[app.common.test-helpers.files :as thf]
[app.common.test-helpers.ids-map :as thi]
[app.common.test-helpers.shapes :as ths]
@ -172,3 +175,17 @@
(t/is (empty? (wrf/pending)))
(t/is (= :settled (await (ftm/await-step [(fill-main-child red)]))))
(t/is (= red (fill-of :copy-child))))
(t/deftest skipped-optional-keeps-the-undo-baseline
;; The end-of-variant round trip undoes back to the last file install. A
;; skipped optional installs nothing, so the baseline stays at the setup,
;; before the edit, where the undo index is -1.
(t/async done
(let [later (n/change-property :copy-instance :fills red)]
(ftm/check done
{:setup setup/simple-component-with-labeled-copy
:operation (tm/in-sequence [(n/change-property :main-instance :fills red)
(tm/optional later)])}
(fn [situation]
(when-not (tm/applied? situation later)
(t/is (= -1 (:depth (uc/baseline situation))))))))))

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

@ -48,7 +48,9 @@
[app.main.data.workspace :as dw]
[app.main.data.workspace.libraries :as dwl]
[app.main.data.workspace.reflow :as wrf]
[app.main.data.workspace.selection :as dws]
[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.transforms :as dwt]
[app.main.data.workspace.undo :as dwu]
@ -133,12 +135,23 @@
node uses, but wrapped in the real workspace event (so it commits to the store
and the watcher auto-propagates):
ChangeProperty -> update-shapes (generate-update-shapes; n/set-property)
EditText -> v2-update-text-shape-content (n/edit-text-content)
MoveShape -> update-position (sidebar, page coordinates)
MoveChild -> relocate-shapes (generate-relocate, existing shape)
AddChild -> add-shape (create a shape under the parent)
RemoveChild -> delete-shapes (generate-delete-shapes)
Detach -> detach-component (generate-detach-component)
UpdateMain -> update-component-sync (generate-sync-shape-inverse)
DeleteComponent -> delete-component (generate-delete-shapes on the main)
RestoreComponent -> restore-component (generate-restore-component)
Duplicate -> duplicate-shapes (generate-duplicate-changes)
NestCopy -> relocate-shapes (generate-relocate into a main)
SwapShape -> component-swap (any copy head)
MoveToCell -> update-shapes on the grid board (n/move-to-cell-fn)
SyncFromLibrary -> sync-file (the cross-file library-update action, H)
Undo -> dwu/undo (reverse the previous operation(s), I)
Redo -> dwu/redo (apply the undone operation(s) again)
UndoBeforeSync -> update-shapes + dwu/undo, emitted together
(In-file propagation is automatic — the watcher — so no propagate op exists.)"
[op situation]
(cond
@ -150,6 +163,20 @@
[(dwsh/update-shapes #{(tm/target-shape-id situation target)}
(fn [shape] (n/set-property shape property value)))])
(instance? n/EditText op)
;; The commit the text editor makes when the edit ends (on blur), SVG
;; renderer path.
(let [{:keys [target edit value]} op
id (tm/target-shape-id situation target)
shape (tm/shape-by-id situation id)
{:keys [content name]} (n/text-edit-commit shape edit value)]
[(dwtx/v2-update-text-shape-content id content
:update-name? (some? name)
:name name
:finalize? true
:save-undo? true
:original-content (:content shape))])
(instance? n/Rotate op)
;; The real sidebar rotation event, absolute mode: rotates the shape (and its
;; whole subtree) around its center. Its apply-modifiers step runs the
@ -158,6 +185,13 @@
(let [{:keys [target angle]} op]
[(dwt/increase-rotation [(tm/target-shape-id situation target)] angle)])
(instance? n/MoveShape op)
;; The real sidebar position event, in page coordinates.
(let [{:keys [target dx dy]} op
id (tm/target-shape-id situation target)
{:keys [x y]} (:selrect (tm/shape-by-id situation id))]
[(dwt/update-position id {:x (+ x dx) :y (+ y dy)} {:absolute? true})])
(instance? n/ChangeHeight op)
;; The real sidebar dimension event.
(let [{:keys [target value]} op]
@ -175,6 +209,20 @@
target-id (n/lineage-component-id situation target)]
[(dwl/component-swap shape file-id target-id (boolean keep-touched?))])
(instance? n/SwapShape op)
(let [{:keys [target to keep-touched?]} op]
[(dwl/component-swap (tm/shape-by-id situation (tm/target-shape-id situation target))
(:id (tm/file situation))
(n/swap-target-id situation to)
(boolean keep-touched?))])
(instance? n/MoveToCell op)
;; The board's new cells, as the commit of a canvas drop into the cell.
(let [{:keys [board child row column]} op]
[(dwsh/update-shapes #{(tm/target-shape-id situation board)}
(n/move-to-cell-fn (tm/target-shape-id situation child) row column)
{:with-objects? true})])
(instance? n/SwitchVariant op)
;; The variant-switch action: switch the resolved variant copy head to the
;; sibling member whose selector property (pos 0) has `value`, via the REAL
@ -188,6 +236,31 @@
shape (tm/shape-by-id situation head-id)]
[(dwv/variants-switch {:shapes [shape] :pos 0 :val value})])
(instance? n/Detach op)
[(dwl/detach-component (tm/target-shape-id situation (:target op)))]
(instance? n/UpdateMain op)
[(dwl/update-component-sync (tm/target-shape-id situation (:target op))
(:id (tm/file situation)))]
(instance? n/DeleteComponent op)
(let [root (tm/shape-by-id situation (tm/target-shape-id situation (:target op)))]
[(dwl/delete-component {:id (:component-id root)})])
(instance? n/Duplicate op)
[(dws/duplicate-shapes #{(tm/target-shape-id situation (:target op))}
:change-selection? false)]
(instance? n/NestCopy op)
(let [parent-id (tm/target-shape-id situation (:into op))]
[(dwsh/relocate-shapes #{(tm/target-shape-id situation (:copy op))}
parent-id
(n/nest-target-index situation parent-id))])
(instance? n/RestoreComponent op)
[(dwl/restore-component (:id (tm/file situation))
(n/deleted-component-id situation (:deletion op)))]
(instance? n/MoveChild op)
(let [{:keys [target parent to-index]} op]
[(dwsh/relocate-shapes #{(cthi/id target)} (cthi/id parent) to-index)])
@ -209,9 +282,18 @@
[(dwl/sync-file file-id library-id)])
(instance? n/Undo op)
;; Reverse the previous operation(s) via the real undo event. The workspace
;; undo stack was maintained automatically by the prior ops' commits.
[dwu/undo]
;; Reverse the previous operation(s) via the real undo event, once per
;; operation to undo. The workspace undo stack was maintained automatically
;; by the prior ops' commits.
(vec (repeat (:times op) dwu/undo))
(instance? n/UndoBeforeSync op)
;; The edit and the undo go out together, so the undo commits before the
;; watcher inspects the edit's commit.
(let [{:keys [target property value]} op]
[(dwsh/update-shapes #{(tm/target-shape-id situation target)}
(fn [shape] (n/set-property shape property value)))
dwu/undo])
(instance? n/Redo op)
;; Apply again the latest undone operation(s) via the real redo event.
@ -277,25 +359,45 @@
[pending]
(update-keys pending #(or (cthi/label %) %)))
(defn- unwrap
"The concrete operation of an op unit: the op chosen by a RecordedChoice,
through nested choices (e.g. an optional one-of)."
[op]
(if (tm/recorded-choice? op) (recur (tm/choice-of op)) op))
(defn- record-choices
"Record in `situation` each choice on the way from the op unit `op` to its
concrete op, outermost first, as nested `RecordedChoice`s' own `apply-to`
does. Returns the situation."
[situation op]
(if (tm/recorded-choice? op)
(recur (tm/record-choice situation op) (tm/choice-of op))
situation))
(defn- record-op
"Record an operation's application onto the situation (after its effect settled),
re-reading the file from the store. For a RecordedChoice (one-of), record the
choice under the one-of identity (so the asserter's `get-choice` works) and
then the chosen op's application, in the order `RecordedChoice`'s own
`apply-to` uses."
re-reading the file from the store. The record is the op's own fields, plus
its `n/applied-result` when it has one. For a RecordedChoice (one-of), record
the choices first, under their one-of identities (so the asserter's
`get-choice` works), and then the chosen op's application, in the order
`RecordedChoice`'s own `apply-to` uses."
[situation op]
(let [situation (tm/with-file situation (current-file))
[situation op] (if (tm/recorded-choice? op)
[(tm/record-choice situation op) (tm/choice-of op)]
[situation op])]
(tm/record-application situation op (dissoc (into {} op) ::tm/id))))
(let [before (tm/file situation)
situation (-> situation
(tm/with-file (current-file))
(record-choices op))
op (unwrap op)
record (cond-> (dissoc (into {} op) ::tm/id)
(satisfies? n/IAppliedResult op)
(merge (n/applied-result op before (tm/file situation))))]
(tm/record-application situation op record)))
(defn- op-events
"The workspace events to dispatch for an op unit (a plain op or a one-of's
RecordedChoice — for the latter, the chosen op's events). `situation` provides
cross-file context to ops that need it."
[op situation]
(op->events (if (tm/recorded-choice? op) (tm/choice-of op) op) situation))
(op->events (unwrap op) situation))
(defn- install-file-event
"An UpdateEvent that replaces the current file in the (global) store with `file`
@ -310,11 +412,6 @@
:current-page-id (cthf/current-page-id file))
(assoc-in [:files (:id file)] file)))))
(defn- unwrap
"The concrete operation of an op unit (the chosen op of a RecordedChoice)."
[op]
(if (tm/recorded-choice? op) (tm/choice-of op) op))
;; --------------------------------------------------------------------------
;; Undo/redo round trip (see `app.common.test-helpers.composable.comp.undo-check`)
;;
@ -437,7 +534,8 @@
;; A user operation, but the real reset event transitively reads browser
;; globals (CSS vars), so it cannot run headless; the shared apply-to runs
;; the production reset generator with validation off.
(instance? n/ResetCopyInstance op))))
(instance? n/ResetCopyInstance op)
(instance? n/ResetOverrides op))))
(defn- run-sync-op
"Apply a synchronous (`sync-op?`) operation: run its shared `apply-to` against a
@ -450,9 +548,12 @@
(let [situation (tm/with-file situation (current-file))
situation (tm/apply-to op situation)]
(st/emit! (install-file-event (tm/file situation)))
;; a file install is the round trip's new baseline; a skipped optional
;; and an inline test install nothing new
(cond-> situation
(and (::undo-check? situation)
(not (instance? tm/Test (unwrap op))))
(not (instance? tm/Test (unwrap op)))
(not (instance? tm/Skip (unwrap op))))
(mark-baseline))))
(defn- run-ops
@ -518,19 +619,41 @@
(set! st/state (:state original-store))
(set! st/stream (:stream original-store)))
(defn- headless-text-measurement
"Stands in for the DOM text measurement, which needs a browser. A text whose
content changes stays pending until the renderer starts measuring it (see
`app.main.data.workspace.texts`); this starts and ends that measurement
for each text a `:text/reflow` names, leaving its geometry and
`:position-data` as they are. Replaces itself when started again."
[]
(ptk/reify ::headless-text-measurement
ptk/WatchEvent
(watch [_ _ stream]
(->> stream
(rx/filter (ptk/type? :text/reflow))
(rx/map deref)
;; after the text watcher opened its wait for the measurement
(rx/observe-on :async)
(rx/tap (fn [{:keys [ids]}]
(wrf/finish! (wrf/start! :text-measure ids))))
(rx/ignore)
(rx/take-until (rx/filter (ptk/type? ::headless-text-measurement) stream))))))
(defn install!
"Install `situation` in the global store and start the watchers the workspace
starts, replacing the previous variant's. Restores the global store first (a
preceding namespace may have swapped it) and forgets any pending work left
over, so a step that timed out earlier cannot hold up this variant's steps.
Stopping the previous layout watcher clears it too, but on the first install
of a run there is none. Returns the situation."
starts, replacing the previous variant's, plus the headless stand-in for
the DOM text measurement. Restores the global store first (a preceding
namespace may have swapped it) and forgets any pending work left over, so a
step that timed out earlier cannot hold up this variant's steps. Stopping
the previous layout watcher clears it too, but on the first install of a run
there is none. Returns the situation."
[situation]
(restore-global-store!)
(wrf/reset-pending!)
(st/emit! (install-situation-event situation)
(dw/initialize-edit-watchers)
(dwl/watch-library-changes))
(dwl/watch-library-changes)
(headless-text-measurement))
situation)
(defn- run-variant

6
plugins/apps/composable-test-suite/src/composable-tests/cases.ts
View File

@ -6,6 +6,9 @@ import { createTestCaseVariantSwitchPropagates } from "./cases/caseVariantSwitch
import { createTestCaseCopySubheadDeletePreservesSlots } from "./cases/caseCopySubheadDeletePreservesSlots.ts";
import { createTestCaseMainReorderKeepsCopySlots } from "./cases/caseMainReorderKeepsCopySlots.ts";
import { createTestCaseMainChildMovedOutLeavesCopy } from "./cases/caseMainChildMovedOutLeavesCopy.ts";
import { createTestCaseDetachKeepsNestedCopiesLinked } from "./cases/caseDetachKeepsNestedCopiesLinked.ts";
import { createTestCaseCopySwapSurvivesMainChanges } from "./cases/caseCopySwapSurvivesMainChanges.ts";
import { createTestCaseResetOfNestedSwapKeepsTopCopyOverrides } from "./cases/caseResetOfNestedSwapKeepsTopCopyOverrides.ts";
/**
* All composable test cases currently defined. A factory (not a constant): each
@ -21,5 +24,8 @@ export function allCases(): readonly TestCase[] {
createTestCaseCopySubheadDeletePreservesSlots(),
createTestCaseMainReorderKeepsCopySlots(),
createTestCaseMainChildMovedOutLeavesCopy(),
createTestCaseDetachKeepsNestedCopiesLinked(),
createTestCaseCopySwapSurvivesMainChanges(),
createTestCaseResetOfNestedSwapKeepsTopCopyOverrides(),
];
}

88
plugins/apps/composable-test-suite/src/composable-tests/cases/caseCopySwapSurvivesMainChanges.ts Normal file
View File

@ -0,0 +1,88 @@
import { LibraryComponent } from "@penpot/plugin-types";
import { TestCase } from "../test-suite/TestCase.ts";
import { Situation } from "../core/Situation";
import { Color } from "../model/Color";
import { ShapePropFillColor } from "../model/ShapeProp.ts";
import { OpChangeProperty } from "../operations/OpChangeProperty";
import { OpAssert } from "../operations/OpAssert";
import { OpCreateNestableComponent } from "../operations/OpCreateNestableComponent";
import { ContentCreationStrategyRectangle } from "../content-creation/ContentCreationStrategyRectangle.ts";
import { OpSequence } from "../operations/OpSequence.ts";
import { OpOptional } from "../operations/OpOptional.ts";
import { OpSwap } from "../operations/OpSwap.ts";
import { Assert } from "../util/Assert.ts";
// distinct fill colours (read-back values are lower-case)
const BASELINE = new Color("#aaaaaa");
const RED = new Color("#ff0000"); // the component the copy swaps to
const GREEN = new Color("#00ff00"); // the component the main swaps to
const BLUE = new Color("#0000ff"); // remote edit
/** The main component of a nestable component's configuration. */
function componentOf(op: OpCreateNestableComponent<ContentCreationStrategyRectangle>) {
return (s: Situation): LibraryComponent => {
const component = s.get(op.roles.mainInstance).component();
if (component === null) {
throw new Error("the main instance has no component");
}
return component;
};
}
/**
* Case AA — a copy's swap survives changes to the main.
*
* A component nests a copy of another; a copy of the outer component swaps its
* nested copy for a third component. Optionally the outer main then swaps its own
* nested copy for a fourth component, and optionally the nested component's main
* changes its rect. The copy's nested head stays an instance of the component it
* swapped to, showing that component's rect.
*/
export function createTestCaseCopySwapSurvivesMainChanges(): TestCase {
const opCreateComponent = new OpCreateNestableComponent(new ContentCreationStrategyRectangle(BASELINE));
const opCreateRed = new OpCreateNestableComponent(new ContentCreationStrategyRectangle(RED), "red");
const opCreateGreen = new OpCreateNestableComponent(new ContentCreationStrategyRectangle(GREEN), "green");
const fillColor = new ShapePropFillColor();
const { remoteInstance } = opCreateComponent.roles;
// the nested copy inside the outer copy, and inside the outer main
const copyNested = (s: Situation) => opCreateComponent.getNestedInstance(s, 1);
const mainNested = (s: Situation) => opCreateComponent.getCopyInstance(s, 0);
return new TestCase(
"CopySwapSurvivesMainChanges",
"A component containing a rectangle is created and nested once in an outer component, " +
"and two more components with differently coloured rectangles are created. A copy " +
"of the outer component swaps its nested copy for the first of them. Optionally the " +
"outer main swaps its own nested copy for the second, and optionally the nested " +
"component's main recolours its rectangle. The copy's swap must survive: its nested " +
"copy stays an instance of the component it swapped to and shows its colour.",
new OpSequence(
opCreateComponent,
opCreateRed,
opCreateGreen,
opCreateComponent.createOpInstantiate(),
opCreateComponent.createOpMakeNested(),
new OpSwap(copyNested, componentOf(opCreateRed), "the copy's nested copy for the red component"),
new OpOptional(
new OpSwap(mainNested, componentOf(opCreateGreen), "the main's nested copy for the green component")
),
new OpOptional(
new OpChangeProperty(
(s: Situation) => opCreateComponent.contentCreator.getRectangle(s.get(remoteInstance)),
fillColor,
BLUE,
"remote rect"
)
),
new OpAssert("the copy's nested copy keeps its swap", (s) => {
const head = copyNested(s);
Assert.that(
head.component()?.id === componentOf(opCreateRed)(s).id,
"the nested copy is a red instance"
);
fillColor.assertEqual(fillColor.read(opCreateComponent.contentCreator.getRectangle(head)), RED);
})
)
);
}

73
plugins/apps/composable-test-suite/src/composable-tests/cases/caseDetachKeepsNestedCopiesLinked.ts Normal file
View File

@ -0,0 +1,73 @@
import { Shape } from "@penpot/plugin-types";
import { TestCase } from "../test-suite/TestCase.ts";
import { Situation } from "../core/Situation";
import { Color } from "../model/Color";
import { ShapePropFillColor } from "../model/ShapeProp.ts";
import { OpChangeProperty } from "../operations/OpChangeProperty";
import { OpAssert } from "../operations/OpAssert";
import { OpCreateNestableComponent } from "../operations/OpCreateNestableComponent";
import { ContentCreationStrategyRectangle } from "../content-creation/ContentCreationStrategyRectangle.ts";
import { OpSequence } from "../operations/OpSequence.ts";
import { OpOptional } from "../operations/OpOptional.ts";
import { OpDetach } from "../operations/OpDetach.ts";
import { Assert } from "../util/Assert.ts";
// distinct fill colours (read-back values are lower-case)
const BASELINE = new Color("#aaaaaa");
const GREEN = new Color("#00ff00"); // main edit
const BLUE = new Color("#0000ff"); // remote edit
/**
* Case Q — a detached copy's nested copies stay linked.
*
* At nesting depth 0, 1 or 2, optionally change the main's rect, detach the
* copy, then change the remote (original) main's rect. At depth 0 the copy's
* rect is detached and keeps its value. Deeper, the rect lies in a nested copy,
* which stays a copy one level up and inherits the main's override: with it the
* rect keeps the main's colour, without it the rect follows the remote main.
*/
export function createTestCaseDetachKeepsNestedCopiesLinked(): TestCase {
const opCreateComponent = new OpCreateNestableComponent(new ContentCreationStrategyRectangle(BASELINE));
const fillColor = new ShapePropFillColor();
const { remoteInstance, mainInstance, copyInstance } = opCreateComponent.roles;
const rectOf =
(role: typeof remoteInstance) =>
(s: Situation): Shape =>
opCreateComponent.contentCreator.getRectangle(s.get(role));
const nestings = [opCreateComponent.createOpMakeNested(), opCreateComponent.createOpMakeNested()];
const changeMain = new OpChangeProperty(rectOf(mainInstance), fillColor, GREEN, "main rect");
const changeRemote = new OpChangeProperty(rectOf(remoteInstance), fillColor, BLUE, "remote rect");
return new TestCase(
"DetachKeepsNestedCopiesLinked",
"A component containing a rectangle is created and a copy is instantiated from it, " +
"optionally nested one or two levels deep. Optionally the current main's rectangle " +
"is coloured. The copy is then detached, and the originally created (remote) main's " +
"rectangle is coloured. Without nesting the copy's rectangle is no longer linked and " +
"keeps its colour. With nesting it lies in a nested copy that stays linked: it keeps " +
"the main's colour when the main was coloured, and otherwise follows the remote main.",
new OpSequence(
opCreateComponent,
opCreateComponent.createOpInstantiate(),
new OpOptional(nestings[0]),
new OpOptional(nestings[1]),
new OpOptional(changeMain),
new OpDetach(copyInstance, "copy"),
changeRemote,
new OpAssert("the copy's rect follows the rule for its depth", (s) => {
const rect = rectOf(copyInstance)(s);
const nested = nestings.some((n) => s.wasApplied(n));
const main = s.wasApplied(changeMain);
if (nested) {
Assert.that(rect.isComponentInstance(), "the nested rect stays linked");
fillColor.assertEqual(fillColor.read(rect), main ? GREEN : BLUE);
} else {
Assert.that(!rect.isComponentInstance(), "the detached rect is not linked");
fillColor.assertEqual(fillColor.read(rect), main ? GREEN : BASELINE);
}
})
)
);
}

18
plugins/apps/composable-test-suite/src/composable-tests/cases/caseRemoteMainCopySyncNested.ts
View File

@ -9,6 +9,7 @@ import { OpCreateNestableComponent } from "../operations/OpCreateNestableCompone
import { ContentCreationStrategyRectangle } from "../content-creation/ContentCreationStrategyRectangle.ts";
import { OpSequence } from "../operations/OpSequence.ts";
import { OpOptional } from "../operations/OpOptional.ts";
import { OpReset } from "../operations/OpReset.ts";
// distinct fill colours (read-back values are lower-case)
const BASELINE = new Color("#aaaaaa");
@ -28,8 +29,8 @@ const BLUE = new Color("#0000ff"); // copy edit
* tracked instance roles' rects (resolved via the strategy at the current depth),
* so the same composition holds at any depth.
*
* (The reset checkpoint of the original case is omitted: the Plugin API exposes no
* override-reset operation.)
* Then a copy override is forced and reset away: after the reset the copy shows
* the main change, else the remote change, else the baseline.
*/
export function createTestCaseRemoteMainCopySyncNested(): TestCase {
const opCreateComponent = new OpCreateNestableComponent(new ContentCreationStrategyRectangle(BASELINE));
@ -45,6 +46,7 @@ export function createTestCaseRemoteMainCopySyncNested(): TestCase {
const changeRemote = new OpChangeProperty(rectOf(remoteInstance), fillColor, RED, "remote rect");
const changeMain = new OpChangeProperty(rectOf(mainInstance), fillColor, GREEN, "main rect");
const changeCopy = new OpChangeProperty(rectOf(copyInstance), fillColor, BLUE, "copy rect");
const forceCopy = new OpChangeProperty(rectOf(copyInstance), fillColor, BLUE, "copy rect");
// the colour expected at the copy under the precedence rule
const expectedAtCopy = (s: Situation): Color => {
@ -63,7 +65,9 @@ export function createTestCaseRemoteMainCopySyncNested(): TestCase {
"then applied: colouring the rectangle on the remote, on the current main, and on the " +
"copy. The copy's rectangle must show the highest-precedence applied edit — a copy " +
"override wins over a main change, which wins over a remote change, which wins over " +
"the baseline — at every nesting depth.",
"the baseline — at every nesting depth. Finally the copy's rectangle is overridden " +
"once more and the copy's overrides are reset: it then shows the main change, else " +
"the remote change, else the baseline.",
new OpSequence(
opCreateComponent,
opCreateComponent.createOpInstantiate(),
@ -77,6 +81,14 @@ export function createTestCaseRemoteMainCopySyncNested(): TestCase {
new OpAssert("scopy shows the highest-precedence applied edit", (s) => {
const copyRect = opCreateComponent.contentCreator.getRectangle(s.get(copyInstance));
fillColor.assertEqual(fillColor.read(copyRect), expectedAtCopy(s));
}),
// force a copy override, then reset it away
forceCopy,
new OpReset(copyInstance),
new OpAssert("after the reset the copy shows the main's value", (s) => {
const copyRect = opCreateComponent.contentCreator.getRectangle(s.get(copyInstance));
const expected = s.wasApplied(changeMain) ? GREEN : s.wasApplied(changeRemote) ? RED : BASELINE;
fillColor.assertEqual(fillColor.read(copyRect), expected);
})
)
);

75
plugins/apps/composable-test-suite/src/composable-tests/cases/caseResetOfNestedSwapKeepsTopCopyOverrides.ts Normal file
View File

@ -0,0 +1,75 @@
import { LibraryComponent } from "@penpot/plugin-types";
import { TestCase } from "../test-suite/TestCase.ts";
import { Situation } from "../core/Situation";
import { Color } from "../model/Color";
import { ShapePropFillColor, ShapePropOpacity } from "../model/ShapeProp.ts";
import { OpChangeProperty } from "../operations/OpChangeProperty";
import { OpAssert } from "../operations/OpAssert";
import { OpCreateNestableComponent } from "../operations/OpCreateNestableComponent";
import { ContentCreationStrategyRectangle } from "../content-creation/ContentCreationStrategyRectangle.ts";
import { OpSequence } from "../operations/OpSequence.ts";
import { OpSwap } from "../operations/OpSwap.ts";
import { OpReset } from "../operations/OpReset.ts";
import { Assert } from "../util/Assert.ts";
// distinct fill colours (read-back values are lower-case)
const BASELINE = new Color("#aaaaaa");
const RED = new Color("#ff0000"); // the component the copy swaps to
/**
* Case AB — resetting a nested swap leaves the rest of the top copy alone.
*
* A copy of a component that nests another overrides its own root's opacity,
* swaps its nested copy for a third component, then resets the nested copy. The
* reset undoes the swap and must change nothing outside the nested copy; today it
* also clears the root's opacity override (F12 in the stabilization plan), which
* the case pins as a known failure.
*/
export function createTestCaseResetOfNestedSwapKeepsTopCopyOverrides(): TestCase {
const opCreateComponent = new OpCreateNestableComponent(new ContentCreationStrategyRectangle(BASELINE));
const opCreateRed = new OpCreateNestableComponent(new ContentCreationStrategyRectangle(RED), "red");
const fillColor = new ShapePropFillColor();
const opacity = new ShapePropOpacity();
const { copyInstance } = opCreateComponent.roles;
const copyNested = (s: Situation) => opCreateComponent.getNestedInstance(s, 1);
const redComponent = (s: Situation): LibraryComponent => {
const component = s.get(opCreateRed.roles.mainInstance).component();
if (component === null) {
throw new Error("the red main instance has no component");
}
return component;
};
return new TestCase(
"ResetOfNestedSwapKeepsTopCopyOverrides",
"A component containing a rectangle is created and nested once in an outer component; " +
"another component with a red rectangle is created. A copy of the outer component " +
"lowers its own opacity, swaps its nested copy for the red component, and then resets " +
"the nested copy. The reset must undo the swap (the nested copy shows the original " +
"rectangle again) and leave the copy's own opacity override alone. Today the reset " +
"also clears that override (known failure F12).",
new OpSequence(
opCreateComponent,
opCreateRed,
opCreateComponent.createOpInstantiate(),
opCreateComponent.createOpMakeNested(),
new OpChangeProperty(copyInstance, opacity, 0.5, "copy"),
new OpSwap(copyNested, redComponent, "the copy's nested copy for the red component"),
new OpReset(copyNested, "the copy's nested copy"),
new OpAssert("the reset undoes the swap and keeps the copy's opacity", (s) => {
const head = copyNested(s);
Assert.that(head.component()?.id !== redComponent(s).id, "the nested copy is no longer red");
fillColor.assertEqual(fillColor.read(opCreateComponent.contentCreator.getRectangle(head)), BASELINE);
// the reset clears the opacity, which the API then reads as null
Assert.knownFailure<number | null>(
"F12",
opacity.read(s.get(copyInstance)) ?? null,
0.5,
null,
(a, b) => a === b
);
})
)
);
}

13
plugins/apps/composable-test-suite/src/composable-tests/model/ShapeProp.ts
View File

@ -137,3 +137,16 @@ export class ShapePropHeight extends ShapePropNumberBase {
shape.resize(shape.width, value);
}
}
/** The opacity of a shape, from 0 to 1. Reads and writes `opacity` directly. */
export class ShapePropOpacity extends ShapePropNumberBase {
readonly name = "opacity";
read(shape: Shape): number {
return shape.opacity;
}
write(shape: Shape, value: number): void {
shape.opacity = value;
}
}

27
plugins/apps/composable-test-suite/src/composable-tests/operations/OpCreateNestableComponent.ts
View File

@ -26,9 +26,20 @@ const NESTED_COMPONENT_NAME = "OuterComponentRoot";
* given instance via the content-creation strategy.
*/
class RolesNestableComponent extends RoleBundle {
readonly remoteInstance = new Role<Board>("remote-instance");
readonly mainInstance = new Role<Board>("main-instance");
readonly copyInstance = new Role<Board>("copy-instance");
readonly remoteInstance: Role<Board>;
readonly mainInstance: Role<Board>;
readonly copyInstance: Role<Board>;
/**
* @param prefix - prepended to the role names, so several lineages can be
* bound in one situation (roles are bound by name)
*/
constructor(prefix: string) {
super();
this.remoteInstance = new Role<Board>(`${prefix}remote-instance`);
this.mainInstance = new Role<Board>(`${prefix}main-instance`);
this.copyInstance = new Role<Board>(`${prefix}copy-instance`);
}
}
/**
@ -131,16 +142,22 @@ class OpMakeNestedComponent extends Operation {
* (e.g. as the target of a variant switch) without knowing how nesting is stored.
*/
export class OpCreateNestableComponent<TContentCreator extends ContentCreationStrategy> extends Operation {
readonly roles = new RolesNestableComponent();
readonly roles: RolesNestableComponent;
/** Private key under which this lineage's (mutable) nesting data is stored. */
private readonly nestingDataKey = new DataKey<NestingData>("nesting-data");
/**
* @param contentCreator - creates and locates the component's content
* @param name - names the lineage when a situation holds more than one; its
* roles are bound under names prefixed with it
*/
constructor(public readonly contentCreator: TContentCreator) {
constructor(
public readonly contentCreator: TContentCreator,
name: string = ""
) {
super();
this.roles = new RolesNestableComponent(name === "" ? "" : `${name}-`);
}
async applyTo(situation: Situation): Promise<void> {

34
plugins/apps/composable-test-suite/src/composable-tests/operations/OpDetach.ts Normal file
View File

@ -0,0 +1,34 @@
import { Operation } from "../core/Operation";
import { Situation } from "../core/Situation";
import { ShapeTarget, resolveTarget } from "../core/ShapeTarget";
import { PenpotSync } from "../util/PenpotSync";
/**
* Detaches the copy head a target resolves to from its component, via the
* Plugin API's `detach()`. The copy's shapes lose their component links; its
* nested copies stay copies, one nesting level up.
*/
export class OpDetach extends Operation {
/**
* @param target - resolves the copy head to detach
* @param targetLabel - a human-readable name for the detached shape, used in
* the applied-operation log; defaults to the target's own string form
*/
constructor(
private readonly target: ShapeTarget,
private readonly targetLabel: string = String(target)
) {
super();
}
async applyTo(situation: Situation): Promise<void> {
// act on the settled document, as a user would
await PenpotSync.awaitPropagation();
resolveTarget(this.target, situation).detach();
await PenpotSync.awaitPropagation();
}
toString(): string {
return `detach ${this.targetLabel}`;
}
}

36
plugins/apps/composable-test-suite/src/composable-tests/operations/OpReset.ts Normal file
View File

@ -0,0 +1,36 @@
import { Shape } from "@penpot/plugin-types";
import { Operation } from "../core/Operation";
import { Situation } from "../core/Situation";
import { ShapeTarget, resolveTarget } from "../core/ShapeTarget";
import { PenpotSync } from "../util/PenpotSync";
/**
* Resets the overrides of the copy head a target resolves to, via the Plugin
* API's `resetOverrides()`: its subtree becomes equal to its main again.
*/
export class OpReset extends Operation {
/**
* @param target - resolves the copy head to reset
* @param targetLabel - a human-readable name for the reset shape, used in
* the applied-operation log; defaults to the target's own string form
*/
constructor(
private readonly target: ShapeTarget,
private readonly targetLabel: string = String(target)
) {
super();
}
async applyTo(situation: Situation): Promise<void> {
// act on the settled document, as a user would
await PenpotSync.awaitPropagation();
// the published @penpot/plugin-types the suite pins predates `resetOverrides`
const shape = resolveTarget(this.target, situation) as Shape & { resetOverrides(): void };
shape.resetOverrides();
await PenpotSync.awaitPropagation();
}
toString(): string {
return `reset overrides of ${this.targetLabel}`;
}
}

40
plugins/apps/composable-test-suite/src/composable-tests/operations/OpSwap.ts Normal file
View File

@ -0,0 +1,40 @@
import { LibraryComponent } from "@penpot/plugin-types";
import { Operation } from "../core/Operation";
import { Situation } from "../core/Situation";
import { ShapeTarget, resolveTarget } from "../core/ShapeTarget";
import { PenpotSync } from "../util/PenpotSync";
/**
* Swaps the copy head a target resolves to for an instance of another
* component, via the Plugin API's `swapComponent()`. The new head keeps the
* old head's id, so a target that found the old head finds the new one.
*
* Unlike the swap in the workspace UI, the API keeps the head's overrides
* (it swaps with keep-touched, F33 in the stabilization plan).
*/
export class OpSwap extends Operation {
/**
* @param target - resolves the copy head to swap
* @param component - resolves the component to swap to
* @param label - a human-readable description of the swap, used in the
* applied-operation log
*/
constructor(
private readonly target: ShapeTarget,
private readonly component: (situation: Situation) => LibraryComponent,
private readonly label: string
) {
super();
}
async applyTo(situation: Situation): Promise<void> {
// act on the settled document, as a user would
await PenpotSync.awaitPropagation();
resolveTarget(this.target, situation).swapComponent(this.component(situation));
await PenpotSync.awaitPropagation();
}
toString(): string {
return `swap ${this.label}`;
}
}

24
plugins/apps/composable-test-suite/src/composable-tests/util/Assert.ts
View File

@ -30,4 +30,28 @@ export class Assert {
throw new AssertionError(`expected ${render(expected)} but was ${render(actual)}`);
}
}
/**
* Asserts a strict expected failure for `bug` (its row in the component
* stabilization plan's suspected bugs): `expected` is the value that should
* hold, but while the bug is open `actual` must be exactly `pinned`, the
* wrong value the bug gives. Any other value fails, `expected` included, so
* the pin goes only with the fix.
*/
static knownFailure<T>(
bug: string,
actual: T,
expected: T,
pinned: T,
equals: (a: T, b: T) => boolean,
render: (v: T) => string = String
): void {
if (!equals(actual, pinned)) {
const fixed = equals(actual, expected) ? ". The expected value now holds: drop the pin in the fix" : "";
throw new AssertionError(
`known failure ${bug}: expected ${render(expected)}, pinned to the bug's ` +
`${render(pinned)}, but was ${render(actual)}${fixed}`
);
}
}
}