github/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2026-07-22 05:57:56 +00:00
Code Issues Packages Projects Releases Wiki Activity

✨ Add systematic component tests via a composable test model (#10529)

Browse Source 
* ✨ Add systematic component tests via a composable test model

Introduce a framework for systematically testing Penpot component behaviour
(synchronisation/propagation, swaps, variant switches, nesting), plus a first
suite of cases built on it.

A test is expressed as a COMPOSITION OF OPERATIONS over a "situation" (an
in-memory file value plus named role bindings). Operations are reified as data
and composed by two combinators — `in-sequence` (threads the situation) and
`one-of`/`optional` (alternatives, enumerated into concrete variants). So one
written case stands for a whole matrix of variants, and coverage grows by
composition rather than by copying tests. Operations drive the REAL production
change pipeline, and event-operations dispatch the REAL workspace events and
await settlement, so the production watcher's automatic propagation is what is
exercised — the tests reflect genuine app behaviour, not a reimplementation.

Structure (frontend/test/frontend_tests/composable_tests/):
  - core            — the domain-agnostic engine: situation, the operation and
                      enumeration protocols, the combinators, and the runners.
  - comp/nodes      — the component operations (create/instantiate/reset, nesting,
                      swap, the variant ops, child add/remove/move, change, undo,
                      library sync).
  - comp/setups     — component-shaped starting configurations.
  - interpreter     — runs a case against the real frontend store: sync-ops apply
                      directly, event-ops dispatch real events and await
                      settlement (absorbing sync-file's delayed status RPC, which
                      would otherwise leak an error into subsequent tests).
  - comp/sync-test  — the cases (B-F, H, I, K, L, M).

This is test-only code with a single consumer — the frontend test suite (the
layer that runs the real app) — so it lives entirely under the frontend test
tree as .cljs, not under app/common.

The framework and its cases are documented in the project memory
frontend/composable-component-tests, added alongside.

Co-authored-by: Claude <noreply@anthropic.com>

* 🐛 Guard WASM mock teardown against an empty snapshot

`teardown-wasm-mocks!` unconditionally restored from the `originals` atom.
When run without a matching setup (double teardown, or `with-wasm-mocks*`
misused around an async test body), the snapshot is empty and every WASM API
function was `set!` to nil — permanently, for the remainder of the test run.
Any later code calling one of them (e.g. a leaked debounced resize-wasm-text
event firing during a subsequent test namespace) then crashed with
"initialized? is not a function".

Make the restore a no-op when there is nothing to restore.

Co-authored-by: Claude <noreply@anthropic.com>

---------

Co-authored-by: Claude <noreply@anthropic.com>
This commit is contained in:
Dr. Dominik Jain 2026-07-10 12:17:43 +02:00 committed by GitHub
parent 176a813fb9
commit 2c15dcdb84
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
8 changed files with 2976 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

317
.serena/memories/frontend/composable-component-tests.md Normal file
View File

@ -0,0 +1,317 @@
# Composable component tests
A framework for systematically testing Penpot's component subsystem (synchronisation/propagation,
swaps, variant switches, nesting), plus the suite of cases built on it. Lives entirely in the
**frontend** test tree as `.cljs`; it is test-only code with a single consumer (the frontend test
suite, which runs the real app). There is nothing "common" about it — it is not under `app/common`.
## Core idea
A test is a **composition of operations** over a **situation**, plus assertions. You describe a
test as data (a setup + a sequence of operations) rather than writing bespoke imperative code, and
coverage grows by COMPOSITION: a new variation is one combinator wrapped around existing pieces,
not a copied test. One written case stands for a whole matrix of concrete cases.
- **Situation** — the in-memory Penpot file value, plus named **roles** (meaningful shapes, e.g.
`:main-instance`/`:copy-instance`), a `:vars` map (named non-shape values), and an ordered
**applied-log** of what ran.
- **Operation** — a step, reified as a DATA record implementing `IOperation` (single method
`apply-to`; `apply` collides with core). Operations are printable, navigable, and enumerable.
Most transform the situation; some do not — hence the genus is "operation", not "transformation"
(`Test` asserts and returns the situation unchanged; `Skip` is a no-op).
- **Assertions** — inline `Test` operations placed in the sequence (assert at intermediate points)
and/or a trailing asserter (a `situation -> any` lambda calling `t/is`). The runner makes NO
judgment; it applies operations and returns the situation. Only *retrieval* helpers live outside
the test (role accessors, `has-property-of`, `applied?`).
## Principles
- **Operations are data with identity.** Each node gets a unique id at construction (`assign-id`),
records what it did under that id (`record-application`), and is interrogated by identity
(`applied?`, `get-choice`). No flat keyword-tagged log.
- **Drive the real production pipeline.** Every operation routes through the actual production
change functions (`generate-update-shapes`, `generate-component-swap`, `generate-reset-component`,
`generate-sync-file-changes`, …) — never raw field writes, or propagation would have nothing to
react to. The test exercises genuine Penpot logic, not a reimplementation.
- **The frontend runs the real app.** Synchronous file-ops apply directly to the store; event-ops
dispatch the REAL workspace events and await settlement, so the production watcher's AUTOMATIC
propagation is what's under test. Observed semantics are genuine.
- **Roles resolve to ids at setup time.** The global label→id map (`thi`) is shared and
time-varying, so a role is captured as an id when the situation is built; resolving late (across
enumerated variants) would be unsound. Absence throws a diagnostic (never silent nil).
- **Targets resolve at apply-time and may be rebound.** A target is a `(situation -> id)` FUNCTION,
else a currently-bound ROLE, else a LABEL (`target-shape-id`). So one operation targeting a role
follows that role as state-building ops re-point it — which is what lets a single operation be
swept across depth.
- **Enumeration is authored, not exhaustive.** You compose only VALID cases (every `one-of` branch
must be valid against the setup), so outcomes are just pass / fail / error — no not-applicable
cells. Adding a variation across a matrix is a one-expression edit.
- **Naming discipline.** Penpot domain nouns ("component", "variant") must not name framework
abstractions (they collide with real domain concepts). Framework vocabulary is testing concepts
only; an operation may name the domain *action* it performs (`swap`, `propagate`).
## Composition operators
- `in-sequence` — ordered application, threads the situation; enumerates to the CARTESIAN PRODUCT
of its steps' variants. Operations do not commute, so order is explicit. The workhorse.
- `one-of` — exactly one branch; applying it throws (must be enumerated); enumerates to the UNION
of branches, each wrapped in a `RecordedChoice` so `get-choice` recovers which ran.
- `optional(X)` = `one-of([X, skip])` — sweeps "with and without X" (two variants). `skip` is the
identity operation. The workhorse for adding a state-building step as an axis over a case.
- `test-that [assert-fn]` — an inline `Test`: asserts at this point in the sequence, situation
unchanged. Lets checkpoints sit at intermediate steps. Engine stays clojure.test-free (it just
calls the supplied fn).
- `applied? [situation operation]` — whether that exact node ran (identity-based). Composes with
`optional`/`one-of` for free. REQUIREMENT: bind an operation to a value ONCE and reuse it (in the
composition AND any `Test` querying it), so the id you ask about is the id that ran.
## Structure (frontend/test/frontend_tests/composable_tests/)
Two boundaries: the domain-agnostic **engine** and the **comp** subject library (about components;
naming the domain is correct there).
- `core.cljs` (ns `frontend-tests.composable-tests.core`) — the engine, one file:
- situation: `make-situation`, `file`/`with-file`, `with-aux-files`/`aux-files` (carry extra
files, e.g. a library for case H), the applied-log.
- identity & transcript: `assign-id`, `node-id`, `record-application` (also stores a `::kind`
from the record type), `node-data`, `describe-applied` (readable ordered transcript, attached
to every failure so a failing variant in a sweep is identifiable).
- roles & lookup: `role-shape` (strict, by stored id), `has-role?`, `rebind-role`/`rebind-role-id`
(re-point a role — used by state-building ops), `target-shape-id` (fn | role | label),
`shape-by-id` (read a shape whose id is held in a `:vars` object), `resolve-shape`/`-id`.
- protocols: `IOperation`(`apply-to`); `IEnumerable`(`-enumerate`) + `enumerate`.
- operators: `Sequence`/`in-sequence`; `OneOf`/`one-of`/`RecordedChoice`/`get-choice`;
`Skip`/`skip`; `optional`; `Test`/`test-that`; `applied?`; vars `set-var`/`get-var`.
- runners (clojure.test-free): `run-variant`, `run-all` (enumerate → vector, `thi/reset-idmap!`
per variant).
- per-op-interpreter helpers: `sequence-ops` (flatten a concrete variant — flattens `Sequence`,
keeps `RecordedChoice` as a unit), `recorded-choice?`, `choice-of`, `choice-one-of-id`.
- `comp/setups.cljs` — setup fns returning a situation, + role accessors (`main-instance`/
`copy-instance`/`main-root`/`copy-root`, `copy-child` 1-based): `simple-component-with-copy`,
`simple-component-with-labeled-copy`, `component-with-many-children` (E, F),
`nested-component-with-copy`, `cross-file-component-with-copy` (H: main in a linked library, copy
in the consuming file; primary `:file` = consuming, aux = library), and `empty-situation` (empty
file, no roles — the `:setup` for the sweep cases, whose first operation is `create-component`).
- `comp/nodes.cljs` — the component OPERATIONS. General edit/structure ops:
`change-property [target property value]` (`:fills`/`:opacity`) with its dual `has-property-of`
(`IPropertyCheck`); `change-attr`/`has-attr?` are aliases. `add-child`/`remove-child`/`move-child`
(with `IStructuralCheck`). `sync-from-library` (H: `generate-sync-file-changes`, libraries =
primary + aux). `undo` (I; frontend `dwu/undo`). Plus the scenario building blocks below.
- `interpreter.cljs` (ns `frontend-tests.composable-tests.interpreter`) — runs a case against the
real frontend (see "Interpreter").
- `comp/sync_test.cljs` (ns `frontend-tests.composable-tests.comp.sync-test`) — the cases;
registered in `frontend_tests/runner.cljs`.
## Scenario object model (behind the sweep cases)
Scenario ops track one or more named component LINEAGES as OBJECTS under `:vars :components` (keyed
by name, e.g. "main"). Grouping a lineage's fields into one object lets several lineages coexist
(a swap targets a DIFFERENT component) and makes each op "read object `name`, update, write back".
A lineage object has:
- `:main-component-id` — the component the next instantiate/nest uses (advances to the new OUTER
component per `make-nested-component`).
- `:remote-head`/`:remote-rect` — the FIXED deepest origin (the original component everything is
derived from). For a plain lineage this is never re-pointed; a variant nesting DOES re-point it
(see below).
- `:main-head`/`:main-rect` — the current outer main (advances per nesting).
- `:nesting-count`; `:copies`, `:copy-head`/`:copy-rect` (from `instantiate-copy`).
- `:nesting-data` — vector, one entry per level i: `{:main-head, :nested-head, :nested-rect,
:nested-head-parent}`.
- `:nested-head` is the DEEPEST instance at level i — the descendant of the level's copy head
that corresponds to `:remote-head`, found by descending the `:shape-ref` chain (at level 0 the
inner copy itself; deeper, the corresponding shape nested within the outer wrapper). This is THE
SWAP / SWITCH TARGET; it carries a `:component-id`.
- `:nested-head-parent` is the SWAP-STABLE anchor: a swap/switch replaces the head in place but
keeps its parent, so assertions re-resolve parent → current head → rect.
Accessors / targets (in nodes): `lineage-component-id`, `lineage-rect`, `lineage-copy-rect`,
`lineage-nesting`, `level-rect`/`level-rect-of` (level i's CURRENT rect via the parent anchor);
target-fns `remote-rect-of`/`main-rect-of`/`copy-rect-of` and `nested-head-of` (return a
`(situation -> id)` for use as an operation target). "Corresponds to" across layers follows the
`:shape-ref` CHAIN, matching on chain MEMBERSHIP not terminus (a copy rect refs its near-main,
which carries a further `:shape-ref`, so the terminus over-walks). Single-file setups, so the chain
resolves in the local page objects.
Scenario operations (each takes a lineage `name`):
- `create-component [name color]` — a component (frame + rect child of `color`); remote == main,
count 0.
- `make-nested-component [name]` — wrap `name`'s component in a NEW OUTER component whose main
contains a COPY of it inside a board (add-frame → instantiate inside → make-component); the OUTER
becomes `:main-component-id`; advance `:main-*`; append a `:nesting-data` entry; bump count.
ITERABLE: `×N` = board-within-board nesting with one rect at the bottom. Each level's
`:nested-head` is the deepest instance there, so swapping/switching it propagates (via the
watcher) outward to copies of it in OUTER levels.
- `instantiate-copy [name]` — instantiate `name`'s current component; track `:copy-head` and the
rect corresponding to its main rect as `:copy-rect`.
- `reset-copy-instance [name]` — reset overrides on `:copy-head` (production
`generate-reset-component`, `:validate? false` — a file-op on the frontend too: the real reset
event reads browser globals and cannot run headless).
- `swap-component [name level target & {:keys [keep-touched?]}]` — swap level `level`'s
`:nested-head` for lineage `target`'s component, via production `generate-component-swap`.
Frontend = the REAL `dwl/component-swap` event, so the watcher AUTOMATICALLY propagates the swap
to copies (incl. deeper levels). A swap replaces the head in place: Penpot keeps the head id,
rewrites it to the new component, stamps a `:swap-slot-<uuid>` touched group. `keep-touched?`
default false (discards overrides); true is the variant-switch flavour.
- Shared nesting helper `nest-in-new-outer-component [situation name op seek-rect-id seek-head-id
instantiate-inner-fn]` — the contain-outward mechanism behind BOTH nesting ops. Adds the outer
frame, calls `instantiate-inner-fn` to place the inner instance, makes the outer a component,
then computes this level's `:nested-rect`/`:nested-head` as the IMAGES (inside the new inner copy)
of `seek-rect-id`/`seek-head-id` — the FIXED deepest origin — and does the bookkeeping. A flavour
supplies only the two origin ids + the instantiate fn. Seeking the FIXED origin (not the advancing
`:main-*`) is what makes `:nested-head` land on the deepest instance at every level.
`self-or-descendant-corresponding-to` is the chain-descent that also matches the head itself
(needed at level 0, where the inner copy head IS the origin's image).
## Variant operations
A variant switch IS a keep-touched swap whose target is resolved by a property VALUE (the
production `variants-switch`/`variant-switch` reduces to `component-swap … keep-touched? true`), so
it routes through the SAME `generate-component-swap` and the watcher auto-propagates it across
nesting levels exactly like a swap.
- `make-variant-container [name members]` (sync-op) — build a variant SET synchronously, mirroring
the test-helpers' `add-variant` idiom: a container frame (`:is-variant-container`), each `members`
entry `[value color]` becoming a member component whose ROOT is a child of the container carrying
the shared `:variant-id`/`:variant-name`, then `update-component` stamps `:variant-id` +
`:variant-properties [{:name "Property 1" :value value}]` on the component. Read the container id
via `(thi/id container-label)` only AFTER adding the container frame (`thi/id` returns nil before
the shape exists). Records the set in `:vars` (`variant-set`/`variant-member`/
`variant-member-component-id` read it back).
- `make-nested-component-with-variant [name set-name value]` (sync-op) — nest a chosen member via
the shared nesting helper, AND re-point the lineage's `:remote-head`/`:remote-rect` to that
member's root/rect: nesting a variant makes the member the new deepest origin, so subsequent plain
`make-nested-component` descends to the variant's image (its `:nested-head`) at every level.
- `switch-variant [target value]` (frontend event) — switch the variant copy head bound to `target`
to the sibling member with property value `value`, via the REAL `dwv/variants-switch` event (which
DISCOVERS the sibling in the container via `find-variant-components`). `target` uses the standard
resolution (role | label | fn), so the op knows nothing about nesting; cases supply
`nested-head-of name i`.
## Interpreter (interpreter.cljs)
Drives the real app:
- `op->events [op situation]` maps each event-dispatching operation to its real workspace event(s):
`ChangeProperty`→`dwsh/update-shapes` (the SHARED `set-property`, target via `target-shape-id`);
`MoveChild`→`dwsh/relocate-shapes`; `RemoveChild`→`dwsh/delete-shapes`; `AddChild`→`dwsh/add-shape`;
`SyncFromLibrary`→`dwl/sync-file`; `Undo`→`dwu/undo`; `SwapComponent`→`dwl/component-swap`;
`SwitchVariant`→`dwv/variants-switch {:shapes [head] :pos 0 :val value}`. All real events, so the
watcher auto-propagates.
- `sync-op?` ops (`MakeNestedComponent`, `CreateComponent`, `InstantiateCopy`, `ResetCopyInstance`,
`MakeVariantContainer`, `MakeNestedComponentWithVariant`, `Skip`, `Test`) are NOT dispatched as
events: `run-sync-op` runs the shared `apply-to` against a situation whose `:file` is the live
store file, then writes back synchronously. The property under test is still exercised by the
subsequent real-event ops + the watcher.
- It installs the situation's files into the global `st/state` store (primary as current; aux files
tagged `:library-of` the current file so the library-sync machinery treats them as linked), starts
the real `watch-component-changes` and the harness `watch-undo-stack`, then folds the operations:
dispatch events → await settlement → re-read the current file into `:file` → record. Re-reading
`:file` each step is why the shared role accessors keep working.
- `watch-undo-stack` mirrors the production undo-append subscription from `initialize-workspace`
(which the harness does not run); without it `dwu/undo` has an empty stack.
- Settlement (`await-settle`): subscribe to the commit stream, resolve on the first 60ms idle gap
after a commit (captures the edit commit and the watcher's follow-up sync commit), 2000ms timeout.
Debounce-based, not a deterministic per-op stopper. After settling, `op-grace-ms` adds a per-op
grace wait (currently only `SyncFromLibrary`, ~3.2s — see the Running note).
- Thumbnail rendering is stubbed for this suite (`install-thumbnail-noop!` no-ops
`dwth/update-thumbnail`): the propagation watcher schedules thumbnail renders that reach `window`,
absent headless.
- `check [done case-map asserter]` enumerates, runs each variant via the async fold, wraps the
asserter in `describe-applied`, and calls `done`. Per-variant isolation = id-map reset + global
state re-install (the global `st/state` is a shared `defonce`).
- STORE-SWAP IMMUNITY (`original-store`/`restore-global-store!`): many plugins-suite namespaces
`set!` `st/state`/`st/stream` to isolated stores and never restore them. The `app.main.refs`
lenses (through which the watcher observes commits) are okulary lenses bound to the ORIGINAL
atom instance at load time — after such a swap, events commit to a store the watcher cannot see
and ALL propagation dies silently (assertions see base/unsynced state; no error). The interpreter
therefore captures `st/state`/`st/stream` at namespace-LOAD time (before any test runs) and
re-`set!`s them at the start of every variant, making the harness immune to run order. Diagnosed
by bisecting the runner's deterministic execution order (it is NOT the `test-namespaces` vector
order: `t/test-vars-block` groups vars by namespace, and the group-by hash order decides — same
order locally and in CI).
## Cases
Asserters are inline; no `doseq`, no count assertions.
- **B** — an override on the copy survives a later main change (override present + `:touched`
contains the fill group + `:shape-ref` present).
- **C** — attribute sweep via `one-of {fills, opacity}`: assert `(has-attr? (get-choice …) copy)`
per enumerated variant.
- **D** — `add-child` to the main gives the copy a ref-integral child (`is-main-of?` +
`parent-of?` + untouched).
- **E** — `remove-child` of the MIDDLE of three: survivors keep order `[child1, child3]`,
`:shape-ref` intact, untouched (middle removal is where index maintenance is tested).
- **F** — `move-child` of child1 to index 2: copy mirrors `[child2, child1, child3]`, identity
preserved.
- **H** — locality (cross-file): main in a linked library, copy in the consuming (current) file,
library main diverged. The in-file watcher does not cross a library boundary; the cross-file
mechanism is the library-update action (`sync-from-library` → `sync-file file-id library-id`).
Setup order matters: instantiate the copy first (captures the old value), diverge the library main
after.
- **I** — undo: an edit then `undo`; copy and main return to baseline, copy untouched. A single
`dwu/undo` reverses the whole logical action — the edit AND its auto-propagation — because the two
commits share an undo-group.
- **K** — SYNC-SCENARIO SWEEP (the flagship). On `empty-situation`: `create-component` → two
`(optional make-nested-component)` (depths 0/1/2) → `instantiate-copy` → three `(optional change-*)`
over remote/main/copy → INLINE checkpoints: (1) override-precedence at the copy (copy wins, else
main, else remote — branch via `applied?`), (2) force a copy override and confirm it wins, (3)
after `reset-copy-instance`, copy reverts to main's value if main changed, else remote's. No
explicit propagate (the watcher auto-propagates at all depths, incl. chained remote→deep-copy).
- **L** — SWAP SWEEP. On `empty-situation`: `create-component` (base) + one swap-target lineage per
level → three `make-nested-component` → three `(optional (swap-component "main" i target_i))` →
one `Test` asserting each level's colour. A swap at level i auto-propagates to level i and every
OUTER level until a higher swap overrides; colour at level i = applied swap at highest j<=i, else
base.
- **M** — VARIANT-SWITCH SWEEP (case L with a variant switch instead of the plain swap, driving the
REAL variant-switch machinery). On `empty-situation`: `create-component` (base lineage "main") +
`make-variant-container` (4 peer members `v0..v3`) → ONE `make-nested-component-with-variant
"main" "vset" "v0"` (introduce the variant innermost) + two plain `make-nested-component`
(progressive wraps, so each outer level CONTAINS the one below) → three
`(optional (switch-variant (nested-head-of "main" i) v_{i+1}))` → one `Test` with case L's exact
precedence asserter. Because the single variant instance has a switchable `:nested-head` at EVERY
level and the levels are progressively nested, a switch at level i propagates outward like a swap.
NOTE on structure: ONE variant + plain wraps is required for cross-level propagation (the levels
nest WITHIN each other). Three independent `make-nested-component-with-variant` would nest SIBLING
variants (none a descendant of another), so switches would not propagate between them — the right
construction for a different test (one asserting switches DON'T cross unrelated instances).
Running: `cd frontend && pnpm run build:test` then `node target/tests/test.js --focus
frontend-tests.composable-tests.comp.sync-test`. To run one case, use var-level focus, e.g.
`…/case-m-variant-switch-scenarios`. NOTE: the production `sync-file` event (case H) additionally
schedules a 3s-delayed `update-file-library-sync-status` RPC, which fails headless (no backend; a
swallowed URL-parse trace is benign). The interpreter absorbs it: `op-grace-ms` makes the run wait
~3.2s after a `SyncFromLibrary` settles, so the failure lands inside case H instead of leaking into
(and potentially destabilising) whichever test runs next.
## Frontend fidelity — read before extending
The frontend runs the REAL production logic from the dispatched event onward, so observed semantics
are genuine. But it drives a MINIMALLY-ASSEMBLED app: it installs a file into the global store and
starts only the watchers known to be needed. The real app assembles its workspace via
`initialize-workspace`, which wires many subscriptions; the harness reproduces only some.
The risk is SILENT UNDER-WIRING — a behaviour that works in the real app can be silently absent in
the harness with no error (e.g. the undo stack is empty unless `watch-undo-stack` is started).
Therefore: when adding a case needing app behaviour beyond a raw edit (undo, persistence, selection,
layout, thumbnails, library auto-detection), first check whether that behaviour lives in an
`initialize-workspace` subscription the harness has not wired — and verify by PROBING store state,
not by trusting a green assertion. The harness hand-wires two stand-ins (`install-file-event`,
`watch-undo-stack`); track them for drift. A durable fix would be to drive the real
`initialize-workspace` headlessly (not done — full init may pull in machinery that doesn't run
cleanly headless).
## Other caveats
- Cross-namespace leaks land in this suite first because it (correctly) uses the real global
store: besides the store swap above, `frontend-tests.helpers.wasm/teardown-wasm-mocks!` used to
`set!` every WASM fn to nil when run against an empty snapshot (double teardown / async misuse of
`with-wasm-mocks*`), which a leaked debounced `resize-wasm-text` event then tripped over during
our cases (a "Store error: initialized? is not a function"). The teardown is now guarded
(no-op on empty snapshot). If a new inexplicable full-run-only failure appears here, suspect
leaked global state from a preceding namespace before suspecting the framework.
- INLINE `Test` exceptions on the frontend are UNCAUGHT (they run during the async fold, not under
`check`'s try): a throwing checkpoint crashes the whole runner rather than failing one test.
- A `RecordedChoice` wrapping a `Sequence` (i.e. `(optional (in-sequence […]))`) is NOT flattened by
`sequence-ops`, so `op->events` chokes on the `Sequence`. Use independent optionals instead (as
case K does with two `(optional make-nested-component)`), or have the interpreter recurse into a
choice's composite alternative.
- The Serena symbol index / clj-kondo cache for `nodes.cljs` can go STALE and report PHANTOM symbols
or spurious "unresolved symbol" errors against code that compiles — TRUST THE BUILD (a real
`pnpm run build:test`), not the lint or the symbol overview, for this file.
- Label-after-the-fact resolution: `add-child`'s `added-shape` resolves `:new-label` via `thi/id`,
relying on the global label map still reflecting that run's setup — unsound if a structural node
is swept via `one-of`. Fix when needed by capturing the created shape's id at apply-time (as roles
already do).
## Substrate
`mem:common/test-setup`, `mem:common/component-data-model`, `mem:common/component-swap-pipeline`,
`mem:frontend/testing`.

1020
frontend/test/frontend_tests/composable_tests/comp/nodes.cljs Normal file
View File

File diff suppressed because it is too large Load Diff

203
frontend/test/frontend_tests/composable_tests/comp/setups.cljs Normal file
View File

@ -0,0 +1,203 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) KALEIDOS INC Sucursal en España SL
(ns frontend-tests.composable-tests.comp.setups
"Component-specific setups for the test model: named functions that build an
in-memory file value for a particular component configuration. They are the
subject-specific counterpart to the generic engine; a 'simple component with
a copy' is an entirely component-shaped configuration, so it lives behind the
`comp` boundary. See `mem:frontend/composable-component-tests`.
Setups are kept as plain functions (not data): structure resists
declarativization and forcing it here has the worst cost/benefit. Each returns
a *situation* (file + ROLE bindings — meaningful named objects of the
configuration, e.g. :main-instance, :copy-instance), which the test retrieves
via the accessors below and asserts on directly.
For these one-child-per-instance configurations the meaningful objects are the
child shapes that participate in propagation, so :main-instance is the main's
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.files.changes-builder :as pcb]
[app.common.logic.shapes :as cls]
[app.common.test-helpers.components :as thc]
[app.common.test-helpers.compositions :as tho]
[app.common.test-helpers.files :as thf]
[app.common.test-helpers.ids-map :as thi]
[app.common.test-helpers.shapes :as ths]
[frontend-tests.composable-tests.core :as tm]))
(defn simple-component-with-copy
"A situation with a simple component (root + one child) and one clean copy.
Shape labels: :main-root :main-child :copy-root :copy-child. Roles:
:main-instance -> the main child, :copy-instance -> the copy child."
[]
(let [file (-> (thf/sample-file :file1)
(tho/add-simple-component-with-copy
:component1 :main-root :main-child :copy-root
:copy-root-params {:children-labels [:copy-child]}))]
(tm/make-situation file {:main-instance :main-child
:copy-instance :copy-child
:main-root :main-root
:copy-root :copy-root})))
(defn empty-situation
"A situation with an empty file and NO roles — the starting point for scenarios
that build their own configuration via operations (e.g. `create-component`,
`make-nested-component`, `instantiate-copy`). Use as the `:setup` when the first
operation creates the component."
[]
(tm/make-situation (thf/sample-file :file1)))
(defn simple-component-with-labeled-copy
"Like `simple-component-with-copy`, but the main child starts with a known fill
(so 'value stayed' is distinguishable from coincidence). Same labels and roles."
[]
(let [file (-> (thf/sample-file :file1)
(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]}))]
(tm/make-situation file {:main-instance :main-child
:copy-instance :copy-child
:main-root :main-root
:copy-root :copy-root})))
(defn main-instance
"The main child shape of the configuration (role :main-instance), live."
[situation]
(tm/role-shape situation :main-instance))
(defn copy-instance
"The copy child shape of the configuration (role :copy-instance), live."
[situation]
(tm/role-shape situation :copy-instance))
(defn main-root
"The main component root shape (role :main-root), live."
[situation]
(tm/role-shape situation :main-root))
(defn copy-root
"The copy root shape (role :copy-root), live."
[situation]
(tm/role-shape situation :copy-root))
(defn component-with-many-children
"A situation with a component whose main has three children and one clean copy.
Shape labels: :main-root, :main-child1/2/3, :copy-root, :copy-child1/2/3.
Roles: :main-root, :copy-root, and :copy-child-1/2/3 -> the copy's children
(so a test can assert their post-operation order in the copy root)."
[]
(let [file (-> (thf/sample-file :file1)
(tho/add-component-with-many-children-and-copy
:component1
:main-root
[:main-child1 :main-child2 :main-child3]
:copy-root
:copy-root-params {:children-labels [:copy-child1 :copy-child2 :copy-child3]}))]
(tm/make-situation file {:main-root :main-root
:copy-root :copy-root
:copy-child-1 :copy-child1
:copy-child-2 :copy-child2
:copy-child-3 :copy-child3})))
(defn copy-child
"The copy child shape for 1-based index `n` (role :copy-child-n), live. Lets a
test retrieve specific copy children to assert their order/identity."
[situation n]
(tm/role-shape situation (keyword (str "copy-child-" n))))
(defn nested-component-with-copy
"A situation with a NESTED component configuration (depth axis): component2's
main contains a nested instance of component1 (`:main2-nested-head`); a clean
copy of component2 exists, so the copy contains a copy of that nested instance
whose child (`:copy2-child`) reaches the main through a :shape-ref CHAIN.
This is the depth-1 analogue of the simple-with-copy setup: editing
`:main2-nested-head` (the nested instance inside component2's main) and
propagating component2 must reach `:copy2-child` — the same attribute-
propagation property as the flat case, one level deeper. (Editing the
INNERMOST :main1-child and propagating only :component1 would instead be a
CHAINED propagation across two component levels — a different property; not
this setup.)
Shape labels from the helper: :main1-root/:main1-child, :main2-root,
:main2-nested-head, :copy2-root, and :copy2-child (the deep copy child, labeled
via the helper's children-labels). Roles: :main-instance -> :main2-nested-head,
:copy-instance -> :copy2-child, plus :main2-root / :copy-root for structure."
[]
(let [file (-> (thf/sample-file :file1)
(tho/add-nested-component-with-copy
:component1 :main1-root :main1-child
:component2 :main2-root :main2-nested-head
:copy2-root
:copy2-root-params {:children-labels [:copy2-child]}))]
(tm/make-situation file {:main-instance :main2-nested-head
:copy-instance :copy2-child
:main2-root :main2-root
:copy-root :copy2-root})))
(defn- change-main-child-fill
"Apply `fill-color` to the library's :main-child via the production change path
(mirrors how a real edit to the main would have changed the library), returning
the updated library file value. Used to make the library main DIVERGE from the
already-instantiated copy, so a subsequent cross-file sync has something to pull."
[library fill-color]
(let [page (thf/current-page library)
main-id (thi/id :main-child)
changes (cls/generate-update-shapes
(pcb/empty-changes nil (:id page))
#{main-id}
(fn [shape] (assoc shape :fills (ths/sample-fills-color :fill-color fill-color)))
(:objects page)
{})]
(thf/apply-changes library changes)))
(defn cross-file-component-with-copy
"LOCALITY axis (case H): a component whose main lives in a SEPARATE, shared
LIBRARY file, and a clean copy that lives in a CONSUMING file. The library main
has since DIVERGED from the copy (its :main-child now carries `new-fill`, while
the copy still carries the original `#abcdef`), modelling 'the library was
changed elsewhere'. Propagating that change to the copy is therefore a CROSS-
FILE sync (the library-update flow), not the in-file watcher.
The returned situation's PRIMARY file is the CONSUMING file (the current file,
where the copy lives and which the copy roles resolve against); the library
travels as an AUXILIARY file (see `tm/with-aux-files`) so an interpreter can
install it alongside (e.g. into the frontend store's `:files`) and run the
cross-file sync. Roles: :copy-instance -> the copy child, :copy-root -> the copy
root (both in the consuming file). `new-fill` should match the value the test
uses for its expected-value descriptor.
Labels: in the LIBRARY — :component1, :main-root, :main-child; in the CONSUMING
file — :copy-root, :copy-child."
[new-fill]
(let [library (-> (thf/sample-file :library :is-shared true)
(tho/add-simple-component
:component1 :main-root :main-child
:child-params {:fills (ths/sample-fills-color :fill-color "#abcdef")}))
;; instantiate the copy in the consuming file FIRST (copy gets the old fill)
file (-> (thf/sample-file :file)
(thc/instantiate-component :component1 :copy-root
:library library
:children-labels [:copy-child]))
;; THEN diverge the library main (copy is now stale)
library' (change-main-child-fill library new-fill)]
(-> (tm/make-situation file {:copy-instance :copy-child
:copy-root :copy-root})
(tm/with-aux-files {(:id library') library'}))))
(defn library-id
"The id of the library file in a cross-file situation (the single auxiliary
file). Used by the cross-file sync operation."
[situation]
(-> situation tm/aux-files keys first))

346
frontend/test/frontend_tests/composable_tests/comp/sync_test.cljs Normal file
View File

@ -0,0 +1,346 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) KALEIDOS INC Sucursal en España SL
(ns frontend-tests.composable-tests.comp.sync-test
"Component-behaviour cases authored on the composable test model, run against
the REAL app (frontend interpreter). In-file propagation is AUTOMATIC: a case
contains ONLY the user edit(s) (no propagate op); the app's component-change
watcher syncs copies on its own, and that is what we assert.
The cases (see `mem:frontend/composable-component-tests` for details):
B — an override on a copy child survives a later main change (touched gate).
C — a sweep (one-of) over several attribute changes, each auto-propagating.
D — a shape added to the main is structurally auto-propagated (ref-integrity).
E — a middle shape removed from the main; survivors keep order.
F — reordering a shape in the main; order auto-propagates, identity preserved.
H — locality: a library main's change reaches the consuming file's copy on
the explicit library sync (cross-file propagation).
I — undo reverses an edit AND its auto-propagation.
K — the synchronisation sweep: depth x edit-targets, with override-precedence
and reset checkpoints.
L — the swap sweep: swaps at any subset of nesting levels.
M — the variant-switch sweep: case L with variant switches.
Async: each deftest uses `t/async`; `ftm/check` drives the store and calls
`done` when finished."
(:require
[app.common.types.component :as ctk]
[app.common.types.shape-tree :as ctst]
[cljs.test :as t :include-macros true]
[frontend-tests.composable-tests.comp.nodes :as n]
[frontend-tests.composable-tests.comp.setups :as setup]
[frontend-tests.composable-tests.core :as tm]
[frontend-tests.composable-tests.interpreter :as ftm]))
(def ^:private red "#ff0000")
(def ^:private green "#00ff00")
;; Disable thumbnail rendering for the duration of each (async) test: the
;; propagation watcher schedules thumbnail renders that reach `window`, absent in
;; the headless runner. `:each` `:after` runs only after the test's `done` fires
;; (same guarantee the wasm-mock fixtures rely on), so the no-op covers the whole
;; async lifetime and is scoped to THIS namespace. See ftm/install-thumbnail-noop!.
(t/use-fixtures :each
{:before ftm/install-thumbnail-noop!
:after ftm/restore-thumbnail!})
;; (Cases A, G, J retired — subsumed by case K's depth-swept propagation scenario.)
(t/deftest case-b-copy-override-survives-later-main-change
(t/async
done
(let [override (n/change-attr :copy-child :fills green)] ; touch the copy first
(ftm/check
done
{:setup setup/simple-component-with-labeled-copy
;; override the copy, then change the main; the watcher auto-syncs after
;; each edit. The override must survive (touched-flag gate).
:operation (tm/in-sequence
[override
(n/change-attr :main-child :fills red)])}
(fn [situation]
(let [copy-child (setup/copy-instance situation)]
(t/is (n/has-attr? override copy-child))
(t/is (contains? (:touched copy-child) :fill-group))
(t/is (some? (:shape-ref copy-child)))))))))
(t/deftest case-c-attribute-sweep-auto-propagates-to-clean-copy
(t/async
done
(let [sweep (tm/one-of
[(n/change-attr :main-child :fills red)
(n/change-attr :main-child :opacity 0.5)])]
(ftm/check
done
{:setup setup/simple-component-with-copy
:operation (tm/in-sequence [sweep])}
(fn [situation]
(let [chosen (tm/get-choice situation sweep)]
(t/is (some? chosen))
(t/is (n/has-attr? chosen (setup/copy-instance situation)))))))))
(t/deftest case-d-add-shape-to-main-auto-propagates-to-clean-copy
(t/async
done
(let [add (n/add-child :main-root :main-child-2)]
(ftm/check
done
{:setup setup/simple-component-with-labeled-copy
:operation (tm/in-sequence [add])}
(fn [situation]
(let [copy-root (setup/copy-root situation)
main-new (n/added-shape add situation)
copy-new (n/materialized-instance-child add situation copy-root)]
(t/is (some? copy-new))
(t/is (ctk/is-main-of? main-new copy-new))
(t/is (ctst/parent-of? copy-root copy-new))
(t/is (nil? (:touched copy-new)))))))))
(t/deftest case-e-remove-shape-from-main-auto-propagates-to-clean-copy
(t/async
done
(let [removal (n/remove-child :main-child2)]
(ftm/check
done
{:setup setup/component-with-many-children
:operation (tm/in-sequence [removal])}
(fn [situation]
(let [copy-root (setup/copy-root situation)
order (vec (:shapes copy-root))
c1 (setup/copy-child situation 1)
c3 (setup/copy-child situation 3)]
(t/is (= 2 (count order)))
(t/is (= (nth order 0) (:id c1)))
(t/is (= (nth order 1) (:id c3)))
(t/is (some? (:shape-ref c1)))
(t/is (some? (:shape-ref c3)))
(t/is (nil? (:touched c1)))
(t/is (nil? (:touched c3)))
(t/is (nil? (:touched copy-root)))))))))
(t/deftest case-f-move-shape-in-main-auto-propagates-order-to-clean-copy
(t/async
done
(let [move (n/move-child :main-child1 :main-root 2)]
(ftm/check
done
{:setup setup/component-with-many-children
:operation (tm/in-sequence [move])}
(fn [situation]
(let [copy-root (setup/copy-root situation)
order (vec (:shapes copy-root))
c1 (setup/copy-child situation 1)
c2 (setup/copy-child situation 2)
c3 (setup/copy-child situation 3)]
(t/is (= (nth order 0) (:id c2)))
(t/is (= (nth order 1) (:id c1)))
(t/is (= (nth order 2) (:id c3)))
(t/is (some? (:shape-ref c1)))
(t/is (some? (:shape-ref c2)))
(t/is (some? (:shape-ref c3)))
(t/is (nil? (:touched c1)))
(t/is (nil? (:touched c2)))
(t/is (nil? (:touched c3)))))))))
(t/deftest case-i-undo-reverts-edit-and-its-auto-propagation
(t/async
done
;; UNDO axis (case I), built on case A: change the main (which auto-propagates
;; to the clean copy), then UNDO. A single undo reverses the whole logical
;; action — the edit AND its propagation — so the copy returns to baseline and
;; is left untouched. Undo is just another op (`n/undo`); the engine owns
;; reversal (frontend realisation dispatches the real `dwu/undo`).
(let [original "#abcdef" ; the labeled setup's starting fill
baseline (n/change-attr :main-child :fills original) ; expected-VALUE descriptor
change (n/change-attr :main-child :fills red)]
(ftm/check
done
{:setup setup/simple-component-with-labeled-copy
:operation (tm/in-sequence [change (n/undo)])}
(fn [situation]
(let [copy (setup/copy-instance situation)
main (setup/main-instance situation)]
;; the edit was reversed on the main …
(t/is (n/has-attr? baseline main))
;; … and on the copy (the propagation was reversed too) …
(t/is (n/has-attr? baseline copy))
;; … leaving the copy clean.
(t/is (nil? (:touched copy)))))))))
(t/deftest case-h-library-change-propagates-across-file-boundary-on-sync
(t/async
done
;; LOCALITY axis: the main lives in a linked LIBRARY, the copy in the consuming
;; (current) file. The library main has diverged (setup applied `red` to it,
;; leaving the copy stale). Unlike the in-file cases, the watcher does NOT cross the
;; file boundary; the real app propagates via the library-UPDATE action, so the
;; transformation is `sync-from-library` (dispatches the real `sync-file`).
;; `expected` is only an expected-VALUE descriptor (its target is irrelevant;
;; `has-attr?` uses just attr+value), so the asserter reads exactly like case A.
(let [expected (n/change-attr :main-child :fills red)]
(ftm/check
done
{:setup #(setup/cross-file-component-with-copy red)
:operation (tm/in-sequence [(n/sync-from-library)])}
(fn [situation]
(t/is (n/has-attr? expected (setup/copy-instance situation))))))))
(def ^:private blue "#0000ff")
(t/deftest case-k-synchronisation-scenarios
(t/async
done
;; CONSOLIDATED SCENARIO SWEEP — one composition standing in for many cases.
;; Built from the sync-scenario operations on an empty situation. It sweeps:
;; - DEPTH 0/1/2 via two independent `(optional (make-nested-component ...))`
;; - which EDITS were made via three independent `(optional change-*)`
;; and asserts, at INLINE checkpoints, the override-precedence and reset rules.
;; The change targets are the tracked ROLES (:remote/:main/:copy-child-rect), so
;; the same composition holds at any depth. Propagation is AUTOMATIC (no
;; propagate op). Subsumes the flat/nested propagation cases (A/G/J).
(let [m "main"
change-remote (n/change-property (n/remote-rect-of m) :fills red)
change-main (n/change-property (n/main-rect-of m) :fills green)
change-copy (n/change-property (n/copy-rect-of m) :fills blue)
copy-rect (fn [s] (n/lineage-copy-rect s m))
;; precedence at the copy: copy override wins; else main; else remote.
expected-after-edits
(fn [s]
(cond
(tm/applied? s change-copy) (n/has-property-of change-copy (tm/shape-by-id s (copy-rect s)))
(tm/applied? s change-main) (n/has-property-of change-main (tm/shape-by-id s (copy-rect s)))
(tm/applied? s change-remote) (n/has-property-of change-remote (tm/shape-by-id s (copy-rect s)))
:else true))]
(ftm/check
done
{:setup setup/empty-situation
:operation (tm/in-sequence
[(n/create-component m red)
;; depth sweep: two independent optionals give depths 0/1/2
;; (depth 1 appears twice — harmless) without nesting a
;; Sequence inside an optional.
(tm/optional (n/make-nested-component m))
(tm/optional (n/make-nested-component m))
(n/instantiate-copy m)
(tm/optional change-remote)
(tm/optional change-main)
(tm/optional change-copy)
(tm/test-that (fn [s] (t/is (expected-after-edits s))))
;; force a copy override, observe it wins, then reset it away
change-copy
(tm/test-that
(fn [s] (t/is (n/has-property-of change-copy (tm/shape-by-id s (copy-rect s))))))
(n/reset-copy-instance m)
(tm/test-that
(fn [s]
;; after reset: main's value if main changed, else remote's
;; if remote changed (else the original — not asserted).
(cond
(tm/applied? s change-main) (t/is (n/has-property-of change-main (tm/shape-by-id s (copy-rect s))))
(tm/applied? s change-remote) (t/is (n/has-property-of change-remote (tm/shape-by-id s (copy-rect s))))
:else true)))])}))))
(defn- level-color
"The fill colour of the rect currently at lineage `name`'s nesting level `i`."
[s name i]
(-> (tm/shape-by-id s (n/level-rect s name i)) :fills first :fill-color))
(def ^:private base-color "#aaaaaa")
(def ^:private swap-colors ["#ff0000" "#00ff00" "#0000ff"]) ; level 0/1/2 targets
(t/deftest case-l-swap-scenarios
(t/async
done
;; SWAP SWEEP — build a 3-level nesting, then OPTIONALLY swap the nested
;; component at each level for a differently-coloured one, and assert the colour
;; that surfaces at every level. A swap at level i propagates (automatically, via
;; the watcher) to level i and every OUTER (higher-index) level, until a swap at
;; a higher level overrides it. So the colour at level i is the swap at the
;; HIGHEST index j <= i that was applied, else the base colour. (Generalises the
;; "single swap in copy" diagram across which levels are swapped.)
(let [m "main"
targets ["s0" "s1" "s2"]
;; swap[i] swaps level i's nested component for target lineage i (color i)
swaps (mapv (fn [i] (n/swap-component m i (nth targets i))) (range 3))
expected-at
(fn [s i]
;; the colour of the applied swap at the highest j <= i, else base
(or (some (fn [j] (when (tm/applied? s (nth swaps j)) (nth swap-colors j)))
(range i -1 -1))
base-color))]
(ftm/check
done
{:setup setup/empty-situation
:operation (tm/in-sequence
(concat
[(n/create-component m base-color)]
;; a target lineage per level
(map-indexed (fn [i c] (n/create-component (nth targets i) c)) swap-colors)
[(n/make-nested-component m) (n/make-nested-component m) (n/make-nested-component m)]
;; optionally swap at each level
(map (fn [sw] (tm/optional sw)) swaps)
[(tm/test-that
(fn [s]
(doseq [i (range 3)]
(t/is (= (expected-at s i) (level-color s m i))
(str "level " i)))))]))}))))
(t/deftest case-m-variant-switch-scenarios
(t/async
done
;; VARIANT-SWITCH SWEEP — the variant-switch flavour of case L. Build a variant
;; SET of peer members and nest the base member at EVERY level (so each level has
;; a variant head, just as case L's swap target exists at every level). Then
;; OPTIONALLY switch the variant head at each level to a differently-coloured
;; sibling and assert the colour that surfaces at every level. A variant switch
;; routes through the SAME component-swap as case L (keep-touched? true), so the
;; watcher auto-propagates it identically: the colour at level i is the switch at
;; the HIGHEST index j <= i that was applied, else the base member's colour. Same
;; asserter as L — the test of "a variant switch propagates like a swap".
(let [m "main" ; the nesting lineage (holds the nesting-data)
vset "vset" ; the variant set
vals ["v0" "v1" "v2" "v3"]
colors (into [base-color] swap-colors) ; base + sibling colours
;; switch[i] switches level i's variant head to member i+1 (colour i). The
;; single variant instance has a corresponding (switchable) head at every
;; level — `nested-head` IS the deepest instance there — so we can switch at
;; ANY level, exactly like case L's per-level swap.
switches (mapv (fn [i] (n/switch-variant (n/nested-head-of m i) (nth vals (inc i))))
(range 3))
expected-at
(fn [s i]
;; same precedence as case L: the colour at level i is the switch at the
;; HIGHEST index j <= i that was applied (a switch propagates outward),
;; else base.
(or (some (fn [j] (when (tm/applied? s (nth switches j)) (nth swap-colors j)))
(range i -1 -1))
base-color))]
(ftm/check
done
{:setup setup/empty-situation
:operation (tm/in-sequence
(concat
;; the nesting lineage, and the variant set (members = [value color])
[(n/create-component m base-color)
(n/make-variant-container vset (mapv vector vals colors))]
;; introduce the variant instance ONCE (innermost), then wrap it
;; with plain nesting so each outer level CONTAINS the one below
;; (progressive nesting, like case L's make-nested-component x3). nested-head
;; at every level is then the variant (the deepest instance), so a
;; switch at level i targets it and propagates OUTWARD via the
;; watcher — exactly like case L's swap.
[(n/make-nested-component-with-variant m vset "v0")
(n/make-nested-component m)
(n/make-nested-component m)]
;; optionally switch each level's variant head to its target sibling
(map (fn [sw] (tm/optional sw)) switches)
[(tm/test-that
(fn [s]
(doseq [i (range 3)]
(t/is (= (expected-at s i) (level-color s m i))
(str "level " i)))))]))}))))

611
frontend/test/frontend_tests/composable_tests/core.cljs Normal file
View File

@ -0,0 +1,611 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) KALEIDOS INC Sucursal en España SL
(ns frontend-tests.composable-tests.core
"The domain-agnostic ENGINE of the composable test model (see
`mem:frontend/composable-component-tests`):
- a `situation` carrying the in-memory file value, named ROLE bindings,
a `:vars` map, and an ordered record of applied operations,
- node identity (`assign-id`) + the applied-log (`record-application`,
`applied?`, `describe-applied`),
- strict-presence lookup that throws a diagnostic error on a missing name,
- the `IOperation` protocol (single method `apply-to`) and the
`IEnumerable` protocol behind variant enumeration,
- the composition operators `in-sequence`, `one-of`, `optional`, `skip`,
and the inline-assertion operation `test-that`,
- the enumerating pure runners `run-variant` / `run-all` (the frontend
interpreter in `frontend-tests.composable-tests.interpreter` is the
event-dispatching counterpart and the test-facing entry point).
No Penpot domain terms live here; the component-specific operations sit
behind the `comp` boundary (`frontend-tests.composable-tests.comp.*`).
Shape references use the existing label->uuid system (`app.common.test-helpers.ids-map`)
rather than a parallel binding map: a binding name in an operation IS a
shape label, resolved through `thi/id`. The situation adds the applied-log and
the strict-presence discipline on top of that substrate."
(:refer-clojure :exclude [apply-to])
(:require
[app.common.test-helpers.files :as thf]
[app.common.test-helpers.ids-map :as thi]
[app.common.types.shape-tree :as ctst]
[app.common.uuid :as uuid]
[clojure.string :as str]))
;; ---------------------------------------------------------------------------
;; Situation
;;
;; A situation wraps the in-memory Penpot file value together with the record of
;; what has been applied to it. The environment of *shape* bindings is the
;; global label->uuid map (reset per variant by the runners), so the situation
;; does not duplicate it; it only adds:
;; :file - the current in-memory file value
;; :applied-log - vector of application records, in application order
;; ---------------------------------------------------------------------------
;; resolve-shape is defined below (strict-presence section) but referenced by
;; role-shape above it; declare it so the forward reference resolves at load.
(declare resolve-shape)
(declare resolve-shape-id)
(defn make-situation
"Create a situation from an initial in-memory file value, optionally with role
bindings. Roles are meaningful named objects of the configuration the setup
built (e.g. :main-instance, :copy-instance), passed as shape *labels*. The
labels are resolved to ids IMMEDIATELY (at construction, while the labels are
freshly valid) and the situation stores the resolved ids. This is essential:
the global label->id map is time-varying and shared, so resolving a role label
later (e.g. in another enumerated variant's run) would be unsound; capturing
the id at setup time makes each situation resolve its roles against the file it
was built with, independent of the global map's later state.
The situation also carries:
:applied - ordered vector of operation ids, in application order
(so the full sequence is always recoverable from the situation)
:node-data - map of operation-id -> the record that operation
wrote about its own application (keyed by NODE IDENTITY, not by
a node-kind tag), so each node retrieves its own record."
([file] (make-situation file {}))
([file roles]
{:file file
;; resolve role labels to ids now, while the labels are valid
:roles (into {} (map (fn [[k label]] [k (thi/id label)])) roles)
:applied []
:node-data {}}))
(defn file
"The current in-memory file value of the situation."
[situation]
(:file situation))
(defn with-file
"Return a situation with its file value replaced (the threaded result of
applying a transformation through the production change pipeline)."
[situation file']
(assoc situation :file file'))
(defn with-aux-files
"Return a situation carrying AUXILIARY files (a map of file-id -> file value)
beyond the primary `:file`. Used by cross-file configurations (e.g. a copy in
the primary/current file whose main lives in a linked LIBRARY file): the
primary `:file` stays the current file the role accessors resolve against,
while the auxiliary files travel alongside so an interpreter can install them
too (e.g. into the frontend store's `:files`, so cross-file sync can run).
The primary file is NOT included here."
[situation files-by-id]
(assoc situation :aux-files files-by-id))
(defn aux-files
"The situation's auxiliary files (map of file-id -> file), or an empty map.
See `with-aux-files`."
[situation]
(get situation :aux-files {}))
;; ----- Node identity (central, no inheritance) -----------------------------
;;
;; Records are value-equal in Clojure, so two structurally-identical nodes would
;; collide as map keys. Each node therefore carries an explicit unique id under
;; the reserved key ::id, stamped at construction by `assign-id` (the single
;; thing every node constructor must call). The id machinery — stamping, and the
;; record/retrieve-by-id pair below — is implemented ONCE here and shared by all
;; nodes as plain functions; nodes never reimplement it, they just pass `this`.
(defn assign-id
"Stamp a fresh unique id onto a node record (reserved key ::id). Every node
constructor's final step. Returns the node."
[node]
(assoc node ::id (uuid/next)))
(defn node-id
"The unique id of a node."
[node]
(::id node))
;; ----- Self-description, keyed by node identity ----------------------------
(defn- node-kind
"A short readable kind name for a node, derived from its record type (no
per-node boilerplate, faithful to the actual type). E.g. a ChangeAttr record
yields \"change-attr\"."
[node]
(let [cls (or (some-> node type .-name (str/split #"\.") last)
"node")
;; CamelCase -> kebab-case
kebab (-> cls
(str/replace #"([a-z0-9])([A-Z])" "$1-$2")
(str/lower-case))]
kebab))
(defn record-application
"Record what an operation `node` did into `situation`, keyed by the node's
identity, and append its id to the ordered :applied sequence. `record` is an
arbitrary map describing the application; the node retrieves it later via
`node-data` by passing itself. The node's kind (from its type) is merged in
under ::kind so the application can be rendered (see `describe-applied`)
without the node needing to name itself. Both consumers (inspection methods,
undo) read through node identity and ignore the extra ::kind key."
[situation node record]
(-> situation
(update :applied conj (node-id node))
(assoc-in [:node-data (node-id node)] (assoc record ::kind (node-kind node)))))
(defn node-data
"The record that `node` wrote about its own application in `situation`, or nil
if it has not been applied. Keyed by node identity."
[situation node]
(get-in situation [:node-data (node-id node)]))
(defn applied-ids
"The ordered vector of operation ids applied to the situation (the full
sequence, recoverable from the situation)."
[situation]
(:applied situation))
(defn applied?
"Whether `operation` ran in this situation. Identity-based: true iff this exact
operation node (by its `::id`) recorded an application. Works through `optional`
/ `one-of`: a chosen alternative records itself under its own identity, so
querying with the raw operation answers correctly. Bind an operation to a value
ONCE and reuse it (in the composition AND in any `Test` that queries it), so the
id you ask about is the id that ran."
[situation operation]
(contains? (:node-data situation) (node-id operation)))
(defn- render-application
"Render one (non-choice) application record as a short human-readable string.
Content-agnostic: uses ::kind and the record's own fields."
[record]
(let [kind (::kind record)
args (dissoc record ::kind)]
(str kind (when (seq args) (str " " (pr-str args))))))
(defn describe-applied
"A human-readable, ordered transcript of the operations that produced
`situation` — one line per application, in order. Built purely from the
situation's recorded :applied ids and :node-data records (each node's own
self-description), so it is faithful to what actually ran, including the branch
a one-of chose. Used to label failures with the exact sequence at hand."
[situation]
(let [node-data (:node-data situation)]
(->> (:applied situation)
(keep (fn [id]
(let [record (get node-data id)]
(if (contains? record :chosen)
;; a one-of's choice record: if the chosen node recorded its
;; own application, its own line (also in :applied) already
;; tells the story — emit nothing to avoid a duplicate line.
;; Only a non-recording choice (a skipped `optional`) is
;; rendered here, so a skip stays visible in the transcript.
(let [chosen (:chosen record)]
(when-not (contains? node-data (::id chosen))
(str "one-of -> " (render-application {::kind (node-kind chosen)}))))
(render-application record)))))
(str/join "\n "))))
;; ----- Role accessors ------------------------------------------------------
;;
;; A setup records role bindings (meaningful named objects of the configuration)
;; as shape labels. `role-shape` resolves a role to the live shape in the current
;; file, with strict presence: an absent role throws diagnostically (never nil).
;; Specific named accessors (e.g. copy-instance) are thin wrappers, so tests read
;; `(copy-instance situation)` rather than knowing the role key.
(defn role-shape
"Resolve role `role-key` to the live shape in the situation's current file,
using the id captured at setup time. Throws a diagnostic error if the role is
not bound, or if its captured shape is no longer present in the current page
(e.g. it was deleted) — never returns nil silently."
[situation role-key]
(let [id (get-in situation [:roles role-key])
page (thf/current-page (file situation))]
(when (nil? id)
(throw (ex-info (str "Unbound role: " (pr-str role-key)
". Roles present: " (pr-str (vec (keys (:roles situation)))))
{:type ::unbound-role
:role role-key})))
(let [shape (ctst/get-shape page id)]
(when (nil? shape)
(throw (ex-info (str "Role " (pr-str role-key) " resolves to a shape no longer "
"present in the current page (id " (pr-str id) ").")
{:type ::role-shape-absent
:role role-key
:id id})))
shape)))
(defn has-role?
"Whether `role-key` is currently bound in the situation."
[situation role-key]
(contains? (:roles situation) role-key))
(defn shape-by-id
"The live shape with `id` in the situation's current page (nil if absent). For
reading a shape whose id is held outside the role map — e.g. a field of a
tracked component object."
[situation id]
(ctst/get-shape (thf/current-page (file situation)) 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
the configuration (e.g. `make-nested-component`) and must update where a role points so
that role-targeted operations keep acting on the intended shape."
[situation role-key label]
(assoc-in situation [:roles role-key] (thi/id label)))
(defn rebind-role-id
"Like `rebind-role`, but re-points `role-key` to a shape `id` directly (when the
operation discovered the shape by id, e.g. by following a :shape-ref chain,
rather than by label)."
[situation role-key id]
(assoc-in situation [:roles role-key] id))
;; ---------------------------------------------------------------------------
;; Situation vars — arbitrary named values beyond roles
;;
;; Roles name SHAPES (resolved from labels to ids). Some operations need to track
;; named values that are NOT shapes — e.g. a component id to instantiate next, or
;; a counter (nesting depth). Those live in a separate `:vars` map so they do not
;; get confused with shape roles. Set/read with `set-var`/`get-var`.
;; ---------------------------------------------------------------------------
(defn set-var
"Associate `k` with `v` in the situation's `:vars` (arbitrary named values that
are NOT shapes — e.g. a component id, a counter). Returns the situation."
[situation k v]
(assoc-in situation [:vars k] v))
(defn get-var
"Read the value of `k` from the situation's `:vars`, or `default` (nil if
omitted) when absent. See `set-var`."
([situation k] (get-var situation k nil))
([situation k default] (get-in situation [:vars k] default)))
(defn target-shape-id
"Resolve an operation's target to a shape id:
- a FUNCTION `(situation -> id)` is called with the situation (lets the target
be computed from situation state — e.g. a field of a tracked object —
resolved at apply-time so it follows state changes);
- a currently-bound ROLE resolves via the role (so the operation follows the
role as state-building ops re-point it);
- otherwise `target` is a label (strict-presence).
This is what makes a single operation composable across depth / with
make-nested-component et al."
[situation target]
(cond
(fn? target) (target situation)
(has-role? situation target) (:id (role-shape situation target))
:else (resolve-shape-id situation target)))
;; ---------------------------------------------------------------------------
;; Strict-presence lookup
;;
;; Resolving a binding name (shape label) that is absent must throw a DIAGNOSTIC
;; error: it names the absent binding and lists those present. A silently-nil
;; lookup is forbidden (it would make a declarative case a lie / a green test
;; that asserts against nothing). Acting on a present-but-wrong-kind binding is
;; left to crash naturally downstream.
;; ---------------------------------------------------------------------------
(defn resolve-shape
"Resolve a shape binding name (label) to the actual shape in the situation's
current page, throwing a diagnostic error if the name is not bound to a shape
that exists in that page. The diagnostic lists the labels of the shapes that
ARE present, derived from the file itself (not from a parallel binding map)."
[situation name]
(let [the-file (file situation)
page (thf/current-page the-file)
id (thi/id name)
shape (when id (ctst/get-shape page id))]
(when (nil? shape)
(let [present (->> (vals (:objects page))
(map (comp thi/label :id))
(sort)
(vec))]
(throw (ex-info (str "Unbound shape name: " (pr-str name)
". Shapes present in current page: " (pr-str present))
{:type ::unbound-shape-name
:name name
:present present}))))
shape))
(defn resolve-shape-id
"Resolve a shape binding name (label) to its uuid, with strict-presence
diagnostics (see `resolve-shape`)."
[situation name]
(:id (resolve-shape situation name)))
;; ---------------------------------------------------------------------------
;; Operation protocol
;;
;; An OPERATION is a step in a composition. Most operations TRANSFORM the
;; situation (an edit, a structural change, a nesting), but some do not (a `Test`
;; asserts and returns the situation unchanged; `Skip` is a no-op) — hence the
;; genus is "operation", not "transformation". An operation is reified as DATA (a
;; record), not a bare function, so it is printable and navigable. `apply-to`
;; takes the operation and a situation and returns a (possibly identical)
;; situation; it may also record its own application. The method cannot be named
;; `apply` (core clash).
;; ---------------------------------------------------------------------------
(defprotocol IOperation
(apply-to [operation situation]
"Apply this operation to `situation`, returning a (possibly identical)
situation."))
;; ---------------------------------------------------------------------------
;; Enumeration
;;
;; A composed operation may stand for MANY concrete cases (because `one-of`
;; offers alternatives). Enumeration turns one composed operation into the
;; sequence of fully-concrete operations it represents — each of which has
;; no remaining choice and can be `apply-to`'d directly.
;;
;; Enumeration is a generic-engine concern: only the composition operators
;; (`in-sequence`, `one-of`) implement it. Leaf/subject operations (e.g. the
;; component nodes) need not know about it — the top-level `enumerate` falls back
;; to "an operation with no choice enumerates to itself", so a plain node yields a
;; single variant (itself). This keeps `apply-to` and `enumerate` orthogonal and
;; keeps the `comp` node library free of enumeration code.
;; ---------------------------------------------------------------------------
(defprotocol IEnumerable
(-enumerate [operation]
"Return a sequence of fully-concrete operations this one represents."))
(defn enumerate
"The concrete operations represented by `operation`. Falls back to a single
variant (the operation itself) for anything that does not implement
IEnumerable (i.e. leaf operations with no internal choice)."
[operation]
(if (satisfies? IEnumerable operation)
(-enumerate operation)
[operation]))
;; ---------------------------------------------------------------------------
;; Composition operator: sequence
;;
;; A `Sequence` holds an ordered vector of child operations and applies them
;; left-to-right, THREADING the situation through each: the situation returned
;; by one child is the input to the next. Operations do not commute, so order
;; is explicit. Its enumeration is the CARTESIAN PRODUCT of its children's
;; variants (with single-variant children this is exactly one Sequence), which
;; is what makes a `one-of`/`optional` composed inside a sequence multiply the
;; case out into a matrix.
;;
;; The constructor is named `in-sequence` because `sequence` is a clojure.core
;; name and must not be shadowed.
;; ---------------------------------------------------------------------------
(declare ->Sequence)
(defrecord Sequence [steps]
IOperation
(apply-to [_ situation]
(reduce (fn [sit step] (apply-to step sit))
situation
steps))
IEnumerable
(-enumerate [_]
;; Cartesian product: every combination of one concrete variant per step,
;; each combination rewrapped as a concrete Sequence. With single-variant
;; steps this yields exactly one Sequence (the all-singletons case).
(->> steps
(map enumerate) ; step -> seq of concrete variants
(reduce (fn [acc step-variants]
(for [combo acc
variant step-variants]
(conj combo variant)))
[[]]) ; seed: one empty combination
(map ->Sequence))))
(defn in-sequence
"Constructor for the sequence operator: apply `steps` (a seq of
transformations) in order, threading the situation through each."
[steps]
(->Sequence (vec steps)))
;; ---------------------------------------------------------------------------
;; Composition operator: one-of
;;
;; `one-of` offers a set of alternative transformations: it represents N cases,
;; one per alternative. It is a pure *enumeration* construct — it has no single
;; apply semantics, because applying it would mean arbitrarily picking one
;; alternative. So `apply-to` on a raw OneOf is an error; it must be enumerated
;; first (the runner does this). Its `-enumerate` is the UNION of its
;; alternatives' enumerations, so `one-of` composed inside `in-sequence`
;; multiplies out correctly via the sequence's cartesian product.
;; ---------------------------------------------------------------------------
(defrecord RecordedChoice [one-of-id chosen]
;; Internal node produced by OneOf enumeration. Applying it records, under the
;; originating one-of's identity, which alternative was chosen, then applies
;; that alternative. This is how `get-choice` (read by the test holding the
;; one-of) recovers the choice from the resulting situation. It is already
;; concrete, so it enumerates to itself.
IOperation
(apply-to [_ situation]
(-> situation
(assoc-in [:node-data one-of-id] {:chosen chosen})
(update :applied conj one-of-id)
(->> (apply-to chosen))))
IEnumerable
(-enumerate [this] [this]))
(defrecord OneOf [alternatives]
IOperation
(apply-to [_ _]
(throw (ex-info (str "OneOf cannot be applied directly; it represents a choice "
"and must be enumerated first (the runners do this via `enumerate`).")
{:type ::one-of-applied-directly
:alternative-count (count alternatives)})))
IEnumerable
(-enumerate [this]
;; Each alternative may itself enumerate to several concrete variants; every
;; resulting concrete variant is wrapped so that, when applied, it records
;; this one-of's choice under this one-of's identity.
(for [alt alternatives
variant (enumerate alt)]
(->RecordedChoice (node-id this) variant))))
(defn one-of
"Constructor for the one-of operator: represents one case per alternative in
`alternatives`. Used to sweep a set of variants (e.g. several attribute
changes) across an otherwise-shared case. Carries an identity so the choice it
made in a given enumerated run can be recovered via `get-choice`."
[alternatives]
(assign-id (->OneOf (vec alternatives))))
(defrecord Skip []
IOperation
(apply-to [_ situation] situation)
IEnumerable
(-enumerate [self] [self]))
(defn skip
"The identity operation: applies as a no-op, enumerates to itself. The building
block of `optional`."
[]
(->Skip))
(defrecord Test [assert-fn]
;; An operation that makes ASSERTIONS at this point in the sequence and leaves
;; the situation unchanged. `assert-fn` is a (situation -> any) that performs the
;; assertions itself (e.g. calls `t/is`), exactly like an external asserter — so
;; checks can be placed at INTERMEDIATE steps, not only at the end. It records
;; its application (so the transcript shows where checkpoints sit) but changes
;; nothing. Concrete, so it enumerates to itself.
IOperation
(apply-to [this situation]
(assert-fn situation)
(record-application situation this {}))
IEnumerable
(-enumerate [self] [self]))
(defn test-that
"Constructor for an inline `Test` operation. `assert-fn` is a (situation -> any)
that performs assertions (it is run for side effects; its return is ignored).
Place it inside an `in-sequence` to assert at that point in the trajectory.
Typically queries `applied?`/`get-choice`/`has-property-of` to decide what to
assert for the current enumerated variant."
[assert-fn]
(assign-id (->Test assert-fn)))
(defn optional
"`(optional t)` = `(one-of [t (skip)])`: sweeps WITH and WITHOUT `t` across a
case (two enumerated variants). Kept as its own named constructor for
readability. The workhorse for adding a state-building step (e.g.
`(optional (make-nested-component))`) as an axis over an existing case."
[t]
(one-of [t (skip)]))
(defn get-choice
"The alternative this `one-of` chose in `situation` (the concrete transformation
that actually ran for this branch), or nil if it did not run in this variant.
Recovered by node identity, so the test holds the one-of and asks it."
[situation one-of]
(:chosen (node-data situation one-of)))
;; ---------------------------------------------------------------------------
;; Executors
;;
;; Build a fresh situation from a setup thunk and apply a (possibly composed)
;; OPERATION. `run-variant` runs one already-concrete variant; `run-all`
;; enumerates a composed operation and runs every variant. Neither makes a
;; judgment or touches clojure.test — `check` (in
;; `frontend-tests.composable-tests.interpreter`) is the test-facing entry point. (Assertions can also live INSIDE the operation, via
;; `Test`; those fire as the operation is applied.)
;; ---------------------------------------------------------------------------
(defn run-variant
"Run one concrete (already-enumerated) variant: build a fresh situation via
`setup` (a 0-arg fn returning a *situation*) and apply `operation`,
returning the resulting situation. Makes no judgment. Exceptions propagate.
This is the per-variant step `check` builds on; tests use `check`, not this."
[{:keys [setup operation]}]
(->> (setup)
(apply-to operation)))
(defn run-all
"Enumerate `operation` into its concrete variants and run each (fresh setup
per variant, isolated label space — the id map is reset before each variant's
setup so per-variant setups don't clobber labels). Returns a vector of the
resulting situations, one per enumerated variant, in enumeration order. Makes
no judgment and does not touch clojure.test — see `check` (in
`frontend-tests.composable-tests.interpreter`) for the test-facing entry point that asserts."
[{:keys [setup operation]}]
(->> (enumerate operation)
(mapv (fn [variant]
(thi/reset-idmap!)
(run-variant {:setup setup
:operation variant})))))
(defn sequence-ops
"Flatten a CONCRETE (already-enumerated) operation into its ordered units.
Used by alternative interpreters (e.g. the frontend one) that dispatch
per-operation effects rather than calling `apply-to`.
A concrete variant is a single operation record, or a `Sequence` of them, with
`RecordedChoice` (the enumerated form of a one-of) appearing where a one-of was.
`Sequence` is flattened; a `RecordedChoice` is KEPT as a unit (it carries both
the chosen operation and the one-of identity, so a per-op interpreter can
dispatch the chosen op's effect AND record the choice for `get-choice`). Use
`recorded-choice?`, `choice-of`, and `choice-one-of-id` to handle those units."
[variant]
(cond
(instance? Sequence variant)
(vec (mapcat sequence-ops (:steps variant)))
:else
[variant]))
(defn recorded-choice?
"True if `op` is a one-of's enumerated choice wrapper."
[op]
(instance? RecordedChoice op))
(defn choice-of
"The concrete operation a `RecordedChoice` selected."
[recorded-choice]
(:chosen recorded-choice))
(defn choice-one-of-id
"The identity of the one-of that produced this `RecordedChoice` (so a per-op
interpreter can record the choice under it, enabling `get-choice`)."
[recorded-choice]
(:one-of-id recorded-choice))

471
frontend/test/frontend_tests/composable_tests/interpreter.cljs Normal file
View File

@ -0,0 +1,471 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) KALEIDOS INC Sucursal en España SL
(ns frontend-tests.composable-tests.interpreter
"FRONTEND interpreter + test-facing `check` for the composable test model.
The generic engine lives in `frontend-tests.composable-tests.core` and the
component instruments (operation records, setups, role accessors, inspection
methods) behind the `comp` boundary. What lives HERE is:
1. `op->events` — the event realisation of each EVENT-op: the real
workspace event(s) it dispatches (it depends on
`app.main.data.workspace.*`).
2. an ASYNC interpreter that drives a sequence of operations through the REAL
app: it installs the situation's file into the global store, starts the
real component-change watcher, then for each operation dispatches its
event(s) and AWAITS settlement (so the app's AUTOMATIC propagation — not a
manual sync — is what runs), re-reading the file from the store after each.
3. `check` — the test-facing entry: takes {:setup :operation} + an OPTIONAL
asserter; enumerates the operation and runs each variant; assertions may
be inline (`Test` ops) and/or in the asserter.
IN-FILE PROPAGATION IS AUTOMATIC: there is no propagate operation. The watcher
(`dwl/watch-component-changes`), running on the global store, detects
main-instance changes in the CURRENT file and syncs that file's copies on its
own. That automatic behaviour is precisely what the cases exercise. The one
deliberate exception is CROSS-FILE propagation (case H): when the main lives
in a linked LIBRARY and the copy in the consuming file, the watcher does NOT
cross the file boundary — the real app propagates via the library-UPDATE
action, so the `SyncFromLibrary` op explicitly dispatches `sync-file` (this is
faithful: it is exactly the user action, not a test shortcut). See
`mem:frontend/composable-component-tests`.
NOTE on the store: this uses the GLOBAL `st/state` store (not the isolated
`setup-store`), because the watcher reads `refs/workspace-data` which derives
from `st/state`. State is re-installed per variant for isolation."
(:require
[app.common.test-helpers.files :as cthf]
[app.common.test-helpers.ids-map :as cthi]
[app.common.test-helpers.shapes :as cths]
[app.main.data.changes :as dch]
[app.main.data.workspace.libraries :as dwl]
[app.main.data.workspace.shapes :as dwsh]
[app.main.data.workspace.thumbnails :as dwth]
[app.main.data.workspace.undo :as dwu]
[app.main.data.workspace.variants :as dwv]
[app.main.store :as st]
[beicon.v2.core :as rx]
[cljs.test :as t]
[frontend-tests.composable-tests.comp.nodes :as n]
[frontend-tests.composable-tests.core :as tm]
[potok.v2.core :as ptk]))
;; --------------------------------------------------------------------------
;; (0) Thumbnail rendering — disabled in this headless suite
;;
;; The propagation watcher we start (`dwl/watch-component-changes`) ALSO schedules
;; THUMBNAIL renders on every component change (its `component-changed` event has a
;; thumbnail branch). Thumbnail rendering reaches `app.util.dom/get-css-variable`,
;; which calls `window.getComputedStyle` — and there is no `window` in the headless
;; runner, so a (queued, async) render fires LATER and crashes the run. Thumbnails
;; are pure UI side-effect, irrelevant to what we test, so we stub the public seam
;; `dwth/update-thumbnail` to a no-op event for the duration of OUR tests (installed
;; / restored by a `:each` fixture in the case namespace — the same `set!`-and-
;; restore pattern as `frontend_tests.helpers.wasm`, whose `:after` correctly runs
;; only after each async test's `done`). Scope is thus our suite only.
;; --------------------------------------------------------------------------
(defonce ^:private original-update-thumbnail (atom nil))
(defn- noop-thumbnail-event []
(ptk/reify ::noop-thumbnail
ptk/WatchEvent
(watch [_ _ _] (rx/empty))))
(defn install-thumbnail-noop!
"Replace `dwth/update-thumbnail` with a no-op event so no thumbnail rendering
runs (it would reach `window`, absent headless). Restore with
`restore-thumbnail!`. Idempotent."
[]
(when (nil? @original-update-thumbnail)
(reset! original-update-thumbnail dwth/update-thumbnail)
(set! dwth/update-thumbnail (fn [& _] (noop-thumbnail-event)))))
(defn restore-thumbnail!
"Restore the real `dwth/update-thumbnail` saved by `install-thumbnail-noop!`."
[]
(when-let [orig @original-update-thumbnail]
(set! dwth/update-thumbnail orig)
(reset! original-update-thumbnail nil)))
;; --------------------------------------------------------------------------
;; (1) Frontend realisation of operations: op record -> workspace event(s)
;;
;; The operation's "what" (its update-fn / target) is shared in common; this maps
;; it to the "how" on the frontend — the real event a user interaction dispatches.
;; Returns a vector of events to emit for that operation.
;; --------------------------------------------------------------------------
;; The edit a ChangeProperty performs is the SHARED `n/set-property`, so the
;; frontend applies the identical change the common node does (only the wrapping
;; differs: a real workspace event here vs. apply-changes there).
(defn- add-child->shape
"Build the shape value AddChild introduces, parented under the target parent in
the current store page (mirrors the common add-child's sample shape). Returns
the shape with parent/frame set to the target parent."
[parent-label new-label shape-params]
(let [parent-id (cthi/id parent-label)
shape (cths/sample-shape new-label (or shape-params {}))]
(assoc shape
:parent-id parent-id
:frame-id parent-id)))
(defn op->events
"Map a comp operation record to the real workspace event(s) it dispatches.
`op` is one of the comp node records (frontend-tests.composable-tests.comp.nodes);
`situation` provides cross-file context (e.g. the library id) for ops that need
it.
Each operation is realised with the SAME production change builder the common
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)
MoveChild -> relocate-shapes (generate-relocate, existing shape)
AddChild -> add-shape (create a shape under the parent)
RemoveChild -> delete-shapes (generate-delete-shapes)
SyncFromLibrary -> sync-file (the cross-file library-update action, H)
Undo -> dwu/undo (reverse the previous operation(s), I)
(In-file propagation is automatic — the watcher — so no propagate op exists.)"
[op situation]
(cond
(instance? n/ChangeProperty op)
(let [{:keys [target property value]} op]
;; `target` may be a ROLE (resolved via the situation, so the edit follows
;; the role as make-nested-component re-points it) or a label — same dual resolution
;; as the common ChangeProperty. The edit uses the SHARED `n/set-property`.
[(dwsh/update-shapes #{(tm/target-shape-id situation target)}
(fn [shape] (n/set-property shape property value)))])
(instance? n/SwapComponent op)
;; Swap lineage `name`'s nesting level `level` for lineage `target`'s component
;; via the REAL swap event (dwl/component-swap), so it commits through the
;; normal path and the watcher AUTOMATICALLY propagates the swap to copies
;; (incl. the deeper nesting levels). This is the behaviour under test.
(let [{:keys [name level target keep-touched?]} op
file-id (:id (tm/file situation))
nested (n/lineage-nesting situation name level)
shape (tm/shape-by-id situation (:nested-head nested))
target-id (n/lineage-component-id situation target)]
[(dwl/component-swap shape file-id target-id (boolean keep-touched?))])
(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
;; `variants-switch` event (which discovers the sibling in the variant container
;; and routes through component-swap keep-touched? true, so the watcher
;; auto-propagates the switch across nesting levels exactly like a swap). `target`
;; uses the standard resolution (role | label | (situation -> id) fn), so the op
;; is structure-blind.
(let [{:keys [target value]} op
head-id (tm/target-shape-id situation target)
shape (tm/shape-by-id situation head-id)]
[(dwv/variants-switch {:shapes [shape] :pos 0 :val value})])
(instance? n/MoveChild op)
(let [{:keys [target parent to-index]} op]
[(dwsh/relocate-shapes #{(cthi/id target)} (cthi/id parent) to-index)])
(instance? n/RemoveChild op)
(let [{:keys [target]} op]
[(dwsh/delete-shapes #{(cthi/id target)})])
(instance? n/AddChild op)
(let [{:keys [parent new-label shape-params]} op]
[(dwsh/add-shape (add-child->shape parent new-label shape-params)
{:no-select? true})])
(instance? n/SyncFromLibrary op)
;; The cross-file library-update action: sync the current (consuming) file
;; from its linked library — exactly what the "library updated" dialog does.
(let [file-id (:current-file-id @st/state)
library-id (first (keys (tm/aux-files situation)))]
[(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]
:else
(throw (ex-info (str "op->events: no frontend realisation for " (pr-str (type op)))
{:op op}))))
;; --------------------------------------------------------------------------
;; (2) Async interpreter
;; --------------------------------------------------------------------------
(def ^:private settle-debounce-ms
"Resolve a step once the store's commit stream has been idle this long. This
captures the edit commit AND the watcher's follow-up sync commit, without a
fixed total delay. (Provisional: a fully deterministic per-op stopper would
await that op's specific component-changed/sync; debounce-idle is robust enough
for now.)"
60)
(def ^:private settle-timeout-ms 2000)
(defn- install-situation-event
"An UpdateEvent installing the situation's files into the (global) store: the
primary file as the current/workspace file, plus any AUXILIARY files (e.g. a
linked library, for the cross-file case H) alongside in `:files`, each tagged
`:library-of` the current file so the library-sync machinery treats them as
linked libraries."
[situation]
(let [file (tm/file situation)
aux (tm/aux-files situation)]
(ptk/reify ::install-file-event
ptk/UpdateEvent
(update [_ state]
(assoc state
:current-file-id (:id file)
:current-page-id (cthf/current-page-id file)
:permissions {:can-edit true}
:files (into {(:id file) file}
(map (fn [[lib-id lib]] [lib-id (assoc lib :library-of (:id file))]))
aux))))))
(defn- current-file
"Read the live workspace file out of the global store."
[]
(let [st @st/state]
(get-in st [:files (:current-file-id st)])))
(defn- await-settle
"Dispatch `events` into the global store, then call `k` once the commit stream
has gone idle (debounced). A hard timeout guarantees progress."
[events k]
(let [stream (ptk/input-stream st/state)
commits (->> stream (rx/filter dch/commit?))
;; resolve on first idle gap after a commit, or on timeout
settled (->> commits
(rx/debounce settle-debounce-ms)
(rx/take 1)
(rx/timeout settle-timeout-ms (rx/of :settle/timeout)))]
(rx/subscribe settled (fn [_] (k)))
(doseq [e events] (st/emit! e))))
(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
chosen op's application AND the choice under the one-of identity (so the
asserter's `get-choice` works), mirroring `RecordedChoice`'s own `apply-to`."
[situation op]
(let [situation (tm/with-file situation (current-file))]
(if (tm/recorded-choice? op)
(let [chosen (tm/choice-of op)
descriptor (dissoc (into {} chosen) :frontend-tests.composable-tests.core/id)]
(-> situation
;; record the chosen op under its own identity …
(tm/record-application chosen descriptor)
;; … and the choice under the one-of's identity, keyed for get-choice
(update :node-data assoc (tm/choice-one-of-id op) {:chosen chosen})
(update :applied conj (tm/choice-one-of-id op))))
(let [descriptor (dissoc (into {} op) :frontend-tests.composable-tests.core/id)]
(tm/record-application situation op descriptor)))))
(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))
(defn- install-file-event
"An UpdateEvent that replaces the current file in the (global) store with `file`
(keeping aux files and everything else). Used to write back the result of a
FILE-TRANSFORMING op (see `file-op?`)."
[file]
(ptk/reify ::install-file
ptk/UpdateEvent
(update [_ state]
(-> state
(assoc :current-file-id (:id file)
:current-page-id (cthf/current-page-id file))
(assoc-in [:files (:id file)] file)))))
(defn- sync-op?
"Whether `op` is a SYNCHRONOUS, `apply-to`-based operation rather than one that
dispatches a workspace event and needs settling. Two kinds:
- FILE-TRANSFORMING (`make-nested-component`, `skip`): a pure file-value transformation
that arranges the CONFIGURATION (deepens it, re-points roles) — applied by
running `apply-to` against the live store file and writing the result back.
The property under test is still exercised by the SUBSEQUENT real-event ops.
- `Test`: an inline assertion checkpoint — its `apply-to` runs the assertion
against the current situation and returns it unchanged.
Both are handled by `run-sync-op` (no async settle — any store write is a
synchronous UpdateEvent)."
[op]
(let [op (if (tm/recorded-choice? op) (tm/choice-of op) op)]
(or (instance? n/MakeNestedComponent op)
;; the structural building blocks are also file-transforming: they arrange
;; the configuration via the shared `apply-to`. ResetCopyInstance is also a
;; file-op: 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/CreateComponent op)
(instance? n/InstantiateCopy op)
(instance? n/ResetCopyInstance op)
;; the variant container (test-helper assembly) and variant nesting (the
;; shared nesting helper) are file-transforming sync-ops; the SWITCH is the
;; real `variants-switch` workspace event (handled by op->events), not here.
(instance? n/MakeVariantContainer op)
(instance? n/MakeNestedComponentWithVariant op)
(instance? tm/Skip op)
(instance? tm/Test op))))
(defn- run-sync-op
"Apply a synchronous (`sync-op?`) operation: run its shared `apply-to` against a
situation whose `:file` is the live store file, write the resulting file back
into the store, and return the updated situation (with any re-pointed roles).
For `Test` this runs the inline assertion (against the live store state) and the
file is unchanged; for `make-nested-component`/`skip` it writes back the transformed file.
Synchronous."
[situation op]
(let [op' (if (tm/recorded-choice? op) (tm/choice-of op) op)
situation (tm/with-file situation (current-file))
situation (tm/apply-to op' situation)]
(st/emit! (install-file-event (tm/file situation)))
;; record the choice too, if this came wrapped in a one-of
(if (tm/recorded-choice? op)
(-> situation
(update :node-data assoc (tm/choice-one-of-id op) {:chosen op'})
(update :applied conj (tm/choice-one-of-id op)))
situation)))
(defn- op-grace-ms
"Extra wait AFTER an event-op has settled, before proceeding. Zero for all ops
except `SyncFromLibrary`: the production `sync-file` event additionally
schedules `rx/timer 3000` + an `:update-file-library-sync-status` RPC. There is
no backend in the headless runner, so that delayed call fails (benignly) — but
3s after the sync it would land INSIDE whatever test is then running, leaking
an error trace across test boundaries (and historically destabilising
whole-suite runs). Waiting it out here absorbs the failure within the test that
caused it."
[op]
(let [op (if (tm/recorded-choice? op) (tm/choice-of op) op)]
(if (instance? n/SyncFromLibrary op) 3200 0)))
(defn- run-ops
"Async fold over `ops` (concrete operation units, in order — plain ops and/or
one-of RecordedChoice wrappers). Threads the situation. A SYNCHRONOUS op
(`sync-op?` — file-transforming or an inline `Test`) is applied synchronously
via `apply-to`; every other op dispatches its real workspace event(s) and awaits
settlement (plus a per-op grace period, see `op-grace-ms`). The file is re-read
from the store after each. Calls `k` with the final situation."
[situation ops k]
(if (empty? ops)
(k situation)
(let [op (first ops)]
(if (sync-op? op)
(run-ops (run-sync-op situation op) (rest ops) k)
(await-settle
(op-events op situation)
(fn []
(let [continue #(run-ops (record-op situation op) (rest ops) k)
grace (op-grace-ms op)]
(if (pos? grace)
(js/setTimeout continue grace)
(continue)))))))))
(defn- watch-undo-stack
"Maintain the workspace UNDO STACK in the (global) store, mirroring the
production subscription in `app.main.data.workspace/initialize-workspace`:
for every local commit with `save-undo?` and non-empty `:undo-changes`, dispatch
`dwu/append-undo`. We start this in the harness because the minimal store setup
does not run the full `initialize-workspace` (which is where the real app wires
it). Re-emitting this event stops any previous instance (so re-install per
variant does not stack watchers)."
[]
(ptk/reify ::watch-undo-stack
ptk/WatchEvent
(watch [_ _ stream]
(let [stopper-s (->> stream (rx/filter (ptk/type? ::watch-undo-stack)))]
(->> stream
(rx/filter dch/commit?)
(rx/map deref)
(rx/filter #(= :local (:source %)))
(rx/mapcat
(fn [{:keys [save-undo? undo-changes redo-changes undo-group tags stack-undo? selected-before]}]
(if (and save-undo? (seq undo-changes))
(rx/of (dwu/append-undo
{:undo-changes undo-changes
:redo-changes redo-changes
:undo-group undo-group
:tags tags
:selected-before selected-before}
stack-undo?))
(rx/empty))))
(rx/take-until stopper-s))))))
(defonce ^:private original-store
;; Captured at namespace-LOAD time — i.e. before any test in the run executes.
;; Several test namespaces (the plugins suite) `set!` st/state / st/stream to
;; isolated stores and never restore them. That silently kills this harness:
;; the refs in `app.main.refs` (through which `watch-component-changes`
;; observes commits) are okulary lenses bound to THIS atom instance at load
;; time, so once the var points elsewhere, our events commit to a store the
;; watcher does not see and propagation dies with no error. Re-installing the
;; original per variant makes the harness immune to run order.
{:state st/state :stream st/stream})
(defn- restore-global-store!
"Point st/state / st/stream back at the load-time originals (see
`original-store`)."
[]
(set! st/state (:state original-store))
(set! st/stream (:stream original-store)))
(defn- run-variant
"Set up one variant on the global store and run its ops. `setup` returns a
situation (file + roles). Restores the global store (a preceding namespace may
have swapped it), installs the file + starts the watcher, then folds the ops.
Calls `k` with the final situation."
[setup ops k]
;; fresh label space per variant (mirrors the pure `tm/run-all`)
(cthi/reset-idmap!)
(restore-global-store!)
(let [situation (setup)]
(st/emit! (install-situation-event situation))
(st/emit! (dwl/watch-component-changes))
(st/emit! (watch-undo-stack))
(run-ops situation ops k)))
;; --------------------------------------------------------------------------
;; (3) Test-facing check
;; --------------------------------------------------------------------------
(defn check
"Frontend `check`: run `case-map` ({:setup :operation}) through the REAL app and,
if `asserter` is given, apply it (a situation -> any fn performing assertions)
to the resulting situation of EACH enumerated variant. Async — `done` is the
cljs.test async callback and MUST be called when finished.
Assertions may be INLINE (via `Test` operations in the `:operation` sequence,
firing as the op runs) and/or via the trailing `asserter`; `asserter` is
optional (omit when all assertions are inline). The asserter closes over node
references the test holds (e.g. `has-property-of` on a change node). In-file
propagation is AUTOMATIC (the watcher) — no propagate op is added.
Arities: `(check done case-map)` or `(check done case-map asserter)`."
([done case-map] (check done case-map nil))
([done {:keys [setup operation]} asserter]
(let [variants (tm/enumerate operation)]
(letfn [(run-next [vs]
(if (empty? vs)
(done)
(run-variant
setup
;; a variant is a composed operation; flatten to its ordered leaf
;; ops. `enumerate` already removed all one-of choices, so the
;; variant is a Sequence (or a single op).
(tm/sequence-ops (first vs))
(fn [situation]
(when asserter
(t/testing (str "operations:\n " (tm/describe-applied situation))
(asserter situation)))
(run-next (rest vs))))))]
(run-next variants)))))

8
frontend/test/frontend_tests/helpers/wasm.cljs
View File

@ -202,9 +202,13 @@
(set! wasm.fonts/get-content-fonts mock-get-content-fonts))
(defn teardown-wasm-mocks!
"Restore the original WASM functions saved by `setup-wasm-mocks!`."
"Restore the original WASM functions saved by `setup-wasm-mocks!`.
No-op when there is nothing to restore (`originals` empty): restoring from an
empty snapshot would `set!` every WASM function to nil, breaking any later
code that calls them (e.g. a leaked debounced event firing during a
subsequent test namespace)."
[]
(let [orig @originals]
(when-let [orig (not-empty @originals)]
(set! wasm.api/initialized? (:initialized? orig))
(set! wasm.api/use-shape (:use-shape orig))
(set! wasm.api/calculate-position-data (:calculate-position-data orig))

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

@ -6,6 +6,7 @@
[clojure.tools.cli :refer [parse-opts]]
[frontend-tests.basic-shapes-test]
[frontend-tests.code-gen-style-test]
[frontend-tests.composable-tests.comp.sync-test]
[frontend-tests.copy-as-svg-test]
[frontend-tests.data.nitrate-test]
[frontend-tests.data.repo-test]
@ -79,6 +80,7 @@
(def test-namespaces
['frontend-tests.basic-shapes-test
'frontend-tests.code-gen-style-test
'frontend-tests.composable-tests.comp.sync-test
'frontend-tests.copy-as-svg-test
'frontend-tests.data.nitrate-test
'frontend-tests.data.repo-test