diff --git a/backend/src/app/graph/debug.clj b/backend/src/app/graph/debug.clj index 6a3b35907d..c42a045a33 100644 --- a/backend/src/app/graph/debug.clj +++ b/backend/src/app/graph/debug.clj @@ -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 %))) diff --git a/backend/src/app/graph/overlay.clj b/backend/src/app/graph/overlay.clj index 6645e6fbfb..2c860daaa9 100644 --- a/backend/src/app/graph/overlay.clj +++ b/backend/src/app/graph/overlay.clj @@ -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)))] diff --git a/backend/src/app/graph/overlay/sync.clj b/backend/src/app/graph/overlay/sync.clj index 9088734805..9d7c46a586 100644 --- a/backend/src/app/graph/overlay/sync.clj +++ b/backend/src/app/graph/overlay/sync.clj @@ -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))})) diff --git a/backend/test/backend_tests/graph_overlay_sync_test.clj b/backend/test/backend_tests/graph_overlay_sync_test.clj index 1537706566..05cb891f95 100644 --- a/backend/test/backend_tests/graph_overlay_sync_test.clj +++ b/backend/test/backend_tests/graph_overlay_sync_test.clj @@ -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")))