🐛 Preserve file destinations through undo and redo

Keep a namespaced file destination on each history change. Replay changes
in order in their target files, including stacked entries and transactions.
Keep payload fields named file-id intact, such as set-tokens-source (F111).

Snapshot the current file and every library in both composable runners.
Name the file in failure signatures; normalize the server synced-at status
stamp alongside modified-at. Update golden cases H and AP for this exclusion.
The library update regression checks both files through undo and redo and
failed against the old code.

Common JVM: 1705 tests; JS: 1633; frontend: 1495; backend: 1610; exporter: 14.
All pass, with lint and formatting checks for both changed modules.

Benchmark vs Phase 1e (lower quantile, ms):
world                 baseline     now   ratio
main-10                  1.790   0.993    0.55
main-100                15.415   9.038    0.59
main-1000              153.086  90.145    0.59
three-levels            35.215  18.989    0.54
chain                   68.931  35.045    0.51
library-500             83.083  85.830    1.03
many-shapes              4.837   3.344    0.69
variant-100             32.052  33.586    1.05
All worlds pass the 10% regression threshold.

AI-assisted-by: GPT-6
This commit is contained in:
alonso.torres 2026-10-22 14:37:48 +02:00
parent 9fbc7dd818
commit a3d75b0e45
11 changed files with 108 additions and 48 deletions

View File

@ -117,7 +117,7 @@ Two pure runners (no store, JVM + CLJS):
`common-tests.logic.composable-runner-test`.
- Undo/redo round trip (`comp/undo_check.cljc`, alias `uc`), on by default in the pure runner
(`:undo-check?`): after each `:user` step that pushed a group, undo must give back the
normalized file before it and redo the file after it (the variant continues from the redone
normalized files before it and redo the files after it (the variant continues from the redone
file); a user step that pushed nothing must change nothing (`:no-undo-entry`); at the end,
undo back to the last assembly step (the baseline; a case's own undo below it moves it) and
redo all. Files compare through `app.common.test-helpers.normalize` (`thn/normalize-file`:
@ -137,6 +137,11 @@ Two pure runners (no store, JVM + CLJS):
workspace undo index (`:undo-index`/`:redo-index` phases): a step must add exactly one undo
entry or group. File installs (assembly ops) are its baselines; a skipped optional and an inline `Test` are not. The interpreter
empties `:workspace-undo` per variant. Frontend snapshots drop `:position-data` under WASM.
Both runners use `uc/snapshot-files` for the current file and every
auxiliary/library file. File differences prefix signatures with
`[:file <label> ...]`. Normalization also drops library `:synced-at`,
a server status stamp rather than design data. `ftm/snapshot` exposes
the same snapshot to cross-file undo regressions.
Undo groups get lost in derived work: `initialize-shape-layout` buffers `:layout/update`
without its `:undo-group` (F43), so a swap's reflow lands in entries of its own. Match
steps by node identity, never by record type or rendered name: `n/MoveChild` does not resolve

View File

@ -24,6 +24,11 @@
with its prior file data. The component watcher syncs each transition
before the next user commit, keeping undo groups adjacent. Its barrier
remains open through the event turn. Foreign file cascades stay in common.
- Undo changes carry `:app.main.data.workspace.undo/file-id`, separate from
change payload fields named `:file-id` (e.g. `:set-tokens-source`). Undo
and redo replay consecutive runs per destination in order; old entries
without the routing key use the current file. Stacking and transactions
keep these keys on each change.
- Layout batches cross an `:asap` boundary before reflow so synchronous
component sync cannot emit into the buffer being closed and lose a task.
- Persistence buffers local commits: status becomes pending after about 200ms, commits are flushed after about 3s or `::force-persist`, and buffered commits are merged per file before `:update-file`.
@ -49,4 +54,4 @@
- `refs/libraries` is explicitly deprecated for performance; prefer derefing `refs/files` and memoizing `select-libraries` in components.
- `refs/workspace-page-objects` uses `identical?` equality, so preserving object map identity matters for avoiding derived-ref churn.
- Selected-shapes refs use a small `{objects selected}` wrapper with custom equality before running `process-selected`; avoid bypassing that pattern in hot UI paths.
- Selected-shapes refs use a small `{objects selected}` wrapper with custom equality before running `process-selected`; avoid bypassing that pattern in hot UI paths.

View File

@ -213,7 +213,8 @@
(defn- snapshot
[situation]
(uc/snapshot (tm/file situation)))
(let [file (tm/file situation)]
(uc/snapshot-files (assoc (tm/aux-files situation) (:id file) file))))
(defn- attempt
"`[(f) nil]`, or `[nil error]` when `f` throws."

View File

@ -56,6 +56,12 @@
([file] (snapshot file {}))
([file opts] (thn/normalize-file file opts)))
(defn snapshot-files
"The normalized files affected by a step, including linked libraries."
([files] (snapshot-files files {}))
([files opts]
{:files (into {} (map (fn [[id file]] [id (snapshot file opts)])) files)}))
(defn mark-baseline
"Record the state the end-of-variant round trip undoes back to: the
normalized file `snap` with `depth` undo groups on the stack."
@ -141,17 +147,24 @@
`[:data key]` / `[:file key]` for anything else. Shapes without a test
label are `:unlabelled`."
[expected actual]
(let [ed (:data expected)
ad (:data actual)]
(-> #{}
(into (map #(vector :file %)) (differing-keys expected actual #{:data}))
(into (map #(vector :data %)) (differing-keys ed ad #{:pages-index :components}))
(into (entities-signature :page (:pages-index ed) (:pages-index ad) #{:objects}
(fn [e a]
(entities-signature :object (:objects e) (:objects a)
#{} (constantly nil)))))
(into (entities-signature :component (:components ed) (:components ad)
#{} (constantly nil))))))
(if (or (contains? expected :files) (contains? actual :files))
(into #{}
(mapcat (fn [id]
(map #(into [:file (label-of id)] %)
(signature (get-in expected [:files id])
(get-in actual [:files id])))))
(into (set (keys (:files expected))) (keys (:files actual))))
(let [ed (:data expected)
ad (:data actual)]
(-> #{}
(into (map #(vector :file %)) (differing-keys expected actual #{:data}))
(into (map #(vector :data %)) (differing-keys ed ad #{:pages-index :components}))
(into (entities-signature :page (:pages-index ed) (:pages-index ad) #{:objects}
(fn [e a]
(entities-signature :object (:objects e) (:objects a)
#{} (constantly nil)))))
(into (entities-signature :component (:components ed) (:components ad)
#{} (constantly nil)))))))
(defn compare-states
"Record a failure of `phase` at `step` unless the normalized files

View File

@ -12,6 +12,8 @@
are the same for the user:
- `:modified-at` of the file and of each component, bumped by every
change, undo and redo included;
- a linked file's `:synced-at`, the server sync status rather than
authored design data;
- with `{:position-data? false}`, the shapes' `:position-data`, the text
layout that WASM measurement regenerates.
Shapes and the maps that hold them become plain maps, so a shape record
@ -54,7 +56,7 @@
([file opts]
(let [opts (merge {:position-data? true} opts)]
(-> file
(dissoc :modified-at)
(dissoc :modified-at :synced-at)
(update :data
(fn [data]
(-> data

View File

@ -363,10 +363,10 @@
:operation (->WrongUndoEdit)})]
;; the redo leaves the wrong name in place, and so does the variant undo
(t/is (= [:undo :redo :variant-undo] (phases situation)))
(t/is (= (repeat 3 #{[:object :copy-root :name]})
(t/is (= (repeat 3 #{[:file :file1 :object :copy-root :name]})
(map :signature (uc/failures situation))))
(t/is (= {:name "Wrong"}
(-> (uc/failures situation) first :diff second :data :pages-index
(-> (uc/failures situation) first :diff second :files :file1 :data :pages-index
vals first :objects (get :copy-root))))))
(t/deftest round-trip-reports-a-change-with-no-undo-entry
@ -410,7 +410,7 @@
(let [edit (tm/assign-id (->WrongUndoEdit))
situation (r/run-variant {:setup setup/simple-component-with-copy
:operation edit})
pin #{[:object :copy-root :name]}
pin #{[:file :file1 :object :copy-root :name]}
known {:bug "F0" :fails {:undo pin :redo pin :variant-undo pin} :op edit}
verdict #(uc/verdict situation {:undo-check {:known-failures %}})]
(t/is (= {:unexpected [] :resolved []} (verdict [known])))
@ -457,7 +457,7 @@
(let [edit (tm/assign-id (->WrongUndoEdit))
situation (r/run-variant {:setup setup/simple-component-with-copy
:operation edit})
pin #{[:object :copy-root :name]}
pin #{[:file :file1 :object :copy-root :name]}
known {:bug "F0" :fails {:undo pin :redo pin :variant-undo pin} :op edit}
check #(report-types (fn [] (uc/check! situation {:undo-check %})))]
(t/is (= [:fail :fail :fail] (check {})))
@ -470,7 +470,7 @@
right (n/change-property :main-child :fills red)
situation (r/run-variant {:setup setup/simple-component-with-copy
:operation (tm/in-sequence [wrong right])})
pin #{[:object :copy-root :name]}
pin #{[:file :file1 :object :copy-root :name]}
known {:bug "F0" :fails {:undo pin :redo pin :variant-undo pin} :op wrong}
verdict #(uc/verdict situation {:undo-check {:known-failures [%]}})
phases (fn [k mark] (mapv :phase (k (verdict mark))))]
@ -488,7 +488,7 @@
(t/deftest a-mark-that-applies-to-no-variant-fails
(let [edit (tm/assign-id (->WrongUndoEdit))
pin #{[:object :copy-root :name]}
pin #{[:file :file1 :object :copy-root :name]}
mark {:bug "F0" :fails {:undo pin} :op edit}
case-map {:undo-check {:known-failures [mark]}}]
(t/is (= [:fail] (report-types #(uc/check-marks-applied! case-map :pure []))))

View File

@ -497,10 +497,10 @@
(rx/filter dch/commit?)
(rx/map deref)
(rx/mapcat
(fn [{:keys [save-undo? undo-changes redo-changes undo-group tags stack-undo? selected-before]}]
(fn [{:keys [file-id save-undo? undo-changes redo-changes undo-group tags stack-undo? selected-before]}]
(if (and save-undo? (seq undo-changes))
(let [entry {:undo-changes undo-changes
:redo-changes redo-changes
(let [entry {:undo-changes (mapv #(assoc % ::dwu/file-id file-id) undo-changes)
:redo-changes (mapv #(assoc % ::dwu/file-id file-id) redo-changes)
:undo-group undo-group
:tags tags
:selected-before selected-before}]

View File

@ -283,6 +283,19 @@
(assoc-in state [:workspace-local :selected] selected-ids)
state))))
(defn- commit-history-changes
"Replay changes in order, keeping each run in its destination file.
Older entries without a destination use the current file."
[origin changes]
(->> (partition-by ::file-id changes)
(map (fn [changes]
(dch/commit-changes {:file-id (::file-id (first changes))
:redo-changes (mapv #(dissoc % ::file-id) changes)
:undo-changes []
:origin origin
:save-undo? false})))
(rx/from)))
(defn undo-to-index
"Repeat undoing or redoing until dest-index is reached."
[dest-index]
@ -310,11 +323,9 @@
(map :redo-changes))
:else [])))]
(when (seq changes)
(rx/of (materialize-undo changes dest-index)
(dch/commit-changes {:redo-changes changes
:undo-changes []
:origin it
:save-undo? false})))))))))))
(rx/concat
(rx/of (materialize-undo changes dest-index))
(commit-history-changes it changes)))))))))))
(declare ^:private assure-valid-current-page)
@ -354,13 +365,11 @@
(let [first-item (get items undo-group-index)]
(rx/of (undo-to-index (dec undo-group-index))
(restore-selection (:selected-before first-item))))
(rx/of (materialize-undo changes (dec index))
(dch/commit-changes {:redo-changes changes
:undo-changes []
:save-undo? false
:origin it})
(restore-selection (:selected-before item))
(assure-valid-current-page)))))))))))
(rx/concat
(rx/of (materialize-undo changes (dec index)))
(commit-history-changes it changes)
(rx/of (restore-selection (:selected-before item))
(assure-valid-current-page))))))))))))
(def redo
(ptk/reify ::redo
@ -392,12 +401,10 @@
(let [last-item (get items redo-group-index)]
(rx/of (undo-to-index redo-group-index)
(restore-selection (:selected-after last-item))))
(rx/of (materialize-undo changes (inc index))
(dch/commit-changes {:redo-changes changes
:undo-changes []
:origin it
:save-undo? false})
(restore-selection (:selected-after item))))))))))))
(rx/concat
(rx/of (materialize-undo changes (inc index)))
(commit-history-changes it changes)
(rx/of (restore-selection (:selected-after item)))))))))))))
(defn- assure-valid-current-page
[]

View File

@ -46,7 +46,7 @@
:case-ao-copy-dropped-into-a-grid-cell-reaches-copies
[{:transcript " {:copy :loose, :into :main-root, :cell [1 3]}", :states ["abc6e41a291516a2" "571d314ba8917a08"]}]
:case-ap-library-main-child-removal-reaches-copy
[{:transcript "", :states ["f53d220c42298128" "7c2dfde6478d399c"]}]
[{:transcript "", :states ["dd877acf0d7f120c" "0a472792b8a73e33"]}]
:case-aq-main-change-reaches-a-copy-nested-in-a-sub-board
[{:transcript " {:target #fn, :property :fills, :value \"#00ff00\"}\n {:target :main-instance, :property :fills, :value \"#ff0000\"}", :states ["d458024081bee6ec" "df29aaf3b63bece6" "0aef0de70c1e2e98"]}
{:transcript "one-of -> \n {:target :main-instance, :property :fills, :value \"#ff0000\"}", :states ["c9ecea6283cef90c" "be12b667808778f3"]}]
@ -109,7 +109,7 @@
:case-f-move-shape-in-main-auto-propagates-order-to-clean-copy
[{:transcript " {:target :main-child1, :parent :main-root, :to-index 2}", :states ["1994876f6bbe7d2e" "de144b280bc4fc82"]}]
:case-h-library-change-propagates-across-file-boundary-on-sync
[{:transcript "", :states ["d8c5e8bda3728127" "6ee281995d7d8f65"]}]
[{:transcript "", :states ["46c4b8337914be2d" "d95e20909221223c"]}]
:case-i-undo-reverts-edit-and-its-auto-propagation
[{:transcript " {:target :main-child, :property :fills, :value \"#ff0000\"}\n \n {:times 1}", :states ["386e940ac63af4b1" "734ec524d88eb6bb" "ff1fa863b88027e5"]}]
:case-k-synchronisation-scenarios

View File

@ -480,12 +480,12 @@
(let [{:keys [index items]} (:workspace-undo @st/state)]
(or index (dec (count items)))))
(defn- snapshot
"The normalized live file the round trip compares. WASM regenerates
(defn snapshot
"The normalized live files the round trip compares. WASM regenerates
`:position-data` by measuring, so it is left out there."
[]
(uc/snapshot (current-file)
{:position-data? (not (features/active-feature? @st/state "render-wasm/v1"))}))
(uc/snapshot-files (:files @st/state)
{:position-data? (not (features/active-feature? @st/state "render-wasm/v1"))}))
(defn- mark-baseline
[situation]

View File

@ -16,6 +16,7 @@
[app.common.test-helpers.ids-map :as cthi]
[app.common.test-helpers.shapes :as cths]
[app.main.data.workspace.libraries :as dwl]
[app.main.data.workspace.undo :as dwu]
[app.main.repo :as rp]
[app.main.store :as st]
[beicon.v2.core :as rx]
@ -72,3 +73,29 @@
(t/is (= new-color (nested-child-fill library'))))
(t/is (= new-color (fill-of (ftm/current-file) :copy-a-child)))
(t/is (= new-color (fill-of (ftm/current-file) :copy-b-nested-child)))))))
(t/deftest ^:async undo-and-redo-update-main-restore-both-files
(await
(mock/with-mocks*
{rp/cmd! (mock/stub (fn [& _] (rx/of nil)))
rx/timer mock/timer-mock}
(let [library (install!)]
(await (ftm/await-step [(ftm/fill-commit :copy-a-child new-color {})]))
(let [before (ftm/snapshot)]
(await (ftm/await-step [(dwl/update-component-sync (cthi/id :copy-a) (:id library))]))
(let [after (ftm/snapshot)]
(await (ftm/await-step [dwu/undo]))
(t/is (= before (ftm/snapshot)))
(await (ftm/await-step [dwu/redo]))
(t/is (= after (ftm/snapshot)))))
(await (ftm/await-step [dwu/undo]))
(let [restored (get-in @st/state [:files (:id library)])]
(t/is (= old-color (fill-of restored :main-a-child)))
(t/is (= old-color (nested-child-fill restored))))
(t/is (= old-color (fill-of (ftm/current-file) :copy-b-nested-child)))
(t/is (= new-color (fill-of (ftm/current-file) :copy-a-child)))
(await (ftm/await-step [dwu/redo]))
(let [redone (get-in @st/state [:files (:id library)])]
(t/is (= new-color (fill-of redone :main-a-child)))
(t/is (= new-color (nested-child-fill redone))))
(t/is (= new-color (fill-of (ftm/current-file) :copy-b-nested-child)))))))