;; 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.transforms :as dwt] [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/Rotate op) ;; The real sidebar rotation event, absolute mode: rotates the shape (and its ;; whole subtree) around its center. Its apply-modifiers step runs the ;; placement-vs-override classification for component copies (check-delta), ;; which is part of what a case using `rotate` exercises. (let [{:keys [target angle]} op] [(dwt/increase-rotation [(tm/target-shape-id situation target)] angle)]) (instance? n/ChangeHeight op) ;; The real sidebar dimension event. (let [{:keys [target value]} op] [(dwt/update-dimensions [(tm/target-shape-id situation target)] :height 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)))))