🐛 Decide a move the way the document decides it

The move mirror re-pointed a parent edge for every shape a :mov-objects
change named, so the fold followed a move the document refused. Two
measured consequences: moving a shape into its own subtree left the fold
disagreeing with a rebuild, and moving a shape under its own descendant
closed a cycle in the fold's parent edges, after which the fold had not
returned eight seconds later with app.graph.overlay.sync/subtree-eids on
the stack.

The gate is all-or-nothing for the whole change, which is the half a
per-shape mirror cannot see: process-change :mov-objects proceeds only
when the change names a shape, the parent exists, and every named shape
passes its own is-valid-move?, so one invalid shape in a batch of ten
moves none of them. The mirror now asks the same question of the running
state, in the change's own order.

It asks rather than answers, because a predicate written again in the
applier would be a second definition of which moves are legal, and the
two would drift the first time Penpot changes a nesting rule. So
calculate-invalid-targets and the predicate move out of the change
method into valid-move? at the namespace level, taking the objects view
and the two flags, with the method's own call site delegating to them and
no behaviour changed. The objects view is what the answer takes rather
than a container: the decision walks the moved shape's subtree down
:shapes and the destination's chain up :parent-id, reading :component-id
and :shape-ref off every shape it meets, and the overlay holds all of
those, which is why the same predicate answers for an index.

subtree-eids gains the guard the cycle case needs, so a cyclic index
fails loudly instead of spinning: the walk tracks the shapes it has
entered and returns.

Six new tests, and each mutation of the repair fails by name rather than
in an unrelated test: dropping the gate fails seven assertions across the
three gate tests, weakening every? to some fails the three that pin the
change-level reading, asking the predicate about the wrong destination
fails the same seven, and removing the walk guard fails the two that pin
the cycle.

backend-tests.graph-overlay-sync-test: 29 tests, 228 assertions, 0
failures.

Entry: pp:graph:decide-a-move-the-way-the-document-does open -> done

AI-assisted-by: deepseek-flash
This commit is contained in:
Álvaro Tejero Cantero 2026-09-18 01:11:31 +02:00
parent ad3cb9739e
commit 1c4d3580d4
No known key found for this signature in database
3 changed files with 310 additions and 58 deletions

View File

@ -98,13 +98,23 @@
(mapv :e (d/datoms db :avet :shape/parent eid)))
(defn- subtree-eids
"The shape entity plus every descendant, via the reverse parent index."
"The shape entity plus every descendant, via the reverse parent index.
`seen` is what makes the walk return on a cyclic index: the children
closure is the same thing `app.common.files.helpers/get-children-ids`
walks with its own `processed` set, and an index that carries a cycle
(a change that escaped `app.common.files.changes/valid-move?`, or a
rebuild of a document that already had one) would otherwise accumulate
every revisit and never reach the end of the loop."
[db root-eid]
(loop [acc []
seen #{root-eid}
frontier [root-eid]]
(if-let [eid (peek frontier)]
(recur (conj acc eid)
(into (pop frontier) (child-eids db eid)))
(let [children (remove seen (child-eids db eid))]
(recur (conj acc eid)
(into seen children)
(into (pop frontier) children)))
acc)))
(defn- container-shape-eids
@ -510,6 +520,38 @@
(subtree-eids db eid)))]
(ok (with-order db' (children-in-order db' peid)))))))
(defn- container-objects
"The destination container's objects map, reconstructed from the index
for `app.common.files.changes/valid-move?`: shape id → `:parent-id`,
`:shapes`, `:component-id` and `:shape-ref`, which are the keys the move
decision reads and the only ones it reads.
The predicate takes the objects-shaped view rather than an index, so
this is the view: the index is not a second way to answer which moves
are legal (`pp:graph:database-is-the-boundary`). Parent and child ids
are shape ids, as they are in the document, so a shape the index parents
on its container — the page root frame, the root copy of a component
container — arrives with no parent, and the walk up stops where the
document's stops.
Built for the whole container, the order `renumber-container-tx` beside
it already reads: the decision walks the moved shape's subtree and the
destination's chain, and neither stops where it started. The child lists
are unsorted, because the walk reads membership and never a position."
[db ceid]
(let [eids (container-shape-eids db ceid)
children (group-by (fn [e] (:db/id (:shape/parent (d/entity db e)))) eids)]
(into {}
(map (fn [eid]
(let [ent (d/entity db eid)]
[(:shape/id ent)
{:parent-id (:shape/id (:shape/parent ent))
:shapes (into [] (map #(:shape/id (d/entity db %)))
(get children eid))
:component-id (:shape/component-id ent)
:shape-ref (:shape/shape-ref ent)}])))
eids)))
(defn- apply-mov-objects
"Reparenting, and the order that comes with it: `:mov-objects` carries
shape ids, a parent id, and either an `:index` or an `:after-shape`
@ -517,36 +559,52 @@
in the destination's child list where `insert-at-index` puts them and
the parents they left close their gaps. The index is read against the
destination's list as it stands, moved shapes included, because that is
the list the document splits."
[db {:keys [parent-id shapes index after-shape] :as change}]
the list the document splits.
The move itself is the document's decision and not a second one:
`process-change :mov-objects` asks `valid-move?` for every shape the
change names and moves none of them unless every answer is yes, so one
invalid shape in a batch of ten leaves all ten where they were. The
mirror asks that same predicate, in the same order, of the container as
the index holds it at this point in the change list, and where the
document leaves its objects untouched the index rewrites no datom. That
is an applied change rather than a skip, because the fold still equals a
rebuild of the changed document (`pp:graph:stale-index-gate`)."
[db {:keys [parent-id shapes index after-shape allow-altering-copies syncing] :as change}]
(let [ceid (queries/container-eid db (change-container-id change))
peid (when ceid (queries/shape-eid db ceid parent-id))]
(if-not peid
(skip db :missing-parent)
(let [moved (into []
(keep (fn [sid] (queries/shape-eid db ceid sid)))
shapes)
siblings (children-in-order db peid)
index (or (some->> after-shape
(queries/shape-eid db ceid)
(ctd/index-of siblings)
inc)
index)
order (if (some? index)
(ctd/insert-at-index siblings index moved)
(cfh/append-at-the-end siblings moved))
left (into []
(comp (keep #(:db/id (:shape/parent (d/entity db %))))
(remove #{peid})
(distinct))
moved)
tx (mapv (fn [eid] [:db/add eid :shape/parent peid]) moved)
db' (cond-> db (seq tx) (d/db-with tx))
db' (with-order db' order)
db' (reduce (fn [db* pe] (with-order db* (children-in-order db* pe)))
db' left)
db' (with-renumber db' ceid)]
(ok (with-reresolved db' (into [] (mapcat #(subtree-eids db' %)) moved)))))))
(let [objects (container-objects db ceid)
flags {:allow-altering-copies allow-altering-copies
:syncing syncing}]
(if-not (and (seq shapes)
(every? #(cp/valid-move? objects % parent-id flags) shapes))
(ok db)
(let [moved (into []
(keep (fn [sid] (queries/shape-eid db ceid sid)))
shapes)
siblings (children-in-order db peid)
index (or (some->> after-shape
(queries/shape-eid db ceid)
(ctd/index-of siblings)
inc)
index)
order (if (some? index)
(ctd/insert-at-index siblings index moved)
(cfh/append-at-the-end siblings moved))
left (into []
(comp (keep #(:db/id (:shape/parent (d/entity db %))))
(remove #{peid})
(distinct))
moved)
tx (mapv (fn [eid] [:db/add eid :shape/parent peid]) moved)
db' (cond-> db (seq tx) (d/db-with tx))
db' (with-order db' order)
db' (reduce (fn [db* pe] (with-order db* (children-in-order db* pe)))
db' left)
db' (with-renumber db' ceid)]
(ok (with-reresolved db' (into [] (mapcat #(subtree-eids db' %)) moved)))))))))
(defn- apply-reorder-children
"Mirror of `process-change :reorder-children` ->

View File

@ -35,6 +35,7 @@
[app.graph.overlay.queries :as queries]
[app.graph.overlay.sync :as sync]
[clojure.set :as set]
[clojure.string :as str]
[clojure.test :as t]
[datascript.core :as d]))
@ -582,7 +583,7 @@
:del-obj {:coverage :covered
:why "the shape and its subtree, and Penpot's one change per selected shape is idempotent here"}
:mov-objects {:coverage :covered
:why "the parent edge and the child list, the container renumber and the re-resolution of the moved subtrees"}
:why "the parent edge and the child list, the container renumber and the re-resolution of the moved subtrees, for the moves `app.common.files.changes/valid-move?` accepts; a change the gate refuses moves none of its shapes, which is the document's own answer and rewrites no datom here"}
:reorder-children {:coverage :covered
:why "the sibling ordinals, from the parent's own list sorted as `process-children-reordering` sorts it: a partial order over the children, the unnamed ones first, and a parent inside a component copy left alone unless the change allows altering copies"}
:add-page {:coverage :covered
@ -1125,6 +1126,174 @@
(t/is (= expected (select-keys (ordinals (:db result)) [child-1 child-2]))
(str label ": the copy's child order moved the wrong way"))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; the move gate
;;
;; `process-change :mov-objects` refuses the whole change when any shape it
;; names may not move, and a shape may not land in its own subtree, in a
;; component copy, or in its main component. The mirror asks the document's
;; own predicate for that answer, so a move the document leaves alone is a
;; move the fold leaves alone, and a change the document moves nothing for
;; rewrites no datom here.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def ^:private with-a-copy-on-the-page
"The fixture's changes up to the component record's rename: the main
instance's subtree stands on the page, and `copy-root-id` carries a
`:shape-ref`, so a move into it is a move into a component copy."
(vec (take-while #(not= :mod-component (:type %)) changes)))
(def ^:private before-circ-leaves
"The fixture's changes up to the `:del-obj` of circ-id: `subchild-id` is
still the frame's grandchild, which is what makes a move of the frame
under it a move under its own descendant."
(vec (take-while #(not= :del-obj (:type %)) changes)))
(defn- parent-shape-id
"The shape id of the parent the index gives `sid` inside `container-id`:
the answer a consumer reads out of the fold without the document."
[db container-id sid]
(let [ceid (queries/container-eid db container-id)]
(:shape/id (:shape/parent (d/entity db (queries/shape-eid db ceid sid))))))
(defn- fold-and-rebuild
"The fixture after `change-list` on both paths: the changed document, the
folded index, the rebuilt index, and the fold's report. `round-trip`
compares the second and third in normal form; a test that names an entity
needs the databases themselves."
[change-list]
(let [data0 (base-data)
data1 (cp/process-changes data0 change-list false)
result (sync/apply-changes (overlay/build data0) change-list)]
{:document data1
:folded (:db result)
:rebuilt (overlay/build data1)
:applied (:applied result)
:skipped (:skipped result)}))
(t/deftest a-move-the-gate-refuses-leaves-the-parent-edges-alone
;; The measurement `pp:graph:the-move-mirror-ignores-the-validity-gate`
;; records, on this fixture: the destination is a component copy, so the
;; document refuses to move the main instance's child into it, and the fold
;; used to follow the move anyway, leaving the fold with a parent edge the
;; document never had.
(let [change (conj with-a-copy-on-the-page
{:type :mov-objects :page-id page-id
:parent-id copy-root-id :shapes [comp-child-id]})
{:keys [document folded rebuilt applied skipped]} (fold-and-rebuild change)]
(t/is (empty? skipped)
(str "a refused move is not a skip: " (pr-str skipped)))
(t/is (= :mov-objects (peek applied))
"the change is applied, because the index still equals a rebuild")
(t/is (= comp-root-id
(get-in document [:pages-index page-id :objects comp-child-id :parent-id]))
"the document kept the main instance's child where it was")
(t/is (= [comp-root-id comp-root-id]
[(parent-shape-id folded page-id comp-child-id)
(parent-shape-id rebuilt page-id comp-child-id)])
"and both indexes kept the parent the document kept")
(t/is (= (normal-form folded) (normal-form rebuilt))
"the parent edge was the whole difference this case had")))
(t/deftest a-move-into-a-copy-follows-allow-altering-copies
;; `allow-altering-copies` is the document's own lift of the copy
;; restriction, which a component swap carries, and the mirror passes it
;; through rather than deciding for itself: the same move into a copy is
;; refused without the flag and follows with it, on both paths.
(let [change (fn [flags]
(conj with-a-copy-on-the-page
(merge {:type :mov-objects :page-id page-id
:parent-id copy-root-id :shapes [rect-id]}
flags)))
refused (fold-and-rebuild (change {}))
allowed (fold-and-rebuild (change {:allow-altering-copies true}))]
(t/is (= [frame-id frame-id]
[(parent-shape-id (:folded refused) page-id rect-id)
(parent-shape-id (:rebuilt refused) page-id rect-id)])
"without the flag the copy still refuses the move")
(t/is (= (normal-form (:folded refused)) (normal-form (:rebuilt refused))))
(t/is (= [copy-root-id copy-root-id]
[(parent-shape-id (:folded allowed) page-id rect-id)
(parent-shape-id (:rebuilt allowed) page-id rect-id)])
"and with it both indexes follow the move the document makes")
(t/is (= (normal-form (:folded allowed)) (normal-form (:rebuilt allowed))))))
(t/deftest one-invalid-shape-moves-none-of-the-shapes-with-it
;; The half a per-shape mirror cannot see: the gate is all-or-nothing for
;; the change, so the frame that may not land under its own descendant
;; keeps the text beside it where it was. The control is the same change
;; with the frame left out, which moves the text on both paths — the
;; invalid shape's presence is the only difference between the two.
(let [change (fn [shape-ids]
(conj before-circ-leaves
{:type :mov-objects :page-id page-id
:parent-id subchild-id :shapes shape-ids}))
refused (fold-and-rebuild (change [frame-id text-id]))
control (fold-and-rebuild (change [text-id]))]
(t/is (empty? (:skipped refused))
(str "a refused move is not a skip: " (pr-str (:skipped refused))))
(t/is (= [uuid/zero uuid/zero]
[(parent-shape-id (:folded refused) page-id frame-id)
(parent-shape-id (:rebuilt refused) page-id frame-id)])
"neither index moved the frame the gate refuses")
(t/is (= [uuid/zero uuid/zero]
[(parent-shape-id (:folded refused) page-id text-id)
(parent-shape-id (:rebuilt refused) page-id text-id)])
"and the text stayed with it, as the document left it")
(t/is (= (normal-form (:folded refused)) (normal-form (:rebuilt refused))))
(t/is (empty? (:skipped control))
(str "the control is a valid move: " (pr-str (:skipped control))))
(t/is (= [subchild-id subchild-id]
[(parent-shape-id (:folded control) page-id text-id)
(parent-shape-id (:rebuilt control) page-id text-id)])
"while the same change without the invalid shape moves the text")
(t/is (= (normal-form (:folded control)) (normal-form (:rebuilt control))))))
(t/deftest a-move-under-its-own-descendant-returns-and-folds-to-the-rebuild
;; The second measurement: the mirror followed this move, closed a cycle in
;; its parent edges, and walked `subtree-eids` for ever — eight seconds in,
;; the stack still bore it. The gate refuses the move, so there is no cycle
;; to enter and the change lands as an applied change.
(let [change (conj before-circ-leaves
{:type :mov-objects :page-id page-id
:parent-id subchild-id :shapes [frame-id]})
{:keys [document folded rebuilt applied skipped]} (fold-and-rebuild change)]
(t/is (empty? skipped)
(str "a refused move is not a skip: " (pr-str skipped)))
(t/is (= :mov-objects (peek applied))
"the change is applied, because the index still equals a rebuild")
(t/is (= uuid/zero
(get-in document [:pages-index page-id :objects frame-id :parent-id]))
"the document refuses to nest the frame under its own descendant")
(t/is (= [uuid/zero uuid/zero]
[(parent-shape-id folded page-id frame-id)
(parent-shape-id rebuilt page-id frame-id)])
"and neither index followed it")
(t/is (= (normal-form folded) (normal-form rebuilt)))))
(t/deftest the-subtree-walk-returns-on-a-cyclic-index
;; The gate is the first half of the repair and this is the second: an
;; index that already holds a cycle must not make the walk run for ever,
;; because `subtree-eids` runs over every moved subtree and every deleted
;; one. `app.common.files.helpers/get-children-ids`, which walks the same
;; closure in the document, carries its own `processed` set for the same
;; reason. The deref is the assertion: a walk that does not return fails
;; here rather than hanging the run.
(let [db (-> (overlay/build (base-data))
(sync/apply-changes (subvec changes 0 4))
:db)
ceid (queries/container-eid db page-id)
circ (queries/shape-eid db ceid circ-id)
sub (queries/shape-eid db ceid subchild-id)
;; circ under its own child: a cycle of two, which no accepted change
;; produces and a rebuilt index can still hold
db (d/db-with db [[:db/add circ :shape/parent sub]])
walked (deref (future (#'sync/subtree-eids db circ)) 5000 ::timeout)]
(t/is (not= ::timeout walked)
"the walk must return on a cyclic index")
(t/is (= [circ sub] walked)
"and name each shape of the cycle once")))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; the staleness gate
;;
@ -1285,6 +1454,18 @@
(t/is (contains? (types-with change-coverage :covered) :reorder-children)
"and it is covered here, which is what the ordinal bought"))
(t/deftest the-mov-objects-row-names-the-gate-it-covers
;; The row is the table's claim about which moves the mirror covers, and
;; the mirror covers exactly the moves the document's validity gate
;; accepts. A row that names the decision it rests on and states the
;; answer for a change the gate refuses is one a reader can hold the
;; applier to, and the claim goes stale loudly where the row goes stale.
(let [why (:why (change-coverage :mov-objects))]
(t/is (str/includes? why "valid-move?")
"the row names the decision the mirror asks")
(t/is (str/includes? why "refuses")
"and states what a change the gate refuses moves")))
(t/deftest the-classification-table-names-every-operation
(let [dispatched (disj (set (keys (methods cp/process-operation))) :default)
rows (set (keys operation-coverage))]

View File

@ -747,37 +747,50 @@
(d/update-in-when data [:pages-index page-id :objects] reg-objects)
(d/update-in-when data [:components component-id :objects] reg-objects))))
(defn- calculate-invalid-targets
"The shapes `shape-id` may not be moved into: itself and its whole
subtree, read off the objects map's own child lists."
[objects shape-id]
(let [reduce-fn #(into %1 (calculate-invalid-targets objects %2))]
(->> (get-in objects [shape-id :shapes])
(reduce reduce-fn #{shape-id}))))
(defn valid-move?
"Whether `shape-id` may be moved under `parent-id`, decided off
`objects`: avoid placing a shape as a direct or indirect child of
itself, or inside its main component if it's in a copy, or inside a
copy, or from a copy. A component swap (`allow-altering-copies`) and the
deprecated `syncing` path allow changing the structure of a copy.
`objects` is the view the answer takes rather than a container, because
the decision walks the moved shape's subtree down `:shapes` and the
destination's chain up `:parent-id`, reading `:component-id` and
`:shape-ref` off every shape it meets: a caller holding those four facts
per shape can ask this without a document. It is public because
`app.graph.overlay.sync` is that caller, and the incremental overlay
refuses a move the document refuses by asking this predicate rather than
by answering the same question a second time."
[objects shape-id parent-id {:keys [allow-altering-copies syncing]}]
(let [invalid-targets (calculate-invalid-targets objects shape-id)
shape (get objects shape-id)]
(and shape
(not (invalid-targets parent-id))
(not (cfh/components-nesting-loop? objects shape-id parent-id))
(or allow-altering-copies
syncing
(and
;; We don't want to change the structure of component copies
(not (ctk/in-component-copy? (get objects (:parent-id shape))))
;; We need to check the origin and target frames
(not (ctk/in-component-copy? (get objects parent-id))))))))
(defmethod process-change :mov-objects
;; FIXME: ignore-touched is no longer used, so we can consider it deprecated
[data {:keys [parent-id shapes index page-id component-id #_ignore-touched after-shape allow-altering-copies syncing]}]
(letfn [(calculate-invalid-targets [objects shape-id]
(let [reduce-fn #(into %1 (calculate-invalid-targets objects %2))]
(->> (get-in objects [shape-id :shapes])
(reduce reduce-fn #{shape-id}))))
;; Avoid placing a shape as a direct or indirect child of itself, or
;; inside its main component if it's in a copy, or inside a copy, or
;; from a copy
(is-valid-move? [objects shape-id]
(let [invalid-targets (calculate-invalid-targets objects shape-id)
shape (get objects shape-id)]
(and shape
(not (invalid-targets parent-id))
(not (cfh/components-nesting-loop? objects shape-id parent-id))
(or
;; In some cases (like a component
;; swap) it's allowed to change the
;; structure of a copy
allow-altering-copies
;; DEPRECATED, remove once v2.12 released
syncing
(and
;; We don't want to change the structure of component copies
(not (ctk/in-component-copy? (get objects (:parent-id shape))))
;; We need to check the origin and target frames
(not (ctk/in-component-copy? (get objects parent-id))))))))
(letfn [(is-valid-move? [objects shape-id]
(valid-move? objects shape-id parent-id
{:allow-altering-copies allow-altering-copies
:syncing syncing}))
(insert-items [prev-shapes index shapes]
(let [prev-shapes (or prev-shapes [])]