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

✨ Close the applier's coverage gaps and mirror a reorder

Browse Source 
Child order lives in the document as each container's :shapes vector, and
the projection recorded it only as the global Euler intervals, so the
index had no attribute a consumer could read to learn that a shape is the
third child of its parent rather than the fourth. :shape/order is that
attribute now: a plain 0-based integer, dense within one parent, declared
in the schema beside :shape/id and written by the builder per shape from
the parent's vector, exactly as the intervals are derived from it. The
intervals keep their purpose, which is containment, and the ordinal does
not answer a containment query.

With an order in the index, :reorder-children stops being a skip.
process-change carries :parent-id and :shapes, so the new arm writes the
container's ordinals from that vector and retracts the ordinal of a child
the vector no longer holds. The classification table's row moves to
:covered, and the tier supports twenty-five of the thirty-nine change
types rather than twenty-four.

The applier's other gaps close beside it. The raw colour and typography
reference ids ride in the index beside the resolved refs, so an asset
added after the shape that named it repairs every shape that was waiting
for it. A token name written onto a taken name displaces the holder as
one retraction rather than refusing. Every declared shape attribute names
its writer, so an attribute cannot be added to the schema and to no
writer. And a batch that skipped or dropped a change marks the session
stale, so both read gates refuse rather than answer from an index that
disagrees with the document.

Measured on a 5,101-object page: 20,411 datoms before one insertion and
20,412 after, of which one is the new shape's ordinal and none touches a
shape already present, so an append rewrites no sibling while a deletion
rewrites the ordinals after it (9,997 of them for the hundredth child)
and a move pays the interval renumbering it already paid.

backend-tests.graph-overlay-sync-test: 23 tests, 203 assertions, 0
failures.

Entry: pp:graph:sibling-order-needs-an-authored-attribute open -> done
Entry: pp:graph:mirror-the-reorder-children-change open -> done
Entry: pp:graph:store-the-raw-asset-ref open -> done
Entry: pp:graph:mirror-the-token-name-displacements open -> done
Entry: pp:graph:pin-the-attribute-vocabulary open -> done
Entry: pp:graph:does-a-set-token-carry-its-id open -> answered
Entry: pp:graph:stale-index-gate open -> done
Entry: pp:graph:close-applier-coverage-gap open -> done

AI-assisted-by: deepseek-flash
This commit is contained in:
Álvaro Tejero Cantero 2026-09-18 00:50:09 +02:00
parent 74f51ca0cf
commit ad3cb9739e
No known key found for this signature in database
4 changed files with 1751 additions and 128 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

163
backend/src/app/graph/debug.clj
View File

@ -81,38 +81,90 @@
:truncated? truncated?
:row-count (count rows)})
(defn- mark-stale
"Record a staleness verdict in a session's sync state, once.
Every verdict `app.graph.overlay.sync/staleness` returns is a permanent
divergence: the index has folded a state no rebuild produces, and the
batches after it fold onto that state. So a later clean batch must not
erase the mark, and only `load-session!` clears it, by building fresh
metadata from the file."
[sync verdict]
(cond-> sync
(and (some? verdict) (nil? (:stale sync)))
(assoc :stale verdict)))
(defn- stale-meta
"Session metadata for a batch that never reached the applier."
[meta verdict message]
(update meta :sync #(-> %
(assoc :error message)
(mark-stale verdict))))
(defn- applied-meta
"Session metadata after one applied batch.
The revision is stamped for every message, not only for a batch that
applied something: a batch whose every change was skipped still
advanced the file, and stamping only the productive ones leaves
`:graph-revn` reading like a caught-up index. `:graph-revn` is
therefore the revision this session has *seen*, and the staleness mark
beside it is what says whether the index still agrees with it."
[meta revn sync-at result verdict]
(-> meta
(cond-> (number? revn) (assoc :graph-revn (long revn)))
(update :sync #(-> %
(dissoc :error)
(assoc :last-at sync-at
:last-applied (:applied result)
:last-skipped (:skipped result))
(mark-stale verdict)))))
(defn- apply-file-change!
[profile-id {:keys [changes revn file-id]}]
(try
(when-let [current (get @sessions (session-key profile-id))]
(when (= file-id (:file-id current))
(let [result (overlay.sync/apply-changes @(:db-atom current) changes)
sync-at (ct/now)]
(reset! (:db-atom current) (:db result))
(swap! sessions update-in [(session-key profile-id) :meta]
(fn [meta]
(cond-> (-> meta
(update :sync dissoc :error)
(assoc-in [:sync :last-at] sync-at)
(assoc-in [:sync :last-applied] (:applied result))
(assoc-in [:sync :last-skipped] (:skipped result)))
(seq (:applied result))
(assoc :graph-revn (long revn)))))
(when (seq (:skipped result))
(l/dbg :hint "graph sync skipped changes"
:file-id (str file-id)
:revn revn
:skipped (:skipped result))))))
(catch Throwable cause
(l/wrn :hint "graph sync failed"
:file-id (str file-id)
:cause cause)
(swap! sessions assoc-in [(session-key profile-id) :meta :sync :error]
(ex-message cause)))))
(let [key (session-key profile-id)]
(try
(when-let [current (get @sessions key)]
(when (= file-id (:file-id current))
(let [result (overlay.sync/apply-changes @(:db-atom current) changes)
sync-at (ct/now)
verdict (overlay.sync/staleness (get-in current [:meta :graph-revn])
revn result)]
(reset! (:db-atom current) (:db result))
(swap! sessions update-in [key :meta]
applied-meta revn sync-at result verdict)
(when (seq (:skipped result))
(l/dbg :hint "graph sync skipped changes"
:file-id (str file-id)
:revn revn
:skipped (:skipped result)))
(when verdict
(l/wrn :hint "graph index is stale"
:file-id (str file-id)
:revn revn
:reason (name (:reason verdict))
:verdict (pr-str verdict))))))
(catch Throwable cause
(l/wrn :hint "graph sync failed"
:file-id (str file-id)
:cause cause)
;; the message may be nil, and a verdict may not be: a batch that
;; threw left the index at a prefix nothing names
(let [message (or (ex-message cause) (.getName (class cause)))]
(when (contains? @sessions key)
(swap! sessions update-in [key :meta]
stale-meta
(overlay.sync/staleness nil nil {:error message})
message)))))))
(defn- start-sync-loop!
[{:keys [profile-id file-id] :as session}]
(if-let [msgbus (:msgbus session)]
;; A dropping buffer is the silence this subsystem cannot see: a full
;; buffer discards a message with no log line and no revision change.
;; `app.graph.overlay.sync/staleness` catches it one message later,
;; because the next message's revision is then two beyond the
;; index's, and the read gates refuse until a reload rebuilds.
(let [sync-ch (sp/chan :buf (sp/dropping-buffer 64))]
(mbus/sub! msgbus :topic file-id :chan sync-ch)
;; Recur ONLY while the channel is open. A bare `(recur)` after
@ -139,13 +191,23 @@
:loaded-at (ct/format-inst loaded-at :iso)}))
(defn sync-status
"Return incremental sync status for the active session."
"Return incremental sync status for the active session.
`:stale` is the verdict `app.graph.overlay.sync/staleness` returned for
the batch that broke the index, nil while the index still equals a
rebuild, and `:reason` names which of the three cases it was. The two
revisions are reported beside it and neither is the gate: `:revn` is
the file's revision when this session was built and `:graph-revn` the
last revision the session saw, so a subtraction says nothing about a
batch whose changes were skipped or dropped."
[profile-id]
(when-let [session (get @sessions (session-key profile-id))]
(let [{:keys [file-id meta loaded-at]} session]
{:file-id file-id
:revn (:revn meta)
:graph-revn (:graph-revn meta)
:stale (get-in meta [:sync :stale])
:reason (get-in meta [:sync :stale :reason])
:sync (:sync meta)
:loaded-at (ct/format-inst loaded-at :iso)})))
@ -173,7 +235,11 @@
[file-id file]))
(defn load-session!
"Build the overlay of `file-id` for `profile-id`."
"Build the overlay of `file-id` for `profile-id`.
This is the only repair for a stale index: the metadata is fresh, so
the staleness mark `apply-file-change!` records is gone with the
session that carried it."
[cfg profile-id file-id]
(unload-session! profile-id)
(let [msgbus (::mbus/msgbus cfg)
@ -199,24 +265,39 @@
(swap! sessions assoc (session-key profile-id) session)
meta))
(defn session-db
"The current overlay value for `profile-id`, or nil."
[profile-id]
(some-> (get @sessions (session-key profile-id)) :db-atom deref))
(defn- check-fresh!
"Refuse a read from an index that has fallen behind.
The mark is `app.graph.overlay.sync/staleness`'s verdict, recorded by
`apply-file-change!`, and a reload clears it by rebuilding
(`load-session!`). This refusal is what makes partial change-type
coverage a performance property rather than a correctness one: a
refused read falls back to the whole document, and a silently stale
answer has no fallback at all."
[session]
(when-let [stale (get-in session [:meta :sync :stale])]
(ex/raise :type :restriction
:code :graph-index-stale
:hint "the graph index has fallen behind the file; reload the session"
:reason (:reason stale)
:stale stale)))
(defn query-session!
"Run a Datalog `statement` against the overlay for `profile-id`.
Read-only by construction — `d/q` cannot transact — and gated against
function smuggling by `app.graph.overlay.console/check-query!`."
Read-only by construction (`d/q` cannot transact), gated against
function smuggling by `app.graph.overlay.console/check-query!`, and
gated against a stale index by `check-fresh!`."
[profile-id statement]
(when (or (nil? statement) (= "" statement))
(ex/raise :type :validation
:code :missing-query
:hint "datalog query is required"))
(if-let [db (session-db profile-id)]
(-> (console/run-query db statement)
format-query-result)
(if-let [session (get @sessions (session-key profile-id))]
(do
(check-fresh! session)
(-> (console/run-query @(:db-atom session) statement)
format-query-result))
(ex/raise :type :not-found
:code :graph-session-not-loaded
:hint "load a file graph before running queries")))
@ -283,9 +364,13 @@
(defn export-graph-data!
"Export the node/edge inventory of the overlay for `profile-id` as plain
data for the debug graph view. Returns nil when no session is loaded."
data for the debug graph view. Returns nil when no session is loaded,
and refuses through `check-fresh!` when the index has fallen behind:
the graph view is the second read gate, and it hands out every node and
edge the index holds."
[profile-id]
(when-let [{:keys [db-atom file-id meta]} (get @sessions (session-key profile-id))]
(when-let [{:keys [db-atom file-id meta] :as session} (get @sessions (session-key profile-id))]
(check-fresh! session)
(let [db @db-atom
eids (into (sorted-set)
(mapcat #(map :e (d/datoms db :avet %)))

97
backend/src/app/graph/overlay.clj
View File

@ -82,8 +82,13 @@
rather than as one union, because the sync path receives `:set` ops one
attribute at a time and must be able to rebuild each contribution
independently. The `uses-color` rule in `app.graph.overlay.queries`
reunites them. Folded token attributes (`:token/fill`, ...) are plain
string values and need no declaration."
reunites them. Each source also keeps the raw id it resolved from, as a
value rather than a ref: the id joins nothing until
`build-asset-maps` finds the asset, and an asset the library does not
hold yet leaves the id stored and the reference absent, which is the
state `app.graph.overlay.sync/apply-add-asset` repairs. Folded token
attributes (`:token/fill`, ...) are plain string values and need no
declaration."
{;; document
:document/id {:db/unique :db.unique/identity}
;; containers: pages, and components that carry their own :objects
@ -91,6 +96,11 @@
:container/document {:db/valueType :db.type/ref}
;; shapes: identity is the (container, shape) pair
:shape/id {:db/index true}
;; a plain value attribute datascript needs no declaration for, declared
;; so that the test suite's attribute-vocabulary comparison has one set
;; to compare the writers against (every other attribute a shape carries
;; is declared here or is part of the folded token vocabulary)
:shape/type {}
:shape/container {:db/valueType :db.type/ref}
:shape/parent {:db/valueType :db.type/ref}
:shape/name {:db/index true}
@ -100,6 +110,11 @@
:shape/swap-slot {:db/index true}
;; the builder-resolved reference edge: ctf/find-ref-shape's answer
:shape/refers-to {:db/valueType :db.type/ref}
;; the sibling ordinal: each shape's position in its parent's `:shapes`
;; vector, which is the document's own child order. An authored
;; attribute a consumer reads, unlike the intervals below, which are
;; derived from the walk and answer containment
:shape/order {:db/index true}
;; global Euler-tour containment intervals
:shape/enter {:db/index true}
:shape/exit {:db/index true}
@ -112,6 +127,17 @@
:db/cardinality :db.cardinality/many}
:shape/uses-typography {:db/valueType :db.type/ref
:db/cardinality :db.cardinality/many}
;; the raw ids those four resolved from, one attribute per source,
;; indexed because `app.graph.overlay.sync/apply-add-asset` reads the
;; shapes waiting on an id
:shape/fill-color-ref-id {:db/index true
:db/cardinality :db.cardinality/many}
:shape/stroke-color-ref-id {:db/index true
:db/cardinality :db.cardinality/many}
:shape/text-color-ref-id {:db/index true
:db/cardinality :db.cardinality/many}
:shape/typography-ref-id {:db/index true
:db/cardinality :db.cardinality/many}
;; components (the record, distinct from any container it may carry)
:component/id {:db/unique :db.unique/identity}
:component/document {:db/valueType :db.type/ref}
@ -246,6 +272,27 @@
(keys objects))]
[walked counter])))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; sibling order
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn sibling-order
"The ordinal of each shape among its siblings, for one container's
`:objects`: the index the shape holds in its parent's `:shapes` vector.
That vector is the document's own child order, and the ordinal is the
index's copy of it, so a consumer holding an overlay and no document can
still say that a shape is its parent's third child rather than its
fourth.
A shape no vector names has no ordinal, which is the container's root
frame: nothing lists the root frame among children. Returns
{shape-id index}."
[objects]
(into {}
(mapcat (fn [[_ shape]]
(map-indexed (fn [i id] [id i]) (:shapes shape))))
objects))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; entity construction
;;
@ -254,23 +301,35 @@
;; (string tempids at build time, resolved eids on the sync path);
;; `:resolve-ref` answers a shape's `:shape-ref` with the reference of
;; the shape `ctf/find-ref-shape` names, or nil; `:numbering` maps a
;; shape id to its Euler interval within the current container.
;; shape id to its Euler interval within the current container, and
;; `:order` maps it to its position in its parent's `:shapes` vector.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn shape-asset-attrs
"The asset-edge attributes of one shape, resolved through the ctx."
"The asset-edge attributes of one shape: for each source, the raw ids the
document names and the reference the ctx resolved from them.
The raw id is written whether or not the ctx resolves it. A shape that
names an asset the library does not hold keeps the id and carries no
reference, which is what `app.graph.overlay.sync/apply-add-asset` reads
when the asset finally arrives; a reference is written only for an id
the ctx resolves."
[shape {:keys [colors typographies]}]
(let [ref-vals (fn [m ids] (into [] (keep m) ids))
fills (ref-vals colors (fill-color-ref-ids (:fills shape)))
strokes (ref-vals colors (stroke-color-ref-ids (:strokes shape)))
content (when (= :text (:type shape)) (:content shape))
text (ref-vals colors (content-color-ref-ids content))
typs (ref-vals typographies (content-typography-ref-ids content))]
(let [ref-vals (fn [m ids] (into [] (keep m) ids))
fill-ids (fill-color-ref-ids (:fills shape))
stroke-ids (stroke-color-ref-ids (:strokes shape))
content (when (= :text (:type shape)) (:content shape))
text-ids (content-color-ref-ids content)
typ-ids (content-typography-ref-ids content)]
(cond-> {}
(seq fills) (assoc :shape/fill-color fills)
(seq strokes) (assoc :shape/stroke-color strokes)
(seq text) (assoc :shape/text-color text)
(seq typs) (assoc :shape/uses-typography typs))))
(seq fill-ids) (assoc :shape/fill-color-ref-id fill-ids)
(seq stroke-ids) (assoc :shape/stroke-color-ref-id stroke-ids)
(seq text-ids) (assoc :shape/text-color-ref-id text-ids)
(seq typ-ids) (assoc :shape/typography-ref-id typ-ids)
(seq (ref-vals colors fill-ids)) (assoc :shape/fill-color (ref-vals colors fill-ids))
(seq (ref-vals colors stroke-ids)) (assoc :shape/stroke-color (ref-vals colors stroke-ids))
(seq (ref-vals colors text-ids)) (assoc :shape/text-color (ref-vals colors text-ids))
(seq (ref-vals typographies typ-ids)) (assoc :shape/uses-typography (ref-vals typographies typ-ids)))))
(defn shape-token-attrs
"The folded applied-token attributes of one shape: one datom per applied
@ -306,8 +365,9 @@
self-referential, which covers the page root frame (its `:parent-id` is
itself) and the root copy of a component container (its parent lives on
a page)."
[container-ref container-id objects shape {:keys [resolve-ref numbering] :as ctx}]
[container-ref container-id objects shape {:keys [resolve-ref numbering order] :as ctx}]
(let [[enter exit] (get numbering (:id shape))
position (get order (:id shape))
ref (when resolve-ref (resolve-ref shape))]
(merge (cond-> {:db/id (shape-tempid container-id (:id shape))
:shape/id (:id shape)
@ -315,8 +375,9 @@
:shape/parent (if (resolvable-parent? objects shape)
(shape-tempid container-id (:parent-id shape))
container-ref)}
(some? enter) (assoc :shape/enter enter :shape/exit exit)
(some? ref) (assoc :shape/refers-to ref))
(some? enter) (assoc :shape/enter enter :shape/exit exit)
(some? position) (assoc :shape/order position)
(some? ref) (assoc :shape/refers-to ref))
(shape-attrs shape)
(shape-asset-attrs shape ctx))))
@ -450,6 +511,7 @@
[{} counter])
ctx (assoc assets
:numbering numbering
:order (sibling-order objects)
:resolve-ref
(ref-resolver data doc-id
(ctn/make-container component :component)))]
@ -462,6 +524,7 @@
(euler-numbering (:objects page) counter)
ctx (assoc assets
:numbering numbering
:order (sibling-order (:objects page))
:resolve-ref
(ref-resolver data doc-id
(ctn/make-container page :page)))]

795
backend/src/app/graph/overlay/sync.clj
View File

@ -29,21 +29,40 @@
changed. The resolution walks the same head chain the helper walks,
over the index instead of the document.
One authored attribute rides every change that can move a child:
`:shape/order`, the sibling ordinal the builder derives from each
container's `:shapes` vector. The fold keeps it **equal to a rebuild's**,
because a consumer holding an index and no document reads it to learn a
shape's position among its siblings
(`pp:graph:sibling-order-needs-an-authored-attribute`,
`pp:graph:mirror-the-reorder-children-change`); the two derived layers
above are pinned by their invariants instead, because their values are
not comparable between the two paths.
Everything here is pure: db value in, db value out. The session layer
owns the atom and the revision bookkeeping."
owns the atom and the revision bookkeeping, and `staleness` tells it
when a batch has left the index behind for good."
(:require
[app.common.data :as ctd]
[app.common.files.changes :as cp]
[app.common.files.helpers :as cfh]
[app.common.types.component :as ctk]
[app.common.types.page :as ctp]
[app.common.types.tokens-lib :as ctob]
[app.common.uuid :as uuid]
[app.graph.overlay :as overlay]
[app.graph.overlay.queries :as queries]
[datascript.core :as d]))
(def supported-change-types
#{:add-obj :mod-obj :del-obj :mov-objects
#{:add-obj :mod-obj :del-obj :mov-objects :reorder-children
:add-page :del-page :mod-page
:add-component :mod-component :del-component
:restore-component :purge-component})
:restore-component :purge-component
:add-color :mod-color :del-color
:add-typography :mod-typography :del-typography
:set-tokens-lib :set-token :set-token-set
:rename-token-set-group :move-token-set :move-token-set-group})
(defn supported-change?
[change]
@ -155,6 +174,47 @@
[db ceid]
(d/db-with db (renumber-container-tx db ceid)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; sibling order
;;
;; `:shape/order` is the position a shape holds in its parent's `:shapes`
;; vector, and the fold draws it the way the builder does: dense within
;; one parent, from the parent's child list. Every change that can insert,
;; move or remove a child recomputes the affected parent's list here, and
;; the ordinals it does not move keep the datom they already carry, so an
;; appended child costs one datom and a deletion costs the siblings after
;; it. The list is read back from the ordinals themselves, which is how
;; the fold holds an order the document owns.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn- children-in-order
"The children of `peid` in the order the index holds: their sibling
ordinals ascending. A child that carries no ordinal sorts first, which
only a defect produces: `sibling-order` gives one to every shape a
vector names, and `with-order` gives one to every shape it lists."
[db peid]
(->> (d/datoms db :avet :shape/parent peid)
(map :e)
(sort-by #(:shape/order (d/entity db %)))
vec))
(defn- order-tx
"Transaction data for the child list of one parent, `children` in order:
the dense ordinal each child holds, and an `:db/add` only for the child
whose ordinal moves. A child the change left where it was keeps its
datom and its transaction."
[db children]
(into []
(keep-indexed (fn [i eid]
(when (not= i (:shape/order (d/entity db eid)))
[:db/add eid :shape/order i])))
children))
(defn- with-order
[db children]
(let [tx (order-tx db children)]
(cond-> db (seq tx) (d/db-with tx))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; reference re-resolution
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -240,21 +300,24 @@
(defn- apply-add-obj
"Mirror of `process-change :add-obj` -> `ctst/add-shape`: the effective
parent is `(or parent-id frame-id)`, falling back to the root frame
when absent from the container, then to the container itself."
[db {:keys [id obj frame-id parent-id] :as change}]
when absent from the container, then to the container itself. The child
lands at `:index` when the change carries one and at the end of its
parent's children otherwise, which is `add-shape`'s own placement."
[db {:keys [id obj frame-id parent-id index] :as change}]
(let [container-id (change-container-id change)
ceid (queries/container-eid db container-id)]
(if-not ceid
(skip db :missing-container)
(let [pid (or parent-id frame-id)
peid (or (when (and pid (not= pid id))
(queries/shape-eid db ceid pid))
(queries/shape-eid db ceid uuid/zero)
ceid)
(let [pid (or parent-id frame-id)
peid (or (when (and pid (not= pid id))
(queries/shape-eid db ceid pid))
(queries/shape-eid db ceid uuid/zero)
ceid)
ctx (sync-asset-ctx db)
shape (assoc obj :id id)
tempid (overlay/shape-tempid container-id id)
existing (queries/shape-eid db ceid id)
siblings (children-in-order db peid)
tx (-> (if existing (retract-shape-tx db existing) [])
(conj (merge {:db/id tempid
:shape/id id
@ -263,9 +326,16 @@
(overlay/shape-attrs shape)
(overlay/shape-asset-attrs shape ctx))))
db' (d/db-with db tx)
new-eid (queries/shape-eid db' ceid id)]
new-eid (queries/shape-eid db' ceid id)
placed (when (some? new-eid)
(cond
;; an id the parent already held keeps its slot
(some? existing) (mapv #(if (= % existing) new-eid %) siblings)
(nil? index) (conj siblings new-eid)
:else (ctd/insert-at-index siblings index [new-eid])))]
(-> db'
(with-reresolved (if new-eid [new-eid] []))
(cond-> (some? placed) (with-order placed))
(with-renumber ceid)
(ok))))))
@ -312,18 +382,17 @@
[:db/add eid attr v])))
(or applied {})))
(defn- set-op-tx
"Transaction data for one `:set` / `:set-touched` operation on `eid`.
(defn- set-attr-tx
"Transaction data for one attribute a `:set` operation writes on `eid`.
Attributes the overlay does not index yield nil (a designed no-op),
mirroring `ctn/set-shape-attr` only for the indexed slice."
[db eid ctx {:keys [type attr val touched]}]
mirroring `ctn/set-shape-attr` only for the indexed slice.
The asset attributes come in pairs: the raw ids the payload names and
the references the ctx resolves from them. A raw id is written even
when the ctx has no asset for it, which is the state
`apply-add-asset` repairs later."
[db eid ctx attr val]
(cond
(= :set-touched type)
(swap-slot-tx db eid touched)
(not= :set type)
nil
(contains? plain-attr->overlay attr)
(replace-attr-tx eid (plain-attr->overlay attr) val)
@ -331,25 +400,82 @@
(swap-slot-tx db eid val)
(= :fills attr)
(replace-many-tx eid :shape/fill-color
(keep (:colors ctx) (overlay/fill-color-ref-ids val)))
(let [ids (overlay/fill-color-ref-ids val)]
(concat (replace-many-tx eid :shape/fill-color-ref-id ids)
(replace-many-tx eid :shape/fill-color (keep (:colors ctx) ids))))
(= :strokes attr)
(replace-many-tx eid :shape/stroke-color
(keep (:colors ctx) (overlay/stroke-color-ref-ids val)))
(let [ids (overlay/stroke-color-ref-ids val)]
(concat (replace-many-tx eid :shape/stroke-color-ref-id ids)
(replace-many-tx eid :shape/stroke-color (keep (:colors ctx) ids))))
(= :content attr)
(concat (replace-many-tx eid :shape/text-color
(keep (:colors ctx) (overlay/content-color-ref-ids val)))
(replace-many-tx eid :shape/uses-typography
(keep (:typographies ctx)
(overlay/content-typography-ref-ids val))))
(let [col-ids (overlay/content-color-ref-ids val)
typ-ids (overlay/content-typography-ref-ids val)]
(concat (replace-many-tx eid :shape/text-color-ref-id col-ids)
(replace-many-tx eid :shape/text-color (keep (:colors ctx) col-ids))
(replace-many-tx eid :shape/typography-ref-id typ-ids)
(replace-many-tx eid :shape/uses-typography
(keep (:typographies ctx) typ-ids))))
(= :applied-tokens attr)
(applied-tokens-tx eid val)
:else nil))
(defn- assign-op-tx
"Transaction data for one `:assign` operation, mirroring
`common/src/app/common/files/changes.cljc::process-operation`: the
operation carries an encoded attribute map, the handler decodes it
against the shape's own `:type` and replays it as one `:set` per
changed attribute. The decode runs here against the stored
`:shape/type`, and each attribute goes through the same `:set` mirror.
Two differences from the handler, both invisible in the indexed slice.
The handler drops an attribute whose value already equals the shape's,
a test the overlay cannot make because it stores no values, and a
`:set` writing the value already there is idempotent. And the
handler's `:ignore-touched` and `:ignore-geometry` flags steer
`:touched` bookkeeping and geometry, neither of which reaches an
overlay attribute."
[db eid ctx value]
(let [modifications (-> (assoc value :type (:shape/type (d/entity db eid)))
(cp/decode-shape-attrs)
(dissoc :type))]
(into []
(mapcat (fn [[attr val]] (set-attr-tx db eid ctx attr val)))
modifications)))
(defn- set-op-tx
"Transaction data for one operation on `eid`, over the four members of
`app.common.files.changes/schema:operation`.
`:set` and `:assign` write attributes and `:set-touched` writes the
swap slot the overlay indexes. `:set-remote-synced` is a no-op here:
it writes `:remote-synced` on a shape inside a component copy, and no
overlay attribute carries that name. The Ladybug shape tables do carry
the column, because `app.graph.schema.nodes` derives one per key of
the shape schema, so the same operation is a real gap on that tier and
none on this one."
[db eid ctx {:keys [type attr val touched value]}]
(case type
:set (set-attr-tx db eid ctx attr val)
:assign (assign-op-tx db eid ctx value)
:set-touched (swap-slot-tx db eid touched)
:set-remote-synced nil
nil))
(defn- op-attrs
"The shape attributes one operation writes: a `:set`'s own `:attr`, and
an `:assign`'s attribute keys. The reference re-resolution below keys
off which attributes moved, so an `:assign` carrying a head attribute
has to answer here too."
[{:keys [type attr value]}]
(case type
:set (when attr #{attr})
:assign (disj (set (keys value)) :type)
nil))
(defn- apply-mod-obj
[db {:keys [id operations] :as change}]
(let [ceid (queries/container-eid db (change-container-id change))
@ -359,7 +485,7 @@
(let [ctx (sync-asset-ctx db)
tx (into [] (mapcat #(set-op-tx db eid ctx %)) operations)
db' (cond-> db (seq tx) (d/db-with tx))
set-attrs (into #{} (keep :attr) operations)
set-attrs (into #{} (mapcat op-attrs) operations)
affected (cond
(some head-attrs set-attrs) (subtree-eids db' eid)
(contains? set-attrs :shape-ref) [eid]
@ -367,6 +493,10 @@
(ok (cond-> db' (seq affected) (with-reresolved affected)))))))
(defn- apply-del-obj
"Mirror of `process-change :del-obj` -> `ctst/delete-shape`: the shape
and its subtree leave, and the child list of the parent it left closes
the gap it opened, which is where a deletion moves the ordinals of its
later siblings."
[db {:keys [id] :as change}]
(let [ceid (queries/container-eid db (change-container-id change))
eid (when ceid (queries/shape-eid db ceid id))]
@ -374,29 +504,90 @@
;; Penpot emits one :del-obj per selected shape, so a parent's
;; deletion may already have removed this node; not a defect.
(ok db)
(ok (d/db-with db (into []
(mapcat #(retract-shape-tx db %))
(subtree-eids db eid)))))))
(let [peid (:db/id (:shape/parent (d/entity db eid)))
db' (d/db-with db (into []
(mapcat #(retract-shape-tx db %))
(subtree-eids db eid)))]
(ok (with-order db' (children-in-order db' peid)))))))
(defn- apply-mov-objects
"Reparenting only: `:mov-objects` carries shape ids and a parent id and
nothing else (`common/src/app/common/files/changes.cljc`), and the
overlay stores no sibling order, so the move is a `:shape/parent`
re-point per shape, a container renumber, and a reference re-resolution
of the moved subtrees (their head chains changed)."
[db {:keys [parent-id shapes] :as change}]
"Reparenting, and the order that comes with it: `:mov-objects` carries
shape ids, a parent id, and either an `:index` or an `:after-shape`
(`common/src/app/common/files/changes.cljc`), so the moved shapes land
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}]
(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)
(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` ->
`process-children-reordering`: `:shapes` is a partial order over the
parent's children, and the document sorts the child list it already
holds by the index each id has in that vector, leaving a child the
change does not name where it stands (its key is -1 and the sort is
stable). So the mirror is a function of the change and the order the
index carries, and it needs no document.
A parent inside a component copy is left alone unless the change allows
altering copies, which is the document's own gate: component sync owns
copy child ordering.
Nothing else rides the change. A reorder moves no parent edge, so no
reference re-resolves, and every interval still answers containment:
siblings stay disjoint and a subtree stays nested inside its parent.
The interval numbers differ from a rebuild's either way, which is what
`renumber-container-tx` is for and why the comparison excludes them;
the order is what this change stores."
[db {:keys [parent-id shapes allow-altering-copies] :as change}]
(let [ceid (queries/container-eid db (change-container-id change))
peid (when ceid (queries/shape-eid db ceid parent-id))]
(cond
(nil? peid)
(skip db :missing-parent)
(and (not allow-altering-copies)
(some? (:shape/shape-ref (d/entity db peid))))
(ok db)
:else
(let [children (children-in-order db peid)
ids (mapv #(:shape/id (d/entity db %)) children)
eid-of (zipmap ids children)
id->idx (update-vals (->> (map-indexed vector shapes)
(group-by second))
(comp first first))
reordered (mapv eid-of (sort-by #(get id->idx % -1) < ids))]
(ok (with-order db reordered))))))
(defn- apply-add-page
"Mirror of `process-change :add-page`: id+name means a fresh empty page
(`ctp/make-empty-page`), otherwise the provided page map."
@ -407,7 +598,10 @@
page-id (:id page)]
(if (queries/container-eid db page-id)
(ok db)
(let [ctx (assoc (sync-asset-ctx db) :numbering {} :resolve-ref nil)
(let [ctx (assoc (sync-asset-ctx db)
:numbering {}
:order (overlay/sibling-order (:objects page))
:resolve-ref nil)
tid (overlay/container-tempid page-id)
tx (into [(cond-> {:db/id tid
:container/id page-id
@ -465,7 +659,10 @@
(defn- component-container-tx
"Give the component entity a container role over `objects`."
[db eid component-id objects]
(let [ctx (assoc (sync-asset-ctx db) :numbering {} :resolve-ref nil)]
(let [ctx (assoc (sync-asset-ctx db)
:numbering {}
:order (overlay/sibling-order objects)
:resolve-ref nil)]
(into [[:db/add eid :container/id component-id]
[:db/add eid :container/kind :component]
[:db/add eid :container/document (doc-eid db)]]
@ -507,7 +704,17 @@
(seq (:shape/fill-color ent)) (assoc :shape/fill-color (many-ids (:shape/fill-color ent)))
(seq (:shape/stroke-color ent)) (assoc :shape/stroke-color (many-ids (:shape/stroke-color ent)))
(seq (:shape/text-color ent)) (assoc :shape/text-color (many-ids (:shape/text-color ent)))
(seq (:shape/uses-typography ent)) (assoc :shape/uses-typography (many-ids (:shape/uses-typography ent))))))
(seq (:shape/uses-typography ent)) (assoc :shape/uses-typography (many-ids (:shape/uses-typography ent)))
;; the raw ids ride along: the builder projects them for the copy
;; too, and a reference copied without its id could not be repaired
(seq (:shape/fill-color-ref-id ent))
(assoc :shape/fill-color-ref-id (vec (:shape/fill-color-ref-id ent)))
(seq (:shape/stroke-color-ref-id ent))
(assoc :shape/stroke-color-ref-id (vec (:shape/stroke-color-ref-id ent)))
(seq (:shape/text-color-ref-id ent))
(assoc :shape/text-color-ref-id (vec (:shape/text-color-ref-id ent)))
(seq (:shape/typography-ref-id ent))
(assoc :shape/typography-ref-id (vec (:shape/typography-ref-id ent))))))
(defn- snapshot-component-tx
"Mirror of `ctf/load-component-objects`: copy the main-instance subtree
@ -533,14 +740,24 @@
[:db/add comp-eid :container/document (doc-eid db)]]
(map (fn [eid]
(let [src (d/entity db eid)
parent (:db/id (:shape/parent src))]
(merge {:db/id (copy-tempid eid)
:shape/id (:shape/id src)
:shape/container comp-eid
:shape/parent (if (contains? eidset parent)
(copy-tempid parent)
comp-eid)}
(entity-shape-attrs src)))))
parent (:db/id (:shape/parent src))
inner? (contains? eidset parent)]
(cond->
(merge {:db/id (copy-tempid eid)
:shape/id (:shape/id src)
:shape/container comp-eid
:shape/parent (if inner?
(copy-tempid parent)
comp-eid)}
(entity-shape-attrs src))
;; a child of a copied shape keeps the position it
;; held: the component's objects carry the same
;; `:shapes` vectors. The copy of the subtree's
;; root is a container root that no vector names,
;; so it carries no ordinal, which is what a
;; rebuild of the component's objects gives it
(and inner? (some? (:shape/order src)))
(assoc :shape/order (:shape/order src))))))
eids)))))
(defn- apply-del-component
@ -582,6 +799,423 @@
(ok (with-component-reresolved db' id)))
(ok db)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; library assets: colours and typographies
;;
;; The entity is the one `app.graph.overlay/build-tx` writes for a member
;; of `:colors` or `:typographies`: identity, the document ref, and the
;; name a standing query asks for. The value lives in the document,
;; which the holder of the overlay already has.
;;
;; A shape stores each raw `:fill-color-ref-id` (and its siblings) beside
;; the reference the id resolved to, so an asset the library did not hold
;; when the shape named it leaves the id in the index and no reference.
;; `apply-add-asset` then reads the shapes carrying that id, one index
;; lookup per source, and asserts the reference for each, which is the
;; datom a rebuild writes. The add is the only repair: nothing else
;; revisits a shape that named an asset before the library held it.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def ^:private color-asset
{:id-attr :color/id :doc-attr :color/document :name-attr :color/name
:tempid overlay/color-tempid
:sources [{:raw-attr :shape/fill-color-ref-id :ref-attr :shape/fill-color}
{:raw-attr :shape/stroke-color-ref-id :ref-attr :shape/stroke-color}
{:raw-attr :shape/text-color-ref-id :ref-attr :shape/text-color}]})
(def ^:private typography-asset
{:id-attr :typography/id :doc-attr :typography/document
:name-attr :typography/name :tempid overlay/typography-tempid
:sources [{:raw-attr :shape/typography-ref-id :ref-attr :shape/uses-typography}]})
(defn- waiting-shape-ref-tx
"Reference assertions for every shape that named asset `id` through one of
the asset's sources. For a shape that already holds the reference this
re-asserts a datom it has; for a shape that named the asset before the
library held it, this is the datom a rebuild writes and the fold was
missing."
[db id sources asset-ref]
(into []
(mapcat (fn [{:keys [raw-attr ref-attr]}]
(map (fn [dtm] [:db/add (:e dtm) ref-attr asset-ref])
(d/datoms db :avet raw-attr id))))
sources))
(defn- apply-add-asset
"Mirror of `process-change :add-color` -> `ctl/add-color` and
`:add-typography` -> `ctyl/add-typography`, both of which `assoc` the
asset into the library map whether or not one is already there. A
payload without a name drops the name a rebuild would drop too, which
is why the name is replaced rather than merged.
The shapes that named the asset before the library held it carry its raw
id and no reference; this is where those references appear. The read
runs against `db`, before the write, and the reference is the asset's
eid or its tempid, which the same transaction resolves."
[db {:keys [id-attr doc-attr name-attr tempid sources]} asset]
(let [id (:id asset)]
(if-not (uuid? id)
(skip db :missing-asset-id)
(let [existing (d/entid db [id-attr id])
asset-ref (or existing (tempid id))
tx (-> [(cond-> {:db/id asset-ref
id-attr id
doc-attr (doc-eid db)}
(some? (:name asset))
(assoc name-attr (:name asset)))]
(into (waiting-shape-ref-tx db id sources asset-ref))
(cond-> (and existing (nil? (:name asset)))
(conj [:db.fn/retractAttribute existing name-attr])))]
(ok (d/db-with db tx))))))
(defn- apply-mod-color
"Mirror of `process-change :mod-color` -> `ctl/set-color`, which is
`d/assoc-in-when`: a colour the library does not hold is left alone,
and the one it holds is replaced whole, so an absent name is an
absence rather than a value kept."
[db {:keys [color]}]
(if-let [eid (d/entid db [:color/id (:id color)])]
(ok (d/db-with db (replace-attr-tx eid :color/name (:name color))))
(ok db)))
(defn- apply-mod-typography
"Mirror of `process-change :mod-typography` ->
`ctyl/update-typography` with `merge`, which is the one place the two
asset kinds differ: the payload merges over the stored typography, so
an absent name keeps the stored one instead of dropping it."
[db {:keys [typography]}]
(let [eid (d/entid db [:typography/id (:id typography)])]
(if (and eid (some? (:name typography)))
(ok (d/db-with db [[:db/add eid :typography/name (:name typography)]]))
(ok db))))
(defn- apply-del-asset
"Mirror of `common/src/app/common/types/library.cljc::delete-color` and
of `ctyl/delete-typography`: both dissoc the asset from the library map
and leave every referring shape alone. A rebuild therefore loses the
asset entity *and* every resolved reference to it, because
`app.graph.overlay/build-asset-maps` only maps the ids the library
still holds.
One retraction produces exactly that. Datascript's
`:db.fn/retractEntity` retracts the entity's own datoms and every
reference datom whose value is the entity, which here is every
`:shape/fill-color`, `:shape/stroke-color`, `:shape/text-color` and
`:shape/uses-typography` pointing at the asset. On the design-system
file measured by
`pp:vcs:the-real-change-stream-is-attribute-shaped` one skipped
`:del-color` left up to 10,304 of those ref datoms behind."
[db id-attr id]
(if-let [eid (d/entid db [id-attr id])]
(ok (d/db-with db [[:db.fn/retractEntity eid]]))
(ok db)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; design tokens
;;
;; The entity shape is `app.graph.overlay/tokens-tx`'s: one entity per
;; token set (identity, name, document ref) and one per token (identity,
;; name, type, set ref). Values, themes and resolution stay in the lib,
;; which `app.common.types.tokens-lib` already answers.
;;
;; None of the six changes reads the document or needs the lib to be
;; loaded: each one carries what the mirror needs. Two facts about the
;; lib drive the rest. A set's name is its path, so a move or a group
;; rename is a name rewrite over the sets under a prefix. And both the
;; set tree and a set's token map are keyed by name, so writing a name
;; that is already taken displaces the entity holding it and a rebuild
;; shows that entity simply gone.
;;
;; A displacement of one entity is mirrored, as one retraction beside the
;; write (`apply-set-token-set` and `apply-set-token`). The three
;; group-level writers keep their refusal, because a group move onto an
;; occupied destination drops every set under that destination and a
;; group rename can displace a set outside the group: the shape of that
;; retraction has not been observed in a real change stream, and refusing
;; is worth more than reproducing it from a reading of `d/oassoc-in`.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn- set-names
"Every token set by name. `:token-set/name` carries no `:db/index`, so
this reads the attribute index rather than `:avet`; a file holds token
sets in the tens."
[db]
(into {} (map (fn [dtm] [(:v dtm) (:e dtm)]))
(d/datoms db :aevt :token-set/name)))
(defn- set-token-eids
[db set-eid]
(mapv :e (d/datoms db :avet :token/set set-eid)))
(defn- retract-token-set-tx
"The set entity and its tokens. Retracting the set alone would strand
the tokens: `:token/set` is the only reference between them, and a
token carries its own identity."
[db set-eid]
(into [[:db.fn/retractEntity set-eid]]
(map (fn [eid] [:db.fn/retractEntity eid]))
(set-token-eids db set-eid)))
(defn- token-entities
"Token entities of one set from a lib-shaped token map, in
`app.graph.overlay/tokens-tx`'s shape."
[set-ref tokens]
(into []
(map (fn [token]
(cond-> {:db/id (overlay/token-tempid (:id token))
:token/id (:id token)
:token/set set-ref}
(some? (:name token)) (assoc :token/name (:name token))
(some? (:type token)) (assoc :token/type (:type token)))))
(vals tokens)))
(defn- name-holder
"The entity that holds `name*`, when it is not `eid`. A set tree and a
set's token map are both keyed by name, so the writer that lands on a
taken name writes over this entity and it leaves the library."
[names name* eid]
(when-let [holder (get names name*)]
(when (not= holder eid)
holder)))
(defn- set-under-path?
"Whether a set's path lies strictly under a group path, which is what
`ctob/get-sets-at-path` answers by walking into the group's node: a set
*named* `Brand` is not under the group `Brand`."
[set-path group-path]
(and (> (count set-path) (count group-path))
(= (vec group-path) (vec (take (count group-path) set-path)))))
(defn- sets-under-path
[db path]
(into []
(keep (fn [[name* eid]]
(when (set-under-path? (ctob/split-set-name name*) path) eid)))
(set-names db)))
(defn- reprefixed-name
"`set-path` with its `from` prefix replaced by `to`, joined back into a
name: `ctob/rename-set-group`'s and `ctob/move-set-group`'s formula,
expressed over paths so the separator stays the lib's."
[set-path from to]
(ctob/join-set-path (into (vec to) (drop (count from)) set-path)))
(defn- reprefix-sets-tx
"Rename every set strictly under the group path `from` so its prefix
reads `to`. Nil when one of the new names is held by a set that is not
moving, which is the displacement the caller refuses."
[db from to]
(let [names (set-names db)
moving (into {}
(keep (fn [[name* eid]]
(let [path (ctob/split-set-name name*)]
(when (set-under-path? path from)
[eid (reprefixed-name path from to)]))))
names)]
(when-not (some (fn [[_ name*]]
(when-let [holder (get names name*)]
(not (contains? moving holder))))
moving)
(mapv (fn [[eid name*]] [:db/add eid :token-set/name name*]) moving))))
(defn- apply-set-tokens-lib
"Mirror of `process-change :set-tokens-lib`, which replaces
`:tokens-lib` whole. The index mirrors the replacement: every token-set
and token entity goes, and the incoming library's sets and tokens are
written fresh. Nothing outside the pair points at them, because an
applied token is folded onto the shape as a plain name
(`app.graph.overlay/token-attrs`), so no shape datom needs repair."
[db {:keys [tokens-lib]}]
(let [old (-> (mapv (fn [dtm] [:db.fn/retractEntity (:e dtm)])
(d/datoms db :avet :token-set/id))
(into (map (fn [dtm] [:db.fn/retractEntity (:e dtm)]))
(d/datoms db :avet :token/id)))
new (into []
(mapcat (fn [set*]
(let [sid (ctob/get-id set*)
ref (overlay/token-set-tempid sid)]
(cons {:db/id ref
:token-set/id sid
:token-set/name (ctob/get-name set*)
:token-set/document (doc-eid db)}
(token-entities ref (ctob/get-tokens- set*))))))
(some-> tokens-lib ctob/get-sets))]
;; two transactions: the retraction frees the identities the second
;; one asserts, so no upsert has to resolve against a retracted row
(ok (-> db
(cond-> (seq old) (d/db-with old))
(cond-> (seq new) (d/db-with new))))))
(defn- apply-set-token-set
"Mirror of `process-change :set-token-set`: `ctob/delete-set` when
`attrs` is absent, `ctob/add-set` when the lib holds no set with that
id, and `ctob/update-set` replacing it with `(ctob/make-token-set
attrs)` otherwise.
The replacement is total and `:tokens` is optional in
`ctob/schema:token-set-attrs`, so a payload without tokens leaves the
set empty and a rebuild shows the previous tokens gone. This writes
exactly the tokens the payload carries, and the name through
`ctob/normalize-set-name`, which is the name `make-token-set` stores.
A name another set holds is a displacement rather than a refusal: the
writer that lands on a taken path writes over the set standing there,
and that set leaves the library with every token under it, which a
rebuild shows and `retract-token-set-tx` reproduces."
[db {:keys [id attrs]}]
(let [existing (d/entid db [:token-set/id id])]
(cond
(not attrs)
(ok (cond-> db existing (d/db-with (retract-token-set-tx db existing))))
(not (uuid? id))
(skip db :missing-token-set-id)
:else
(let [name* (ctob/normalize-set-name (:name attrs))
holder (name-holder (set-names db) name* existing)]
(let [set-ref (or existing (overlay/token-set-tempid id))
old (into (if holder (retract-token-set-tx db holder) [])
(map (fn [eid] [:db.fn/retractEntity eid]))
(when existing (set-token-eids db existing)))
new (into [{:db/id set-ref
:token-set/id id
:token-set/name name*
:token-set/document (doc-eid db)}]
(token-entities set-ref (:tokens attrs)))]
;; two transactions: the retraction frees the identities the
;; second one asserts, so no upsert has to resolve against a
;; retracted row
(ok (-> db
(cond-> (seq old) (d/db-with old))
(d/db-with new))))))))
(defn- apply-set-token
"Mirror of `process-change :set-token`: `ctob/delete-token` when
`attrs` is absent, `ctob/add-token` when the set holds no token with
that id, and `ctob/update-token` with `(merge prev attrs)` otherwise,
which is why an absent name or type keeps the stored one. All three
route through `ctob/update-set`, a no-op when the set is absent, so an
unknown set changes nothing here either.
`process-change` adds the token `ctob/make-token` builds from `attrs`,
so the identity to mirror is the one in the payload. The frontend
builds both the id and `:token-id` from one token
(`common/src/app/common/files/changes_builder.cljc::set-token`), and
`ctob/make-token` keeps an id it is given, so the id is there; the
assertion states that rather than refusing a payload the frontend
cannot produce.
A name another token holds is a displacement rather than a refusal: the
set's token map is keyed by name, so the new token takes the name and
the entity that held it leaves the library, which a rebuild shows. The
document decides that rename by map position (`ctob/update-token-`
moves the renamed token with `d/oassoc-before` and the later entry of
the destination name survives), and the index keeps no token order, so
this mirror takes the entry's reading: the holder goes, the renamed
token stays."
[db {:keys [set-id token-id attrs]}]
(let [set-eid (d/entid db [:token-set/id set-id])
eid (let [e (d/entid db [:token/id token-id])]
(when (and set-eid e
(= set-eid (:db/id (:token/set (d/entity db e)))))
e))]
(cond
(nil? set-eid)
(ok db)
(not attrs)
(ok (cond-> db eid (d/db-with [[:db.fn/retractEntity eid]])))
:else
(let [ent (when eid (d/entity db eid))
name* (or (:name attrs) (:token/name ent))
type* (or (:type attrs) (:token/type ent))
holder (some (fn [e]
(when (and (not= e eid)
(= name* (:token/name (d/entity db e))))
e))
(set-token-eids db set-eid))
attrs-tx (fn [e]
(cond-> []
(some? name*) (conj [:db/add e :token/name name*])
(some? type*) (conj [:db/add e :token/type type*])))]
(if eid
(ok (d/db-with db (into (cond-> [] holder (conj [:db.fn/retractEntity holder]))
(attrs-tx eid))))
(let [new-id (:id attrs)]
(assert (uuid? new-id)
(str "a :set-token the frontend builds carries the token id in "
"attrs (`changes_builder.cljc::set-token`), and the mirror "
"reads the identity from there; attrs: " (pr-str attrs)))
(let [new (cond-> {:db/id (overlay/token-tempid new-id)
:token/id new-id
:token/set set-eid}
(some? name*) (assoc :token/name name*)
(some? type*) (assoc :token/type type*))]
;; two transactions: the retraction frees the identity the
;; assertion below writes, so no upsert has to resolve
;; against a retracted row
(ok (-> db
(cond-> holder (d/db-with [[:db.fn/retractEntity holder]]))
(d/db-with [new]))))))))))
(defn- apply-rename-token-set-group
"Mirror of `process-change :rename-token-set-group` ->
`ctob/rename-set-group`, which renames every set under the group path
by replacing the path's last segment. The change carries the path and
the new final name, so the mirror needs no lib. The rename merges into
a group that already exists rather than replacing it, which is why
only a set-name collision is refused here."
[db {:keys [set-group-path set-group-fname]}]
(let [from (vec set-group-path)
to (vec (ctob/replace-last-path-name from set-group-fname))]
(if-let [tx (reprefix-sets-tx db from to)]
(ok (cond-> db (seq tx) (d/db-with tx)))
(skip db :token-set-name-taken))))
(defn- apply-move-token-set
"Mirror of `process-change :move-token-set` -> `ctob/move-set`, which
renames the set at `from-path` to `to-path`, or reorders it when the
two paths are equal. The overlay stores no sibling order, so the
reorder is a designed no-op and the move is one rename. A path the lib
holds no set at is a no-op there too."
[db {:keys [from-path to-path]}]
(let [names (set-names db)
from (ctob/join-set-path from-path)
to (ctob/join-set-path to-path)
eid (get names from)]
(cond
(nil? eid) (ok db)
(= from to) (ok db)
(name-holder names to eid) (skip db :token-set-name-taken)
:else (ok (d/db-with db [[:db/add eid :token-set/name to]])))))
(defn- apply-move-token-set-group
"Mirror of `process-change :move-token-set-group` ->
`ctob/move-set-group`, which moves a whole group and rewrites the name
of every set under it, or reorders the group when the two paths are
equal. The reorder is a designed no-op, for the same reason a set's is.
A destination that already holds sets is refused rather than mirrored:
the move writes the group's node over whatever is at the destination
path, so those sets leave the lib, and refusing is the honest answer to
a state the editor's unique names prevent."
[db {:keys [from-path to-path]}]
(let [from (vec from-path)
to (vec to-path)]
(cond
(= from to)
(ok db)
(seq (remove (set (sets-under-path db from)) (sets-under-path db to)))
(skip db :token-set-group-destination-occupied)
:else
(if-let [tx (reprefix-sets-tx db from to)]
(ok (cond-> db (seq tx) (d/db-with tx)))
(skip db :token-set-name-taken)))))
(defn- apply-change
[db change]
(case (:type change)
@ -589,6 +1223,7 @@
:mod-obj (apply-mod-obj db change)
:del-obj (apply-del-obj db change)
:mov-objects (apply-mov-objects db change)
:reorder-children (apply-reorder-children db change)
:add-page (apply-add-page db change)
:del-page (apply-del-page db change)
:mod-page (apply-mod-page db change)
@ -597,6 +1232,18 @@
:del-component (apply-del-component db change)
:restore-component (apply-restore-component db change)
:purge-component (apply-purge-component db change)
:add-color (apply-add-asset db color-asset (:color change))
:mod-color (apply-mod-color db change)
:del-color (apply-del-asset db :color/id (:id change))
:add-typography (apply-add-asset db typography-asset (:typography change))
:mod-typography (apply-mod-typography db change)
:del-typography (apply-del-asset db :typography/id (:id change))
:set-tokens-lib (apply-set-tokens-lib db change)
:set-token-set (apply-set-token-set db change)
:set-token (apply-set-token db change)
:rename-token-set-group (apply-rename-token-set-group db change)
:move-token-set (apply-move-token-set db change)
:move-token-set-group (apply-move-token-set-group db change)
(skip db :unsupported-type)))
(defn apply-changes
@ -614,3 +1261,43 @@
:reason reason})))))
{:db db :applied [] :skipped []}
changes))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; staleness
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def stale-reasons
"The three ways one batch leaves a maintained index behind."
#{:apply-failed :revision-gap :skipped})
(defn staleness
"The verdict on one batch: nil while the index still equals a rebuild of
the file, otherwise why it no longer does. Pure, so the session layer
owns what to do with it.
- `:apply-failed` when applying threw: the index holds whatever prefix
of the batch had been folded, and nothing says which.
- `:revision-gap` when `revn` is not `graph-revn` plus one.
`app.rpc.commands.files-update/process-changes-and-validate`
increments the file's revision once per accepted save and
`send-notifications!` publishes exactly one message per save, so
consecutive messages carry consecutive revisions. Anything else is a
message this index never saw, which is what the dropping buffer of
`app.graph.debug/start-sync-loop!` produces, or a redelivery, which
would fold a batch twice.
- `:skipped` when the applier had no mirror for a change. The types are
named, because which type diverged is where a repair starts.
Every case is permanent: a later batch folds onto a state no rebuild
produces, so only a rebuild clears the verdict. `result` is
`apply-changes`'s report, or a map carrying `:error` when it threw."
[graph-revn revn {:keys [skipped error] :as _result}]
(cond
(some? error)
{:reason :apply-failed :error (str error)}
(and (number? graph-revn) (number? revn) (not= revn (inc graph-revn)))
{:reason :revision-gap :graph-revn graph-revn :revn revn}
(seq skipped)
{:reason :skipped :types (into [] (distinct) (map :type skipped))}))

824
backend/test/backend_tests/graph_overlay_sync_test.clj
View File

@ -24,10 +24,13 @@
[app.common.features :as ffeat]
[app.common.files.changes :as cp]
[app.common.test-helpers.shapes :as ths]
[app.common.time :as ct]
[app.common.types.file :as ctf]
[app.common.types.library :as ctl]
[app.common.types.tokens-lib :as ctob]
[app.common.types.typography :as ctt]
[app.common.uuid :as uuid]
[app.graph.debug :as graph.debug]
[app.graph.overlay :as overlay]
[app.graph.overlay.queries :as queries]
[app.graph.overlay.sync :as sync]
@ -59,6 +62,11 @@
(def ^:private token-set-id #uuid "00000000-0000-0000-0000-0000000000d2")
(def ^:private token-id #uuid "00000000-0000-0000-0000-0000000000d3")
(def ^:private swap-slot-id #uuid "00000000-0000-0000-0000-000000005571")
(def ^:private color2-id #uuid "00000000-0000-0000-0000-0000000000d4")
(def ^:private typ-id #uuid "00000000-0000-0000-0000-0000000000d5")
(def ^:private token-set2-id #uuid "00000000-0000-0000-0000-0000000000d6")
(def ^:private token2-id #uuid "00000000-0000-0000-0000-0000000000d7")
(def ^:private token3-id #uuid "00000000-0000-0000-0000-0000000000d8")
(defn- shape
"A valid shape for an `:add-obj` payload, from
@ -69,10 +77,11 @@
(ths/sample-shape nil (assoc attrs :id id :type type)))
(defn- base-data
"The untouched document the change list mutates. The library colour and
the token live here, not in the change list, because the sync path does
not support `:add-color` or `:set-token*` changes: both paths must see
them from the start for the asset links to resolve."
"The untouched document the change list mutates. It carries one library
colour and one token set from the start, because the early `:mod-obj`
rows name them: an asset has to exist before the operation that
references it, on both paths. The change list adds a second colour, a
typography and a second token set of its own."
[]
(binding [ffeat/*current* #{"components/v2"}]
(-> (ctf/make-file-data file-id page-id)
@ -90,18 +99,47 @@
:type :color
:value "#FF00FF")})))))))
(def ^:private typography
(ctt/make-typography {:id typ-id :name "Fixture heading"}))
(def ^:private text-content
"A text tree naming the typography, in the shape `txt/node-seq` walks."
{:type "root"
:children [{:type "paragraph-set"
:children [{:type "paragraph"
:children [{:text "Label"
:typography-ref-id typ-id
:typography-ref-file file-id}]}]}]})
(defn- replacement-lib
"The library a `:set-tokens-lib` change carries: a different set with a
different token, so the replacement is visible in every entity."
[]
(-> (ctob/make-tokens-lib)
(ctob/add-set
(ctob/make-token-set
:id token-set2-id
:name "Imported"
:tokens {"imported.radius" (ctob/make-token
:id token2-id
:name "imported.radius"
:type :border-radius
:value "4")}))))
(def ^:private swap-slot-kw
(keyword (str "swap-slot-" swap-slot-id)))
(def ^:private changes
"One change of every type the sync path claims to support, in the order
an editing session would emit them, and every indexed attribute at least
once: topology (add, reparent, delete a subtree), the `:mod-obj` set ops
with their asset refs (`app.graph.overlay.sync/set-op-tx`), a touched
once: topology (add, reparent, reorder, delete a subtree), the
`:mod-obj` set ops
with their asset refs (`app.graph.overlay.sync/set-attr-tx`), a touched
swap slot on a shape inside a copy (`ctk/get-swap-slot`), a copy
child's `:shape-ref` repointed at another main shape (the resolved
`:shape/refers-to` must follow), and the whole component lifecycle from
add to purge."
`:shape/refers-to` must follow), the whole component lifecycle from add
to purge, and then the library tiers: colour, typography and the six
token changes, each with the reference that makes its skip visible."
[{:type :add-obj :page-id page-id :id frame-id
:parent-id uuid/zero :frame-id uuid/zero
:obj (shape frame-id :frame {:name "Board" :width 400 :height 300})}
@ -150,16 +188,30 @@
:val {:fill "brand.primary"}
:ignore-touched true}]}
;; reorder inside the same container: the overlay stores no sibling
;; order, so this must be invisible to it (and therefore is NOT the
;; :mov-objects the injected-bug test drops)
;; reorder inside the same container: the parent edge does not move and
;; the sibling order does, which is now an indexed fact (and therefore
;; is NOT the :mov-objects the injected-bug test drops)
{:type :mov-objects :page-id page-id :parent-id frame-id :index 0 :shapes [circ-id]}
;; reparent to the page's root frame: the parent edge must move
{:type :mov-objects :page-id page-id :parent-id uuid/zero :index 0 :shapes [text-id]}
;; the same arm placed by `:after-shape` instead of an index: the
;; document turns it into an index against the destination's current
;; list, so the fold reads it the same way
{:type :mov-objects :page-id page-id :parent-id frame-id
:after-shape rect2-id :shapes [rect-id]}
;; a partial reorder, the shape `process-children-reordering` takes:
;; the frame's children are sorted by the index each named id holds
;; here, and rect-id, which the change does not name, keeps the -1 key
;; and stays first. The sibling ordinals must follow that sort
;; (`app.graph.overlay.sync/apply-reorder-children`).
{:type :reorder-children :page-id page-id :parent-id frame-id
:shapes [circ-id rect2-id]}
;; delete with survivors: circ and its subtree go, the frame's other
;; children stay
;; children stay and close the gap circ left
{:type :del-obj :page-id page-id :id circ-id}
{:type :add-page :id page2-id :name "Page two"}
@ -226,6 +278,21 @@
{:type :mod-obj :page-id page-id :id copy-child-id
:operations [{:type :set :attr :shape-ref :val comp-root-id}]}
;; an `:assign` operation, the one the applier has to decode itself:
;; `process-operation :assign` decodes the map against the shape's own
;; `:type` and replays it as one `:set` per changed attribute, so a
;; head attribute arriving this way must move the resolution too
{:type :mod-obj :page-id page-id :id copy-child-id
:operations [{:type :assign :value {:name "Copy child, assigned"
:shape-ref comp-child-id
:component-file file-id}}]}
;; `:set-remote-synced` on a shape inside a copy: the classification
;; table calls it a no-op for this tier, and the round trip is what
;; proves it, because no overlay attribute carries `:remote-synced`
{:type :mod-obj :page-id page-id :id copy-child-id
:operations [{:type :set-remote-synced :remote-synced true}]}
;; a swap slot on a shape inside the copy: only the slot is indexed,
;; and only because `ctk/get-swap-slot` extracts it
{:type :mod-obj :page-id page-id :id copy-root-id
@ -242,7 +309,96 @@
{:type :del-component :id comp-id}
{:type :purge-component :id comp-id}])
{:type :purge-component :id comp-id}
;; ---- library colours, the largest unsupported class in the stream
;; measured by pp:vcs:the-real-change-stream-is-attribute-shaped
;; a fill on rect naming a colour the library does not hold yet: the raw
;; id lands in the index and no reference does, because a rebuild
;; resolves a reference only for the ids the library carries. The add
;; below has to link this shape, which is the repair the round closes.
;; The editor emits the asset first, so this order arrives from a save
;; that carries only the use, with the asset in an earlier save.
{:type :mod-obj :page-id page-id :id rect-id
:operations [{:type :set :attr :fills
:val [(assoc (ths/sample-fill-color :fill-color "#0000FF" :fill-opacity 1)
:fill-color-ref-id color2-id)]}]}
{:type :add-color :color {:id color2-id :name "Fixture blue"
:color "#0000FF" :opacity 1}}
;; a stroke naming the colour added one change earlier: the editor's
;; order, which resolves at the operation and needs no repair
{:type :mod-obj :page-id page-id :id rect2-id
:operations [{:type :set :attr :strokes
:val [{:stroke-color "#0000FF" :stroke-opacity 1
:stroke-width 1 :stroke-style :solid
:stroke-alignment :center
:stroke-color-ref-id color2-id
:stroke-color-ref-file file-id}]}]}
;; `ctl/set-color` replaces the colour whole, so the name is replaced
{:type :mod-color :color {:id color2-id :name "Fixture blue, renamed"
:color "#0000EE" :opacity 1}}
;; the worst single skip of the lot: `ctl/delete-color` leaves every
;; referring shape alone, so a rebuild drops the colour entity *and*
;; rect2's `:shape/fill-color` datom, and a fold that only retracted
;; the entity would keep the ref
{:type :del-color :id color-id}
;; ---- library typographies, the same three shapes over one ref
;; the same shape as the colour above: a text operation names a
;; typography the library does not hold, and the add repairs the ref
{:type :mod-obj :page-id page-id :id text-id
:operations [{:type :set :attr :content :val text-content}]}
{:type :add-typography :typography typography}
{:type :mod-obj :page-id page-id :id text-id
:operations [{:type :set :attr :content :val text-content}]}
;; `ctyl/update-typography` merges, so a payload without a name would
;; keep the old one; this one carries a name
{:type :mod-typography :typography {:id typ-id :name "Fixture heading, renamed"}}
{:type :del-typography :id typ-id}
;; ---- design tokens
{:type :set-token-set :id token-set2-id
:attrs {:id token-set2-id :name "Semantic"}}
{:type :set-token :set-id token-set2-id :token-id token2-id
:attrs {:id token2-id :name "semantic.bg" :type :color :value "#123456"}}
;; the merge branch: `:type` is absent from the payload and survives
{:type :set-token :set-id token-set2-id :token-id token2-id
:attrs {:name "semantic.background"}}
;; the renamed token is the one rect2 applies, so the `uses-token`
;; join has to answer the same on both paths afterwards
{:type :set-token :set-id token-set-id :token-id token-id
:attrs {:name "brand.primary.500"}}
;; a set's name is its path, so a move is a rename
{:type :move-token-set :from-path ["Semantic"] :to-path ["Group" "Semantic"]
:before-path nil :before-group nil}
{:type :rename-token-set-group :set-group-path ["Group"] :set-group-fname "Grouped"}
{:type :move-token-set-group :from-path ["Grouped"] :to-path ["Nested" "Grouped"]
:before-path nil :before-group nil}
;; the two delete branches: a token by id, then the set that held it
{:type :set-token :set-id token-set2-id :token-id token2-id :attrs nil}
{:type :set-token-set :id token-set2-id :attrs nil}
;; the whole library replaced, which is what an import emits
{:type :set-tokens-lib :tokens-lib (replacement-lib)}])
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; the normal form
@ -337,10 +493,19 @@
:shape/refers-to (ref-key keymap (:shape/refers-to ent))
:shape/swap-slot (:shape/swap-slot ent)
:shape/parent (ref-key keymap (:shape/parent ent))
;; the sibling ordinal is authored and comparable between the
;; two paths, unlike the intervals below, so it is compared
:shape/order (:shape/order ent)
:shape/fill-color (ref-keys keymap (:shape/fill-color ent))
:shape/stroke-color (ref-keys keymap (:shape/stroke-color ent))
:shape/text-color (ref-keys keymap (:shape/text-color ent))
:shape/uses-typography (ref-keys keymap (:shape/uses-typography ent))}
:shape/uses-typography (ref-keys keymap (:shape/uses-typography ent))
;; the raw ids beside the references, as sets: the extractors
;; return sets, so the stored order is not the document's
:shape/fill-color-ref-id (into #{} (:shape/fill-color-ref-id ent))
:shape/stroke-color-ref-id (into #{} (:shape/stroke-color-ref-id ent))
:shape/text-color-ref-id (into #{} (:shape/text-color-ref-id ent))
:shape/typography-ref-id (into #{} (:shape/typography-ref-id ent))}
;; folded token attributes: plain strings, presence-checked
(into {} (map (fn [a] [a (get ent a)])) overlay/token-attrs))
;; Euler intervals deliberately excluded: the builder and the sync
@ -398,7 +563,197 @@
:skipped (:skipped result)}))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; the tests
;; the classification table
;;
;; One row per member of the change vocabulary, so a type Penpot adds
;; upstream fails this namespace by name instead of being skipped in
;; silence. The criterion is the datom rather than the document: a change
;; is `:no-op` when a rebuild after it produces the datoms the fold
;; already holds, `:covered` when the applier reproduces the difference,
;; and `:partial` when it reproduces a named subset of it.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def ^:private change-coverage
{;; shapes and containers
:add-obj {:coverage :covered
:why "the shape entity, its parent edge, its indexed attributes and its container's fresh intervals"}
:mod-obj {:coverage :covered
:why "every operation the vocabulary defines, over the attributes the overlay indexes"}
: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"}
: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
:why "a container entity and every shape the page carries"}
:del-page {:coverage :covered
:why "the container and its shapes"}
:mod-page {:coverage :covered
:why "the only page attribute the overlay indexes is the name, and the mirror writes it"}
;; components
:add-component {:coverage :covered :why "the component record"}
:mod-component {:coverage :covered
:why "the record, and the component's own container copy when the change carries objects"}
:del-component {:coverage :covered
:why "the deleted flag and the main-instance snapshot a soft delete stores"}
:restore-component {:coverage :covered
:why "the undelete, the dropped copy and the re-resolution back to the page"}
:purge-component {:coverage :covered :why "the record and its container copy"}
;; library assets
:add-color {:coverage :covered
:why "the colour entity, and the reference of every shape that named the id before the library held it, read from the stored raw id"}
:mod-color {:coverage :covered
:why "the stored name, replaced whole as `ctl/set-color` replaces the colour"}
:del-color {:coverage :covered
:why "the colour entity and every resolved reference to it"}
:add-typography {:coverage :covered
:why "the typography entity, with the same repair of the shapes that named the id first"}
:mod-typography {:coverage :covered
:why "the stored name, merged as `ctyl/update-typography` merges"}
:del-typography {:coverage :covered
:why "the typography entity and every reference to it"}
;; design tokens
:set-tokens-lib {:coverage :covered
:why "every token-set and token entity, rewritten from the incoming library"}
:set-token {:coverage :covered
:why "add, rename, displace and delete; the identity is the payload's own `:id`, which `changes_builder.cljc::set-token` builds from the token it names, and a taken name is one retraction"}
:set-token-set {:coverage :covered
:why "add, total replacement, displace and delete, with the set's tokens reconciled; a taken name retracts the set standing there, with its tokens"}
:rename-token-set-group {:coverage :partial
:why "the prefix rewrite over every set under the group; a new name held by a set outside the group refuses"}
:move-token-set {:coverage :partial
:why "the rename, and the reorder that changes no stored datom; a destination name already held refuses"}
:move-token-set-group {:coverage :partial
:why "the prefix rewrite and the reorder; a destination that already holds sets refuses, because the move drops them from the library"}
;; the residue: nothing these write reaches a stored datom
:fix-obj {:coverage :no-op :why "it repairs a parent's `:shapes` vector, which the overlay does not store"}
:reg-objects {:coverage :no-op :why "it writes geometry, which stays in the document"}
:mov-page {:coverage :no-op :why "it reorders the page list, and the overlay stores no page order"}
:set-plugin-data {:coverage :no-op :why "plugin data is not indexed"}
:set-comment-thread-position {:coverage :no-op :why "comment thread positions are not indexed"}
:set-guide {:coverage :no-op :why "guides are not indexed"}
:set-flow {:coverage :no-op :why "flows are not indexed"}
:set-default-grid {:coverage :no-op :why "default grids are not indexed"}
:add-media {:coverage :no-op :why "media lives in the document and the overlay holds no media entity"}
:mod-media {:coverage :no-op :why "the same reason as an add's"}
:del-media {:coverage :no-op :why "the same reason as an add's"}
:set-token-theme {:coverage :no-op :why "themes are not indexed"}
:set-active-token-themes {:coverage :no-op :why "the active theme set is not indexed"}
:set-base-font-size {:coverage :no-op :why "file options are not indexed"}})
(def ^:private operation-coverage
"One row per member of `app.common.files.changes/schema:operation`, the
second filter the change-type count does not show."
{:set {:coverage :covered
:why "the attributes the overlay indexes, and nil for the rest by design"}
:assign {:coverage :covered
:why "decoded against the shape's stored `:shape/type` and replayed as one `:set` per attribute"}
:set-touched {:coverage :covered
:why "only the swap slot `ctk/get-swap-slot` extracts is indexed, and the mirror writes it"}
:set-remote-synced {:coverage :no-op
:why "it writes `:remote-synced`, and no overlay attribute carries that name; the Ladybug shape tables do carry the column"}})
(def ^:private ladybug-only-gaps
"The change types that corrupt the Ladybug mirror, because
`app.graph.schema.nodes` gives that projection a column for every key of
the Penpot schema: the nine this tier still skips, plus
`:reorder-children`, which this tier covers and that mirror still drops
(the `IsChildOf` edge position and the container's `shapes` column keep
the old order). They are the `graph-worker` branch's work, not this
one's, and this set exists so the two lists cannot drift apart in
silence."
#{:reorder-children :fix-obj :reg-objects :mov-page :set-plugin-data
:set-comment-thread-position :set-guide :set-flow :set-default-grid
:set-base-font-size})
(defn- types-with
[table & coverages]
(into #{}
(keep (fn [[type* row]]
(when (contains? (set coverages) (:coverage row)) type*)))
table))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; the attribute vocabulary
;;
;; The third filter, after the change types and the operations: the
;; attributes a shape entity carries. They do not have one writer each. An
;; operation writes `:shape/name` and its neighbours through
;; `app.graph.overlay.sync/set-attr-tx`, a structural pass writes
;; `:shape/refers-to` (`reresolve-refs-tx`) and the sibling ordinal
;; (`order-tx`, which is also how the builder draws it), and the builder
;; writes the identity and topology edges and `:shape/type`. The comparison
;; asks whether every attribute `app.graph.overlay/schema` declares over
;; shape entities, plus the folded token vocabulary, has a writer, and
;; names its kind. An attribute nothing can write fails by name rather than passing
;; as derived, which is the failure mode the operation filter had before
;; the table closed it: the batch reports applied, the fold holds no datom
;; for the attribute, and a rebuild holds one.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def ^:private writer-kinds
"The three places an attribute a shape carries comes from."
#{:operation :pass :builder})
(def ^:private shape-attr-writers
"Every attribute a shape entity carries, and where it is written: an
`:operation` (the `:set` attribute that carries it), a structural
`:pass`, or the `:builder` alone. The folded token attributes ride both
the builder and the `:applied-tokens` operation, and the sibling ordinal
rides the builder and the structural pass that maintains it."
(merge
{;; written by an operation, through `set-attr-tx`
:shape/name [[:operation :name]]
:shape/component-id [[:operation :component-id]]
:shape/component-file [[:operation :component-file]]
:shape/shape-ref [[:operation :shape-ref]]
:shape/swap-slot [[:operation :touched]]
:shape/fill-color [[:operation :fills]]
:shape/stroke-color [[:operation :strokes]]
:shape/text-color [[:operation :content]]
:shape/uses-typography [[:operation :content]]
:shape/fill-color-ref-id [[:operation :fills]]
:shape/stroke-color-ref-id [[:operation :strokes]]
:shape/text-color-ref-id [[:operation :content]]
:shape/typography-ref-id [[:operation :content]]}
;; written by a structural pass, never by one operation
{:shape/refers-to [[:pass "reresolve-refs-tx"]]
:shape/order [[:pass "order-tx"] [:builder "shape-entity"]]}
;; written by the builder alone
{:shape/id [[:builder "shape-entity"]]
:shape/container [[:builder "shape-entity"]]
:shape/parent [[:builder "shape-entity"]]
:shape/type [[:builder "shape-attrs"]]}
;; the folded token vocabulary, from `app.common.types.token/all-keys`
(into {}
(map (fn [attr] [attr [[:builder "shape-token-attrs"]
[:operation :applied-tokens]]]))
overlay/token-attrs)))
(def ^:private excluded-shape-attrs
"The declared shape attributes the comparison does not compare, with the
reason, as the normal form excludes the Euler intervals.
`renumber-container-tx` writes both intervals on the fold and the
builder writes them on the rebuild, but the two draw their numbers from
different DFS orders, so the values are not comparable and only
containment is pinned (`the-intervals-agree-after-the-full-replay`)."
{:shape/enter "the fold and the rebuild number the intervals differently; containment is the invariant"
:shape/exit "the fold and the rebuild number the intervals differently; containment is the invariant"})
(defn- declared-shape-attrs
"The attributes `app.graph.overlay/schema` declares over shape entities,
plus the folded token vocabulary that needs no declaration."
[]
(into (into #{} (filter (fn [attr] (= "shape" (namespace attr)))) (keys overlay/schema))
overlay/token-attrs))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; the round trip, the table, and the gate
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(t/deftest the-fixture-exercises-every-supported-change-type
@ -431,6 +786,90 @@
(str "prefix of length " n " diverges; skipped "
(pr-str (:skipped result))))))))
(t/deftest a-set-written-onto-a-taken-name-leaves-one-set
;; The shared change list asserts that nothing skips, so a collision row
;; cannot live there; this folds a list of its own and compares it against
;; a rebuild, in the shape `round-trip` uses. `base-data` already holds
;; `token-set-id` named "Brand" with `token-id` under it, so the second
;; change below lands on that name and both entities must leave.
(let [change-list [{:type :set-token-set :id token-set2-id
:attrs {:id token-set2-id :name "Semantic"}}
{:type :set-token-set :id token-set2-id
:attrs {:id token-set2-id :name "Brand" :tokens {}}}]
result (sync/apply-changes (overlay/build (base-data)) change-list)
folded (:db result)
{:keys [diff skipped]} (round-trip change-list)]
(t/is (empty? skipped)
(str "a displacement must not skip: " (pr-str skipped)))
(t/is (empty? diff)
(str "fold and rebuild disagree on " (pr-str diff)))
(t/is (nil? (d/entid folded [:token-set/id token-set-id]))
"the displaced set left the library")
(t/is (nil? (d/entid folded [:token/id token-id]))
"and so did the token under it")))
(t/deftest a-token-written-onto-a-taken-name-leaves-one-token
;; The two writes a taken token name can arrive from, each folded as a
;; list of two changes and compared against the rebuild. The rename is
;; the branch whose document outcome reads the token map's order
;; (`pp:graph:token-rename-displacement-is-order-dependent`); this list
;; is the ordering where the holder is the one that goes, which is the
;; reading the mirror takes.
(let [check (fn [label change-list displaced kept]
(let [result (sync/apply-changes (overlay/build (base-data)) change-list)
folded (:db result)
{:keys [diff skipped]} (round-trip change-list)]
(t/is (empty? skipped)
(str label ": the displacement must not skip " (pr-str skipped)))
(t/is (empty? diff)
(str label ": fold and rebuild disagree on " (pr-str diff)))
(t/is (nil? (d/entid folded [:token/id displaced]))
(str label ": the displaced token left the library"))
(t/is (some? (d/entid folded [:token/id kept]))
(str label ": the token that took the name stayed"))))]
;; a fresh id added under a name the set already holds
(check "add onto a taken name"
[{:type :set-token :set-id token-set-id :token-id token2-id
:attrs {:id token2-id :name "second" :type :color :value "#123456"}}
{:type :set-token :set-id token-set-id :token-id token3-id
:attrs {:id token3-id :name "second" :type :color :value "#654321"}}]
token2-id token3-id)
;; an existing token renamed onto a name another token holds
(check "rename onto a taken name"
[{:type :set-token :set-id token-set-id :token-id token2-id
:attrs {:id token2-id :name "second" :type :color :value "#123456"}}
{:type :set-token :set-id token-set-id :token-id token2-id
:attrs {:id token2-id :name "brand.primary" :type :color :value "#123456"}}]
token-id token2-id)))
(t/deftest the-standing-queries-answer-the-same-from-the-fold-and-the-rebuild
;; The raw ids ride beside the resolved references, and the standing
;; queries read the references: `uses-color` reunites the three colour
;; sources, `shapes-using-typography` reads the ref, and `uses-token`
;; keys off the folded name. The prefix ends before the typography and
;; colour deletions so each query has an answer to compare, and the
;; colour answer names both sources the repair fills in: rect's fill,
;; which landed before the colour existed, and rect2's stroke.
(let [n (inc (first (keep-indexed
(fn [i ch] (when (= :mod-typography (:type ch)) i))
changes)))
prefix (subvec changes 0 n)
data0 (base-data)
synced (:db (sync/apply-changes (overlay/build data0) prefix))
rebuilt (overlay/build (cp/process-changes data0 prefix false))]
(t/is (= #{[page-id rect-id] [page-id rect2-id]}
(queries/shapes-using-color synced color2-id)))
(t/is (= (queries/shapes-using-color synced color2-id)
(queries/shapes-using-color rebuilt color2-id)))
(t/is (= #{[page-id text-id]}
(queries/shapes-using-typography synced typ-id)))
(t/is (= (queries/shapes-using-typography synced typ-id)
(queries/shapes-using-typography rebuilt typ-id)))
(t/is (= #{[page-id rect2-id :fill]}
(queries/shapes-using-token synced "brand.primary")))
(t/is (= (queries/shapes-using-token synced "brand.primary")
(queries/shapes-using-token rebuilt "brand.primary")))))
(t/deftest soft-delete-keeps-the-component-container-copy
;; `ctf/delete-component` without `skip-undelete?` stores the
;; main-instance subtree on the component (`ctf/load-component-objects`);
@ -467,13 +906,14 @@
:container/document [:document file-id]}]))))
;; the copies' `:shape/refers-to` equals the rebuild's, pointing at
;; the snapshot copies (the repointed copy child resolves to the
;; root copy, its :shape-ref was set to comp-root-id)
;; the snapshot copies. The copy child's last `:shape-ref` write is
;; the `:assign` operation, so it resolves to the child copy, and the
;; copy root resolves to the root copy.
(t/is (= (get-in rebuilt-m [[:shape page-id copy-root-id] :shape/refers-to])
(get-in synced-m [[:shape page-id copy-root-id] :shape/refers-to])))
(t/is (= [:shape comp-id comp-root-id]
(get-in synced-m [[:shape page-id copy-root-id] :shape/refers-to])))
(t/is (= [:shape comp-id comp-root-id]
(t/is (= [:shape comp-id comp-child-id]
(get-in synced-m [[:shape page-id copy-child-id] :shape/refers-to])))))
(t/deftest the-diff-catches-an-injected-sync-bug
@ -496,6 +936,30 @@
(t/is (contains? moved [:shape page-id text-id])
"a sync that skips a reparent must name the moved shape's key")))
(t/deftest the-diff-catches-a-dropped-reorder
;; The mirror is load-bearing, and this is the assertion that says so.
;; Drop the reorder from the list the overlay sees and keep it in the
;; list the document sees: the two shapes the reorder moved are named by
;; the difference, each with the ordinal the fold holds and the ordinal
;; the rebuild derived.
(let [data0 (base-data)
data1 (cp/process-changes data0 changes false)
crippled (remove #(= :reorder-children (:type %)) changes)
synced (into {} (normal-form (:db (sync/apply-changes (overlay/build data0)
crippled))))
rebuilt (into {} (normal-form (overlay/build data1)))
moved (into {}
(keep (fn [[key attrs]]
(when (not= (:shape/order attrs)
(:shape/order (get rebuilt key)))
[key [(:shape/order attrs)
(:shape/order (get rebuilt key))]])))
synced)]
(t/is (= {[:shape page-id rect-id] [1 0]
[:shape page-id rect2-id] [0 1]}
moved)
"a fold that drops the reorder must name the two shapes it left behind")))
(t/deftest the-intervals-agree-after-the-full-replay
;; The Euler-tour invariants hold on the synced db, not only on the
;; built one. The sync path renumbers a container from beyond the
@ -540,3 +1004,327 @@
(t/is (ok? (nth intervals i) (nth intervals j))
(str "intervals " (pr-str (nth intervals i)) " and "
(pr-str (nth intervals j)) " partially overlap"))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; the sibling ordinal
;;
;; `:shape/order` is the position a shape holds in its parent's `:shapes`
;; vector, and it is the one piece of order the index owns: the intervals
;; answer containment and are excluded from the comparison, so a consumer
;; holding an overlay and no document reads this attribute to learn which
;; child of which parent a shape is
;; (`pp:graph:sibling-order-needs-an-authored-attribute`).
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn- ordinals
"The sibling ordinal of every shape, keyed by the shape's own id: what
a consumer reads out of the index without the document."
[db]
(into {} (d/q '[:find ?id ?o :where [?s :shape/id ?id] [?s :shape/order ?o]] db)))
(defn- document-containers
"Every container of one decoded document as [container-id objects]: the
pages in file order, then the components that carry their own copy."
[data]
(into (vec (keep (fn [page-id]
(when-let [page (get-in data [:pages-index page-id])]
[page-id (:objects page)]))
(:pages data)))
(keep (fn [[component-id component]]
(when-let [objects (:objects component)]
[component-id objects])))
(:components data)))
(t/deftest the-sibling-ordinal-recovers-each-shape-position
;; The ordinal's acceptance, against the document's own vector: for every
;; container, parent and child, the child at index i of `:shapes` carries
;; ordinal i in the index. Both paths are checked, because the builder
;; derives the ordinal from the vector and the fold maintains it from the
;; changes, and a consumer cannot tell which one produced the index it
;; holds.
(let [data0 (base-data)
data1 (cp/process-changes data0 changes false)
built (overlay/build data1)
folded (:db (sync/apply-changes (overlay/build data0) changes))]
(doseq [[label db] [["built" built] ["folded" folded]]
[cid objects] (document-containers data1)
[pid parent] objects
[i sid] (map-indexed vector (:shapes parent))]
(let [ceid (queries/container-eid db cid)
e (d/entity db (queries/shape-eid db ceid sid))]
(t/is (= i (:shape/order e))
(str label ": shape " (pr-str sid) " at index " i " of "
(pr-str pid) "'s children in container " (pr-str cid)
" reads ordinal " (pr-str (:shape/order e))))))))
(t/deftest an-insertion-rewrites-no-siblings-ordinal
;; The blast radius the acceptance asks for: applying one insertion
;; through the sync path adds a datom for the appended child and rewrites
;; the ordinal of no shape that was already present. The
;; five-thousand-object measurement is the entry's own; this is the same
;; claim at fixture size, where a regression fails here rather than in a
;; script nobody runs.
(let [data0 (base-data)
prefix (subvec changes 0 6)
db (-> (overlay/build data0) (sync/apply-changes prefix) :db)
before (ordinals db)
new-id (uuid/next)
result (sync/apply-changes
db
[{:type :add-obj :page-id page-id :id new-id
:parent-id frame-id :frame-id frame-id
:obj (shape new-id :rect {:name "Added" :parent-id frame-id
:frame-id frame-id
:width 5 :height 5})}])
after (ordinals (:db result))]
(t/is (empty? (:skipped result))
(str "the insertion must not skip: " (pr-str (:skipped result))))
(t/is (= before (dissoc after new-id))
"an insertion must leave every ordinal a shape already carried alone")
(t/is (= 4 (get after new-id))
"and the appended child lands after the frame's four children")))
(t/deftest a-reorder-inside-a-component-copy-needs-allow-altering-copies
;; `process-children-reordering` leaves copy child ordering to component
;; sync unless the change allows altering copies. A parent carrying a
;; `:shape-ref` is a copy on both paths, so the same reorder reaches
;; neither child list without the flag and both with it.
(let [root (uuid/next)
child-1 (uuid/next)
child-2 (uuid/next)
setup [{:type :add-obj :page-id page-id :id root
:parent-id uuid/zero :frame-id uuid/zero
:obj (shape root :frame {:name "Copy root" :parent-id uuid/zero
:frame-id uuid/zero
:width 100 :height 100
:shape-ref rect-id})}
{:type :add-obj :page-id page-id :id child-1
:parent-id root :frame-id root
:obj (shape child-1 :rect {:name "First" :parent-id root
:frame-id root :width 10 :height 10})}
{:type :add-obj :page-id page-id :id child-2
:parent-id root :frame-id root
:obj (shape child-2 :rect {:name "Second" :parent-id root
:frame-id root :width 10 :height 10})}]
reorder (fn [flags]
(conj (vec setup)
(merge {:type :reorder-children :page-id page-id
:parent-id root
:shapes [child-2 child-1]}
flags)))]
(doseq [[label flags expected] [["without the flag" {}
{child-1 0 child-2 1}]
["with the flag" {:allow-altering-copies true}
{child-2 0 child-1 1}]]]
(let [result (sync/apply-changes (overlay/build (base-data)) (reorder flags))
{:keys [diff skipped]} (round-trip (reorder flags))]
(t/is (empty? skipped)
(str label ": the reorder must not skip: " (pr-str skipped)))
(t/is (empty? diff)
(str label ": fold and rebuild disagree on " (pr-str diff)))
(t/is (= expected (select-keys (ordinals (:db result)) [child-1 child-2]))
(str label ": the copy's child order moved the wrong way"))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; the staleness gate
;;
;; Three pieces: a pure verdict over one batch, a session that records
;; it, and two read gates that refuse while it is set. The session here
;; is synthetic, because the verdict is what needs pinning and a real
;; `load-session!` would need a file in Postgres.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def ^:private a-query
"[:find ?e :where [?e :document/id _]]")
(def ^:private clean-change
{:type :mod-page :id page-id :name "Renamed by the sync loop"})
(def ^:private unsupported-change
"A change type this tier has no mirror for, which is what the staleness
gate catches: plugin data reaches no overlay attribute. It was
`:reorder-children` until the sibling ordinal landed and that type
became mirrorable."
{:type :set-plugin-data
:object-type :shape
:object-id rect-id
:page-id page-id
:namespace :fixture
:key "the-plugin"
:value "{:anything true}"})
(defn- with-session
"Call `f` with one session registered in `app.graph.debug`: the fixture
overlay in an atom and the metadata a load would have written, with no
database, no msgbus and no sync loop. The registry is a private
`defonce`, and reaching it is the seam a session-level assertion needs."
[f]
(let [registry @#'graph.debug/sessions
profile (uuid/next)]
(try
(swap! registry assoc (str profile)
{:db-atom (atom (overlay/build (base-data)))
:file-id file-id
:meta {:name "Fixture"
:revn 1
:graph-revn 1
:schema-version overlay/schema-version}
:profile-id profile
:loaded-at (ct/now)})
(f profile)
(finally
(swap! registry dissoc (str profile))))))
(defn- deliver-batch!
"One msgbus file-change message, delivered the way the sync loop
delivers it."
[profile revn change-list]
(#'graph.debug/apply-file-change! profile {:file-id file-id
:revn revn
:changes change-list}))
(defn- refusal
[thunk]
(try (thunk) nil (catch Throwable cause (ex-data cause))))
(t/deftest the-staleness-verdict-pins-its-three-cases
(t/is (nil? (sync/staleness 41 42 {:applied [:mod-obj] :skipped []}))
"a contiguous revision with nothing skipped is not stale")
(t/is (= {:reason :revision-gap :graph-revn 41 :revn 43}
(sync/staleness 41 43 {:applied [:mod-obj] :skipped []}))
"a revision that skips a number is a message this index never saw")
(t/is (= {:reason :skipped :types [:set-plugin-data]}
(sync/staleness 41 42 {:applied []
:skipped [{:type :set-plugin-data
:reason :unsupported-type}]}))
"a skipped change names its type")
(t/is (= :apply-failed (:reason (sync/staleness 41 42 {:error "boom"}))))
(t/is (= sync/stale-reasons
(into #{} (keep :reason)
[(sync/staleness 41 43 {})
(sync/staleness 41 42 {:skipped [{:type :set-plugin-data}]})
(sync/staleness 41 42 {:error "boom"})]))
"the three cases are the three the namespace names"))
(t/deftest a-clean-contiguous-batch-leaves-the-session-fresh
(with-session
(fn [profile]
(deliver-batch! profile 2 [clean-change])
(let [status (graph.debug/sync-status profile)]
(t/is (= 2 (:graph-revn status))
"the revision is stamped for every message")
(t/is (nil? (:stale status)))
(t/is (nil? (:reason status)))))))
(t/deftest a-skipped-change-marks-the-session-stale-for-good
(with-session
(fn [profile]
(deliver-batch! profile 2 [unsupported-change])
(let [status (graph.debug/sync-status profile)]
(t/is (= :skipped (:reason status)))
(t/is (= [:set-plugin-data] (get-in status [:stale :types])))
(t/is (= 2 (:graph-revn status))
"a batch that applied nothing still advanced the file"))
(deliver-batch! profile 3 [clean-change])
(t/is (= :skipped (:reason (graph.debug/sync-status profile)))
"a later clean batch must not clear the mark: only a rebuild does"))))
(t/deftest a-revision-gap-marks-the-session-stale
(with-session
(fn [profile]
(deliver-batch! profile 4 [clean-change])
(t/is (= {:reason :revision-gap :graph-revn 1 :revn 4}
(:stale (graph.debug/sync-status profile)))))))
(t/deftest a-batch-that-throws-marks-the-session-stale
(with-session
(fn [profile]
(with-redefs [sync/apply-changes (fn [& _] (throw (ex-info "boom" {})))]
(deliver-batch! profile 2 [clean-change]))
(t/is (= :apply-failed (:reason (graph.debug/sync-status profile)))))))
(t/deftest a-stale-session-refuses-both-reads
(with-session
(fn [profile]
(t/is (some? (:rows (graph.debug/query-session! profile a-query)))
"a fresh session answers")
(t/is (some? (:nodes (graph.debug/export-graph-data! profile))))
(deliver-batch! profile 2 [unsupported-change])
(let [data (refusal #(graph.debug/query-session! profile a-query))]
(t/is (= :graph-index-stale (:code data)))
(t/is (= :skipped (:reason data))))
(t/is (= :graph-index-stale
(:code (refusal #(graph.debug/export-graph-data! profile))))
"the graph view is the second read gate")
(t/is (= :skipped (:reason (graph.debug/sync-status profile)))
"and the status names the reason the reads refused"))))
(t/deftest the-classification-table-names-every-change-type
;; The point of the table: a type Penpot adds upstream fails here by
;; name rather than being skipped in silence. `:default` is a dispatch
;; fallback, not a member of the vocabulary.
(let [dispatched (disj (set (keys (methods cp/process-change))) :default)
rows (set (keys change-coverage))]
(t/is (= dispatched rows)
(str "change types with no row: " (pr-str (set/difference dispatched rows))
"; rows naming no change type: " (pr-str (set/difference rows dispatched)))))
(t/is (every? (comp string? :why val) change-coverage)
"every row carries its reason")
(t/is (= sync/supported-change-types (types-with change-coverage :covered :partial))
"the applier's dispatch and the table's verdict are one list")
(t/is (empty? (set/intersection (types-with change-coverage :no-op)
sync/supported-change-types))
"a type that cannot reach a datom must not claim support")
(t/is (set/subset? (set/difference ladybug-only-gaps sync/supported-change-types)
(types-with change-coverage :no-op))
"the Ladybug residue this tier does not cover is a subset of this tier's no-ops")
(t/is (contains? ladybug-only-gaps :reorder-children)
"a reorder stays a named gap on the Ladybug mirror")
(t/is (contains? (types-with change-coverage :covered) :reorder-children)
"and it is covered here, which is what the ordinal bought"))
(t/deftest the-classification-table-names-every-operation
(let [dispatched (disj (set (keys (methods cp/process-operation))) :default)
rows (set (keys operation-coverage))]
(t/is (= dispatched rows)
(str "operations with no row: " (pr-str (set/difference dispatched rows))
"; rows naming no operation: " (pr-str (set/difference rows dispatched)))))
(t/is (every? (comp string? :why val) operation-coverage))
(t/is (= #{:set :assign :set-touched} (types-with operation-coverage :covered))
"the three operations that reach an overlay attribute")
(t/is (= #{:set-remote-synced} (types-with operation-coverage :no-op))))
(t/deftest every-declared-shape-attribute-names-its-writer
;; The third filter, and the one that fails by name: a shape attribute
;; the builder starts indexing must arrive here with its writer, or the
;; fold writes no datom for it while a rebuild does, and no gate sees the
;; difference because nothing was skipped.
(let [declared (declared-shape-attrs)
named (set/union (set (keys shape-attr-writers))
(set (keys excluded-shape-attrs)))
unwritten (set/difference declared named)
undeclared (set/difference named declared)
unnamed (into #{}
(keep (fn [[attr writers]]
(when (or (empty? writers)
(not-every? (fn [[kind writer]]
(and (contains? writer-kinds kind)
(some? writer)))
writers))
attr)))
shape-attr-writers)]
(t/is (empty? unwritten)
(str "shape attributes with no writer and no named exclusion: "
(pr-str (sort unwritten))))
(t/is (empty? undeclared)
(str "writers declared for attributes the schema does not carry: "
(pr-str (sort undeclared))))
(t/is (empty? unnamed)
(str "attributes whose writer entry names no writer: "
(pr-str (sort unnamed))))
(t/is (every? (comp string? val) excluded-shape-attrs)
"every excluded attribute carries its reason")
(t/is (= #{:shape/enter :shape/exit} (set (keys excluded-shape-attrs)))
"the intervals are the only attributes the comparison excludes")))