diff --git a/backend/src/app/graph/debug.clj b/backend/src/app/graph/debug.clj index 85787243e2..6a3b35907d 100644 --- a/backend/src/app/graph/debug.clj +++ b/backend/src/app/graph/debug.clj @@ -42,7 +42,7 @@ " ?filter_src_id ?filter_tgt_id\n" " :in $ %\n" " :where\n" - " (is-instance-of ?s ?c)\n" + " (instance-of ?s ?c)\n" " [?c :component/name ?component]\n" " [?s :shape/name ?instance]\n" " [?s :shape/container ?pc]\n" @@ -270,14 +270,16 @@ db queries/rules))) (defn- token-use-edges + "UsesToken edges from the folded token attributes, joined to token + entities by name (one edge per matching token when names repeat across + sets, the same join the `uses-token` rule performs)." [db] - (keep (fn [dtm] - (let [e (d/entity db (:e dtm))] - (when-let [token (:token-use/token e)] - {:source (str (:db/id (:token-use/shape e))) - :target (str (:db/id token)) - :rel "UsesToken"}))) - (d/datoms db :avet :token-use/shape))) + (for [attr overlay/token-attrs + dtm (d/datoms db :aevt attr) + token (map :e (d/datoms db :avet :token/name (:v dtm)))] + {:source (str (:e dtm)) + :target (str token) + :rel "UsesToken"})) (defn export-graph-data! "Export the node/edge inventory of the overlay for `profile-id` as plain @@ -298,7 +300,7 @@ (into (ref-edges db :typography/document "IsChildOf")) (into (ref-edges db :token-set/document "IsChildOf")) (into (ref-edges db :token/set "IsChildOf")) - (into (rule-edges db 'is-instance-of "IsInstanceOf")) + (into (rule-edges db 'instance-of "IsInstanceOf")) (into (rule-edges db 'refers-to "RefersTo")) (into (rule-edges db 'fills-swap-slot "FillsSwapSlot")) (into (ref-edges db :shape/fill-color "UsesColor")) diff --git a/backend/src/app/graph/overlay.clj b/backend/src/app/graph/overlay.clj index f7ab3e7a4d..5898877512 100644 --- a/backend/src/app/graph/overlay.clj +++ b/backend/src/app/graph/overlay.clj @@ -24,17 +24,54 @@ parent links are datascript entity references, so topology is interned by construction. + Three results of the 2026-08-20 study are structural here + (docs.local/graph/20260820-report-graph-overlay-datascript.md): + + - **Subtle helpers run in the builder, never in a query.** + `ctf/find-ref-shape` is called once per copy shape at build time and + its answer becomes the plain `:shape/refers-to` reference; a query + never touches the helper. Unresolvable references (libraries not + loaded) simply produce no edge. + - **Containment carries a second form**: one global Euler-tour + numbering, one DFS per container drawing from a single global + counter, so `inside subtree X` is two interval comparisons. The + counter is global because per-container counters overlap numerically + and silently match other pages. + - **Token applications fold the property into the attribute name**: + `{:token/fill \"layerTwo.background\"}` on the shape itself, over the + closed vocabulary of `app.common.types.token/all-keys`. The + `uses-token` rule in `app.graph.overlay.queries` hides the encoding, + so the choice stays reversible. + The namespace is deliberately JVM-free (no imports, no interop): the same code moves to the browser worker as a `.cljc` rename when the mirror experiment lands, which is the point of choosing datascript." (:require - [app.common.types.text :as txt] [app.common.types.component :as ctk] + [app.common.types.container :as ctn] + [app.common.types.file :as ctf] + [app.common.types.text :as txt] + [app.common.types.token :as cto] [app.common.types.tokens-lib :as ctob] [datascript.core :as d])) (def schema-version - "penpot-graph-overlay-1") + "penpot-graph-overlay-2") + +(def token-attr + "The overlay attribute carrying one applied-token property: + `:fill` -> `:token/fill`." + (into {} (map (fn [k] [k (keyword "token" (name k))])) cto/all-keys)) + +(def token-attrs + "The closed folded-token vocabulary, one attribute per applied-token + property of `app.common.types.token/all-keys`." + (into #{} (vals token-attr))) + +(defn token-attr->prop + "`:token/fill` -> `:fill`." + [attr] + (keyword (name attr))) (def schema "Only identity, type, topology, and the attributes a standing query has @@ -45,7 +82,8 @@ 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." + reunites them. 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 @@ -60,6 +98,11 @@ :shape/component-file {:db/index true} :shape/shape-ref {:db/index true} :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} + ;; global Euler-tour containment intervals + :shape/enter {:db/index true} + :shape/exit {:db/index true} ;; asset links (the beadpot ledger's asset link transforms) :shape/fill-color {:db/valueType :db.type/ref :db/cardinality :db.cardinality/many} @@ -81,11 +124,7 @@ :token-set/document {:db/valueType :db.type/ref} :token/id {:db/unique :db.unique/identity} :token/name {:db/index true} - :token/set {:db/valueType :db.type/ref} - ;; applied tokens: one entity per (shape, property, token), because an - ;; edge with a payload needs a relation entity in a triple store - :token-use/shape {:db/valueType :db.type/ref} - :token-use/token {:db/valueType :db.type/ref}}) + :token/set {:db/valueType :db.type/ref}}) (def shape-type->table "The Ladybug projection's node table names, kept for parity counting and @@ -152,14 +191,7 @@ (into #{} (keep :typography-ref-id) (some-> content txt/node-seq))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; entity construction -;; -;; `asset-ctx` abstracts over build and sync: `:colors`, `:typographies` -;; map locally defined asset ids to entity references (string tempids at -;; build time, resolved eids at sync time), and `:tokens-by-name` maps a -;; token name to the references of every token carrying it. Only -;; resolvable references become edges, mirroring beadpot's `node_exists` -;; guard. +;; Euler-tour numbering ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn- resolvable-parent? @@ -169,8 +201,64 @@ (not= parent-id (:id shape)) (contains? objects parent-id)))) +(defn euler-numbering + "Euler-tour intervals for one container's `:objects`, drawn from the + global `counter`: a DFS from the container roots in stored child order, + then a degenerate interval for any shape the tree cannot reach, so the + whole map stays indexed. Returns [{shape-id [enter exit]} counter']. + + The counter is global across containers on purpose: per-container + counters produce numerically overlapping ranges, and an interval query + would silently match shapes of other pages." + [objects counter] + (let [roots (into [] + (comp (filter #(not (resolvable-parent? objects %))) + (map :id)) + (vals objects))] + (loop [events (into [] (map (fn [id] [:enter id])) roots) + counter (long counter) + acc (transient {})] + (if-let [[kind id] (peek events)] + (let [events (pop events)] + (case kind + :enter + (let [children (into [] + (filter #(contains? objects %)) + (get-in objects [id :shapes]))] + (recur (-> events + (conj [:exit id]) + (into (map (fn [c] [:enter c])) (rseq children))) + (inc counter) + (assoc! acc id [counter nil]))) + + :exit + (recur events + (inc counter) + (assoc! acc id (assoc (get acc id) 1 counter))))) + (let [walked (persistent! acc) + ;; degenerate intervals for orphans the tree cannot reach + [walked counter] + (reduce (fn [[m c] id] + (if (contains? m id) + [m c] + [(assoc m id [c (inc c)]) (+ c 2)])) + [walked counter] + (keys objects))] + [walked counter]))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; entity construction +;; +;; `build-ctx` carries the resolution state of one build: `:colors` and +;; `:typographies` map locally defined asset ids to entity references +;; (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. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (defn shape-asset-attrs - "The asset-edge attributes of one shape, resolved through `asset-ctx`." + "The asset-edge attributes of one shape, resolved through the ctx." [shape {:keys [colors typographies]}] (let [ref-vals (fn [m ids] (into [] (keep m) ids)) fills (ref-vals colors (fill-color-ref-ids (:fills shape))) @@ -184,11 +272,25 @@ (seq text) (assoc :shape/text-color text) (seq typs) (assoc :shape/uses-typography typs)))) +(defn shape-token-attrs + "The folded applied-token attributes of one shape: one datom per applied + property, value the applied token name, attribute from the closed + vocabulary. Unresolvable names are stored too; the `uses-token` rule + joins on `:token/name`, so they surface only when the token exists." + [applied-tokens] + (reduce-kv (fn [acc k v] + (if-let [attr (token-attr k)] + (assoc acc attr v) + acc)) + {} + (or applied-tokens {}))) + (defn shape-attrs "The plain indexed attributes of one shape (no identity, no topology)." [shape] (let [swap-slot (ctk/get-swap-slot shape)] - (cond-> {:shape/type (:type shape)} + (cond-> (merge {:shape/type (:type shape)} + (shape-token-attrs (:applied-tokens shape))) (some? (:name shape)) (assoc :shape/name (:name shape)) (some? (:component-id shape)) (assoc :shape/component-id (:component-id shape)) (some? (:component-file shape)) (assoc :shape/component-file (:component-file shape)) @@ -204,44 +306,31 @@ 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 asset-ctx] - (merge {:db/id (shape-tempid container-id (:id shape)) - :shape/id (:id shape) - :shape/container container-ref - :shape/parent (if (resolvable-parent? objects shape) - (shape-tempid container-id (:parent-id shape)) - container-ref)} - (shape-attrs shape) - (shape-asset-attrs shape asset-ctx))) - -(defn token-use-entities - "One (shape, property, token) entity per applied token that resolves. - - Token names are unique within a set but not across sets, so one applied - name may match several tokens; every match links, exactly as beadpot's - name join does (`beadpot.graph.transform.tokens/LinkAppliedTokens`)." - [shape-ref applied-tokens tokens-by-name] - (for [[prop token-name] applied-tokens - token-ref (get tokens-by-name token-name)] - {:token-use/shape shape-ref - :token-use/token token-ref - :token-use/prop prop})) + [container-ref container-id objects shape {:keys [resolve-ref numbering] :as ctx}] + (let [[enter exit] (get numbering (:id shape)) + ref (when resolve-ref (resolve-ref shape))] + (merge (cond-> {:db/id (shape-tempid container-id (:id shape)) + :shape/id (:id shape) + :shape/container container-ref + :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)) + (shape-attrs shape) + (shape-asset-attrs shape ctx)))) (defn container-entities - "Entities for every shape of one container's `:objects` map, plus the - applied-token relation entities. + "Entities for every shape of one container's `:objects` map. The whole map is indexed, not the tree walk from the root: a shape the tree cannot reach is a document defect the index should expose to queries rather than hide (the Ladybug projection walks and drops such shapes with a warning; this is a recorded divergence)." - [container-ref container-id objects asset-ctx] + [container-ref container-id objects ctx] (into [] - (mapcat (fn [shape] - (cons (shape-entity container-ref container-id objects shape asset-ctx) - (token-use-entities (shape-tempid container-id (:id shape)) - (:applied-tokens shape) - (:tokens-by-name asset-ctx))))) + (map (fn [shape] + (shape-entity container-ref container-id objects shape ctx))) (vals objects))) (defn component-entity @@ -262,7 +351,7 @@ "The component record entity, plus a container over its own `:objects` when it carries one (deleted components keep the main-instance subtree, `app.common.types.file/load-component-objects`)." - [component asset-ctx] + [component ctx] (let [objects (:objects component)] (cond-> [(component-entity component)] (seq objects) @@ -271,17 +360,17 @@ :container/kind :component :container/document doc-tempid}) (into (container-entities (container-tempid (:id component)) - (:id component) objects asset-ctx)))))) + (:id component) objects ctx)))))) (defn- page-tx - [page asset-ctx] + [page ctx] (into [(cond-> {:db/id (container-tempid (:id page)) :container/id (:id page) :container/kind :page :container/document doc-tempid} (some? (:name page)) (assoc :container/name (:name page)))] (container-entities (container-tempid (:id page)) - (:id page) (:objects page) asset-ctx))) + (:id page) (:objects page) ctx))) (defn- tokens-tx "Token set and token entities from the file's tokens lib. @@ -305,51 +394,82 @@ :token/set (token-set-tempid set-id)}))))) (some-> tokens-lib ctob/get-sets))) -(defn- build-tokens-by-name - "Token name -> tempids of every token carrying that name." - [tokens-lib] - (reduce (fn [acc set*] - (reduce-kv (fn [acc _ token] - (update acc (:name token) (fnil conj []) - (token-tempid (:id token)))) - acc - (ctob/get-tokens- set*))) - {} - (some-> tokens-lib ctob/get-sets))) +(defn- ref-resolver + "The build-time `:resolve-ref`: `ctf/find-ref-shape` once per copy + shape, against one ctn container, its answer minted as the target's + build tempid. The subtle helper runs here, in the builder, never in a + query; its fostered-children and swap fallbacks stay its own." + [data file-id ctn-container] + (let [file {:id file-id :data data}] + (fn [shape] + (when (:shape-ref shape) + (when-let [ref (ctf/find-ref-shape file ctn-container {} shape + :include-deleted? true + :with-context? true)] + (when-let [target-container-id (:id (:container (meta ref)))] + (shape-tempid target-container-id (:id ref)))))))) -(defn- build-asset-ctx +(defn- build-asset-maps [data] - {:colors (into {} (map (fn [[id _]] [id (color-tempid id)])) - (:colors data)) - :typographies (into {} (map (fn [[id _]] [id (typography-tempid id)])) - (:typographies data)) - :tokens-by-name (build-tokens-by-name (:tokens-lib data))}) + {:colors (into {} (map (fn [[id _]] [id (color-tempid id)])) + (:colors data)) + :typographies (into {} (map (fn [[id _]] [id (typography-tempid id)])) + (:typographies data))}) (defn build-tx "The full transaction that projects file `data` into an empty overlay. - `file` supplies `:id` and `:name` when `data` does not carry them." + `file` supplies `:id` and `:name` when `data` does not carry them. The + Euler counter threads globally across containers, components first, + pages after, so every interval in the file is disjoint." [data file] (let [doc-id (or (:id data) (:id file)) - ctx (build-asset-ctx data)] - (-> [(cond-> {:db/id doc-tempid :document/id doc-id} - (some? (:name file)) (assoc :document/name (:name file)))] - (into (map (fn [[id color]] - (cond-> {:db/id (color-tempid id) - :color/id id - :color/document doc-tempid} - (some? (:name color)) (assoc :color/name (:name color))))) - (:colors data)) - (into (map (fn [[id typ]] - (cond-> {:db/id (typography-tempid id) - :typography/id id - :typography/document doc-tempid} - (some? (:name typ)) (assoc :typography/name (:name typ))))) - (:typographies data)) - (into (tokens-tx (:tokens-lib data))) - (into (mapcat #(component-tx (val %) ctx)) (:components data)) - (into (mapcat #(page-tx (get-in data [:pages-index %]) ctx)) - (filter #(get-in data [:pages-index %]) (:pages data)))))) + assets (build-asset-maps data) + head (-> [(cond-> {:db/id doc-tempid :document/id doc-id} + (some? (:name file)) (assoc :document/name (:name file)))] + (into (map (fn [[id color]] + (cond-> {:db/id (color-tempid id) + :color/id id + :color/document doc-tempid} + (some? (:name color)) (assoc :color/name (:name color))))) + (:colors data)) + (into (map (fn [[id typ]] + (cond-> {:db/id (typography-tempid id) + :typography/id id + :typography/document doc-tempid} + (some? (:name typ)) (assoc :typography/name (:name typ))))) + (:typographies data)) + (into (tokens-tx (:tokens-lib data)))) + [tx _counter] + (as-> [head 0] state + (reduce (fn [[tx counter] component] + (let [objects (:objects component) + [numbering counter] + (if (seq objects) + (euler-numbering objects counter) + [{} counter]) + ctx (assoc assets + :numbering numbering + :resolve-ref + (ref-resolver data doc-id + (ctn/make-container component :component)))] + [(into tx (component-tx component ctx)) counter])) + state + (vals (:components data))) + (reduce (fn [[tx counter] page-id] + (if-let [page (get-in data [:pages-index page-id])] + (let [[numbering counter] + (euler-numbering (:objects page) counter) + ctx (assoc assets + :numbering numbering + :resolve-ref + (ref-resolver data doc-id + (ctn/make-container page :page)))] + [(into tx (page-tx page ctx)) counter]) + [tx counter])) + state + (:pages data)))] + tx)) (defn build "Project file `data` into a fresh overlay. Pure: returns a datascript diff --git a/backend/src/app/graph/overlay/queries.clj b/backend/src/app/graph/overlay/queries.clj index 540c4b8491..08feeaa322 100644 --- a/backend/src/app/graph/overlay/queries.clj +++ b/backend/src/app/graph/overlay/queries.clj @@ -5,89 +5,121 @@ ;; Copyright (c) KALEIDOS INC Sucursal en España SL (ns app.graph.overlay.queries - "The standing question set over the overlay, plus the rule set the - console shares. + "The relation vocabulary and the standing question set over the overlay. + + **The relation vocabulary is a rule set, not raw clauses** + (docs.local/graph/20260820-report-graph-overlay-datascript.md). + `child-of`, `descendant-of`, `instance-of`, `refers-to`, + `fills-swap-slot` and `uses-token` are named once here, implemented per + engine and per encoding, and every consumer query and every backported + beadpot assertion is written against the rules only. The encodings can + change under a rule without a consumer noticing: `refers-to` reads a + builder-resolved reference today and read an id join before, + `uses-token` reads folded token attributes today and read relation + entities before, and the consumer texts did not move. + + Rule signatures are subject first: `(child-of ?c ?p)` reads \"?c is a + child of ?p\", `(descendant-of ?d ?a)` reads \"?d is a descendant of + ?a\". Division of labour, stated once and applied throughout: **when the caller holds the document, Penpot's helper is the query.** The upward walk (`ctn/get-parent-heads` over `cfh/get-parents-with-self`) runs - about 1 500 times faster than the datalog formulation because the - document already encodes it as a pointer chain - (docs.local/graph/20260819-report-graph-overlay-datascript.md). The - functions here exist for the reverse and cross-container questions the - document cannot answer without a full scan, and for callers that hold - only the index. Where a function mirrors a helper, its docstring names - that helper, and the semantic suite pins the equality; the helper stays - the oracle and is never reimplemented here." + about three orders of magnitude faster than any datalog formulation + because the document already encodes it as a pointer chain, and even + the interval form of containment loses to `cfh/get-children-ids` by an + order of magnitude (14.89 ms against 1.09 ms on an 808-child frame). + The functions here exist for the reverse and cross-container questions + the document cannot answer without a full scan, and for callers that + hold only the index. Where a function mirrors a helper, its docstring + names that helper, and the semantic suite pins the equality; the helper + stays the oracle and is never reimplemented here." (:require [app.common.uuid :as uuid] + [app.graph.overlay :as overlay] [datascript.core :as d])) (def rules - "The shared rule set. Edge kinds that the Ladybug projection - materialized as relationship tables are rules here: they derive from - indexed attributes at query time, so they can never drift from the - attributes they restate. + "The relation vocabulary, plus the helper fragments the standing set + composes (`anc-or-self`, `uses-color`, `on-page`). - The predicates the rules restate live in `app.common.types.component` - and stay authoritative: `instance-head?` is `(some? (:component-id - shape))`, which is exactly the `[?s :shape/component-id _]` clause; - `is-instance-of` requires `component-file` as the head marker just as - `ctk/instance-of?` does; `fills-swap-slot` reads the swap slot that - `ctk/get-swap-slot` extracted at build time." - '[;; ancestors, self included: cfh/get-parents-with-self as a rule - [(anc-or-self ?s ?a) - [(identity ?s) ?a]] - [(anc-or-self ?s ?a) - [?s :shape/parent ?p] - (anc-or-self ?p ?a)] + `descendant-of` is implemented over the global Euler-tour intervals the + builder assigns: two comparisons instead of a recursive walk (14.89 ms + against 93.98 ms on an 808-child frame). `descendant-of-walk` keeps the + recursive form: it is the invariant check for the numbering and the + slow side of that measurement, never a consumer surface. - ;; strict descendants: cfh/get-children-ids as a rule - [(desc ?a ?d) - [?d :shape/parent ?a]] - [(desc ?a ?d) - [?x :shape/parent ?a] - (desc ?x ?d)] + `uses-token` hides the folded token encoding: an attribute-variable + clause over the closed vocabulary of `app.common.types.token/all-keys`, + joined to the token entity by name, so the encoding stays reversible + behind the rule." + (into + '[;; containment, one edge + [(child-of ?c ?p) + [?c :shape/parent ?p]] - ;; IsInstanceOf: ctk/instance-of? against a live component record - [(is-instance-of ?s ?c) - [?s :shape/type :frame] - [?s :shape/component-id ?cid] - [?s :shape/component-file _] - [?c :component/id ?cid] - (not [?c :component/deleted true])] + ;; containment, transitive: the Euler-tour interval form + [(descendant-of ?d ?a) + [?a :shape/enter ?e0] + [?a :shape/exit ?e1] + [?d :shape/enter ?de] + [(< ?e0 ?de)] + [(< ?de ?e1)]] - ;; RefersTo: is-main-of? read backwards — the instance shape points - ;; at its homologue by :shape-ref, joined on the target's id - [(refers-to ?s ?t) - [?s :shape/shape-ref ?r] - [?t :shape/id ?r]] + ;; containment, transitive: the recursive form, kept as the + ;; numbering's invariant check and the measured slow side + [(descendant-of-walk ?d ?a) + (child-of ?d ?a)] + [(descendant-of-walk ?d ?a) + (child-of ?d ?x) + (descendant-of-walk ?x ?a)] - ;; FillsSwapSlot: the swapped-in shape names the replaced slot - [(fills-swap-slot ?s ?t) - [?s :shape/swap-slot ?slot] - [?t :shape/id ?slot] - [?s :shape/id ?sid] - [(not= ?sid ?slot)]] + ;; ancestors, self included: cfh/get-parents-with-self as a rule + [(anc-or-self ?s ?a) + [(identity ?s) ?a]] + [(anc-or-self ?s ?a) + [?s :shape/parent ?p] + (anc-or-self ?p ?a)] - ;; UsesColor: the per-source attributes reunited - [(uses-color ?s ?col) - [?s :shape/fill-color ?col]] - [(uses-color ?s ?col) - [?s :shape/stroke-color ?col]] - [(uses-color ?s ?col) - [?s :shape/text-color ?col]] + ;; IsInstanceOf: ctk/instance-of? against a live component record + [(instance-of ?s ?c) + [?s :shape/type :frame] + [?s :shape/component-id ?cid] + [?s :shape/component-file _] + [?c :component/id ?cid] + (not [?c :component/deleted true])] - ;; UsesToken: the relation entity flattened to an edge - [(uses-token ?s ?t) - [?u :token-use/shape ?s] - [?u :token-use/token ?t]] + ;; RefersTo: the reference ctf/find-ref-shape resolved at build time + [(refers-to ?s ?t) + [?s :shape/refers-to ?t]] - ;; scope helper: shapes living on a page (component containers hold - ;; bookkeeping copies, ctf/load-component-objects) - [(on-page ?s) - [?s :shape/container ?c] - [?c :container/kind :page]]]) + ;; FillsSwapSlot: the swapped-in shape names the replaced slot + [(fills-swap-slot ?s ?t) + [?s :shape/swap-slot ?slot] + [?t :shape/id ?slot] + [?s :shape/id ?sid] + [(not= ?sid ?slot)]] + + ;; UsesColor: the per-source attributes reunited + [(uses-color ?s ?col) + [?s :shape/fill-color ?col]] + [(uses-color ?s ?col) + [?s :shape/stroke-color ?col]] + [(uses-color ?s ?col) + [?s :shape/text-color ?col]] + + ;; scope helper: shapes living on a page (component containers hold + ;; bookkeeping copies, ctf/load-component-objects) + [(on-page ?s) + [?s :shape/container ?c] + [?c :container/kind :page]]] + + ;; UsesToken over the folded encoding; the closed vocabulary is + ;; embedded as data so the rule stays engine-portable + [(vector '(uses-token ?s ?tok) + '[?s ?a ?n] + [(list 'contains? overlay/token-attrs '?a)] + '[?tok :token/name ?n])])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; entity resolution @@ -115,7 +147,7 @@ (mapv :e (d/datoms db :avet :shape/id shape-id))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; the standing question set +;; the standing question set — every relation traversal via the rules ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn- entity-depth @@ -152,20 +184,21 @@ [page-id shape-id] pairs. The document-side equivalent is a full scan of every page's `:objects` - filtered by `ctk/instance-of?`; the overlay answers it from two AVET - lookups. Scoped to page containers because component records hold their - own copies of shapes." + filtered by `ctk/instance-of?`; the overlay answers it from the + `instance-of` rule plus one attribute constraint. Scoped to page + containers because component records hold their own copies of shapes." [db component-id file-id] (d/q '[:find ?pid ?id - :in $ ?cid ?fid + :in $ % ?cid ?fid :where - [?e :shape/component-id ?cid] + [?comp :component/id ?cid] + (instance-of ?e ?comp) [?e :shape/component-file ?fid] + (on-page ?e) [?e :shape/container ?c] - [?c :container/kind :page] [?c :container/id ?pid] [?e :shape/id ?id]] - db component-id file-id)) + db rules component-id file-id)) (defn descendant-ids "Descendant shape ids of (container, shape), self excluded: the overlay @@ -178,7 +211,21 @@ [?c :container/id ?cid] [?s :shape/container ?c] [?s :shape/id ?sid] - (desc ?s ?d) + (descendant-of ?d ?s) + [?d :shape/id ?id]] + db rules container-id shape-id))) + +(defn descendant-ids-walk + "The recursive-rule form of `descendant-ids`: the numbering invariant's + slow side, kept for the A/B measurement, never a consumer surface." + [db container-id shape-id] + (set (d/q '[:find [?id ...] + :in $ % ?cid ?sid + :where + [?c :container/id ?cid] + [?s :shape/container ?c] + [?s :shape/id ?sid] + (descendant-of-walk ?d ?s) [?d :shape/id ?id]] db rules container-id shape-id))) @@ -193,7 +240,7 @@ [?c :container/id ?cid] [?s :shape/container ?c] [?s :shape/id ?sid] - (desc ?s ?d) + (descendant-of ?d ?s) [?d :shape/type ?type] [?d :shape/id ?id]] db rules container-id shape-id type))) @@ -216,13 +263,28 @@ (`ctk/instance-head?` over the whole document)." [db] (d/q '[:find ?pid ?id + :in $ % :where [?s :shape/component-id _] + (on-page ?s) [?s :shape/container ?c] - [?c :container/kind :page] [?c :container/id ?pid] [?s :shape/id ?id]] - db)) + db rules)) + +(defn refers-to-pairs + "Resolved reference pairs [[src-container src-id tgt-container tgt-id]] + from the `refers-to` rule (builder-resolved `ctf/find-ref-shape`)." + [db] + (d/q '[:find ?scid ?sid ?tcid ?tid + :in $ % + :where + (refers-to ?s ?t) + [?s :shape/container ?sc] [?sc :container/id ?scid] + [?s :shape/id ?sid] + [?t :shape/container ?tc] [?tc :container/id ?tcid] + [?t :shape/id ?tid]] + db rules)) (defn shapes-using-color "Shapes referencing library color `color-id`, as [container-id shape-id] @@ -252,22 +314,37 @@ [?s :shape/id ?id]] db typography-id)) +(defn- applied-props + "The applied-token properties under which `eid` carries `token-name`, + recovered from the folded attributes of the entity." + [db eid token-name] + (let [e (d/entity db eid)] + (into [] + (keep (fn [attr] + (when (= token-name (get e attr)) + (overlay/token-attr->prop attr)))) + overlay/token-attrs))) + (defn shapes-using-token "Applied-token uses of the token named `token-name`, as [container-id shape-id property] triples (the LinkAppliedTokens - question)." + question). The relation comes from the `uses-token` rule; the property + is recovered from the folded attributes per matched shape." [db token-name] - (d/q '[:find ?cid ?id ?prop - :in $ ?name - :where - [?t :token/name ?name] - [?u :token-use/token ?t] - [?u :token-use/prop ?prop] - [?u :token-use/shape ?s] - [?s :shape/container ?c] - [?c :container/id ?cid] - [?s :shape/id ?id]] - db token-name)) + (let [pairs (d/q '[:find ?cid ?id ?s + :in $ % ?name + :where + [?tok :token/name ?name] + (uses-token ?s ?tok) + [?s :shape/container ?c] + [?c :container/id ?cid] + [?s :shape/id ?id]] + db rules token-name)] + (into #{} + (mapcat (fn [[cid id eid]] + (map (fn [prop] [cid id prop]) + (applied-props db eid token-name)))) + pairs))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; inventory and parity @@ -277,6 +354,11 @@ [db attr] (count (d/datoms db :avet attr))) +(defn token-application-count + "Datoms across the folded token attributes." + [db] + (transduce (map #(count (d/datoms db :aevt %))) + 0 overlay/token-attrs)) + (defn stats "Entity and edge inventory of the overlay." [db] @@ -289,7 +371,9 @@ :typographies (attr-count db :typography/id) :token-sets (attr-count db :token-set/id) :tokens (attr-count db :token/id) - :token-uses (attr-count db :token-use/shape)}) + :token-uses (token-application-count db) + :refs-resolved (attr-count db :shape/refers-to) + :refs-carried (attr-count db :shape/shape-ref)}) (defn edge-counts "Count of every edge kind under the overlay's own conventions (all @@ -299,17 +383,16 @@ {:is-child-of (+ (attr-count db :shape/parent) (attr-count db :container/document) (attr-count db :component/document)) - :is-instance-of (count (d/q '[:find ?s ?c :in $ % :where (is-instance-of ?s ?c)] - db rules)) - :refers-to (count (d/q '[:find ?s ?t :in $ % :where (refers-to ?s ?t)] + :is-instance-of (count (d/q '[:find ?s ?c :in $ % :where (instance-of ?s ?c)] db rules)) + :refers-to (attr-count db :shape/refers-to) :fills-swap-slot (count (d/q '[:find ?s ?t :in $ % :where (fills-swap-slot ?s ?t)] db rules)) :uses-color (+ (attr-count db :shape/fill-color) (attr-count db :shape/stroke-color) (attr-count db :shape/text-color)) :uses-typography (attr-count db :shape/uses-typography) - :uses-token (attr-count db :token-use/shape)}) + :uses-token (token-application-count db)}) (defn ladybug-parity-counts "Edge counts under the Ladybug projection's own conventions, for the @@ -317,19 +400,20 @@ an overlay extension), root frames excluded (the projection skips them), live components only. - A count that disagrees with the projection's relation table is a - finding to explain in writing, never to average away: the two likely - causes are a porting bug here and a projection limitation there, and - they demand opposite responses." + `refers-to` diverges by construction since the builder-resolution + retrofit: the projection's RefersTo is an id join over page shapes, + the overlay's is `ctf/find-ref-shape`'s answer, and the two differ + exactly where the id join is ambiguous or the helper's fallbacks + apply. The difference is a semantics upgrade, recorded rather than + reconciled." [db] (let [zero uuid/zero page-shapes (d/q '[:find [?s ...] - :in $ ?zero + :in $ % ?zero :where - [?s :shape/container ?c] - [?c :container/kind :page] + (on-page ?s) (not [?s :shape/id ?zero])] - db zero) + db rules zero) pages (count (d/q '[:find [?c ...] :where [?c :container/kind :page]] db)) @@ -343,7 +427,7 @@ :in $ % :where (on-page ?s) - (is-instance-of ?s ?c)] + (instance-of ?s ?c)] db rules)) :refers-to (count (d/q '[:find ?s ?t :in $ % diff --git a/backend/src/app/graph/overlay/sync.clj b/backend/src/app/graph/overlay/sync.clj index 7756e008e4..9088734805 100644 --- a/backend/src/app/graph/overlay/sync.clj +++ b/backend/src/app/graph/overlay/sync.clj @@ -14,6 +14,21 @@ the overlay does not index (geometry, style payloads), the mirror is a no-op by design. + Two derived layers ride every structural change: + + - **Euler intervals.** A structural change renumbers its container from + beyond the current global maximum, from overlay topology alone. The + numbers differ from a rebuild's (different DFS order, different + range); interval containment is the invariant, and the suite pins + containment, never the numbers. + - **Resolved references.** `:shape/refers-to` is the builder's + `ctf/find-ref-shape` answer, so the sync path re-resolves it for + every shape whose resolution inputs changed: the shape itself on + `:shape-ref`, the subtree on head-attribute changes and reparents, + and every instance subtree of a component whose record or own copy + changed. The resolution walks the same head chain the helper walks, + over the index instead of the document. + Everything here is pure: db value in, db value out. The session layer owns the atom and the revision bookkeeping." (:require @@ -43,34 +58,21 @@ (some-> (first (d/datoms db :avet :document/id)) :e)) (defn- sync-asset-ctx - "The `asset-ctx` of `app.graph.overlay`, resolved against the live db: - values are eids rather than tempids." + "The asset half of `app.graph.overlay`'s build-ctx, resolved against the + live db: values are eids rather than tempids." [db] {:colors (into {} (map (fn [dtm] [(:v dtm) (:e dtm)])) (d/datoms db :avet :color/id)) :typographies (into {} (map (fn [dtm] [(:v dtm) (:e dtm)])) - (d/datoms db :avet :typography/id)) - :tokens-by-name (reduce (fn [acc dtm] - (update acc (:v dtm) (fnil conj []) (:e dtm))) - {} - (d/datoms db :avet :token/name))}) + (d/datoms db :avet :typography/id))}) (defn- change-container-id [{:keys [page-id component-id]}] (or page-id component-id)) -(defn- token-use-eids - [db shape-eid] - (mapv :e (d/datoms db :avet :token-use/shape shape-eid))) - (defn- retract-shape-tx - "Retract one shape entity plus its applied-token relation entities - (`:db.fn/retractEntity` clears datoms pointing at the shape, but the - relation entity itself would survive as garbage)." - [db eid] - (into [[:db.fn/retractEntity eid]] - (map (fn [tu] [:db.fn/retractEntity tu])) - (token-use-eids db eid))) + [_db eid] + [[:db.fn/retractEntity eid]]) (defn- child-eids [db eid] @@ -96,6 +98,131 @@ (mapcat #(retract-shape-tx db %)) (container-shape-eids db container-eid))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Euler renumbering +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defn- next-euler-counter + [db] + (transduce (map (comp long :v)) (completing (fn [acc v] (max acc (inc v)))) 0 + (d/datoms db :avet :shape/exit))) + +(defn- renumber-container-tx + "Fresh Euler intervals for every shape of `ceid`, drawn from beyond the + current global maximum so ranges stay disjoint file-wide. Rebuilt from + overlay topology alone: the DFS order differs from the builder's, + interval containment is the invariant." + [db ceid] + (let [eids (container-shape-eids db ceid) + by-parent (group-by (fn [e] (:db/id (:shape/parent (d/entity db e)))) eids) + roots (vec (sort (get by-parent ceid []))) + base (next-euler-counter db)] + (loop [events (into [] (map (fn [e] [:enter e])) (rseq roots)) + counter (long base) + seen (transient #{}) + tx (transient [])] + (if-let [[kind eid] (peek events)] + (let [events (pop events)] + (case kind + :enter + (recur (-> events + (conj [:exit eid]) + (into (map (fn [c] [:enter c])) + (sort (get by-parent eid [])))) + (inc counter) + (conj! seen eid) + (conj! tx [:db/add eid :shape/enter counter])) + :exit + (recur events + (inc counter) + seen + (conj! tx [:db/add eid :shape/exit counter])))) + (let [seen (persistent! seen) + tx (persistent! tx)] + ;; degenerate intervals for shapes outside the reachable tree + (first + (reduce (fn [[tx c] eid] + (if (contains? seen eid) + [tx c] + [(conj tx + [:db/add eid :shape/enter c] + [:db/add eid :shape/exit (inc c)]) + (+ c 2)])) + [tx (+ base (* 2 (count seen)))] + eids))))))) + +(defn- with-renumber + [db ceid] + (d/db-with db (renumber-container-tx db ceid))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; reference re-resolution +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defn- parent-heads-of + "The instance heads on the parent chain of `eid`, self included, + top-down: `ctn/get-parent-heads` over the index." + [db eid] + (loop [cur (d/entity db eid) acc ()] + (if (and cur (:shape/id cur)) + (recur (:shape/parent cur) + (cond-> acc (:shape/component-id cur) (conj cur))) + (vec acc)))) + +(defn- resolve-ref-eid + "The sync-path mirror of `ctf/find-ref-shape`: try each parent head + top-down; through the head's component record (deleted included) find + the container that holds the component's shapes — the component's own + copy when it carries one, the main-instance page otherwise — and look + the `:shape/shape-ref` id up there." + [db eid] + (let [ref-id (:shape/shape-ref (d/entity db eid))] + (when ref-id + (some (fn [head] + (when-let [comp (d/entity db [:component/id (:shape/component-id head)])] + (let [ceid (if (:container/id comp) + (:db/id comp) + (some->> (:component/main-instance-page comp) + (queries/container-eid db)))] + (when ceid + (queries/shape-eid db ceid ref-id))))) + (parent-heads-of db eid))))) + +(defn- reresolve-refs-tx + [db eids] + (into [] + (keep (fn [eid] + (let [current (:db/id (:shape/refers-to (d/entity db eid))) + fresh (resolve-ref-eid db eid)] + (cond + (= current fresh) nil + (nil? fresh) [:db.fn/retractAttribute eid :shape/refers-to] + :else [:db/add eid :shape/refers-to fresh])))) + eids)) + +(defn- with-reresolved + [db eids] + (let [tx (reresolve-refs-tx db eids)] + (cond-> db (seq tx) (d/db-with tx)))) + +(defn- component-affected-eids + "Every shape whose reference resolution reads component `cid`: the + subtrees of its instance heads, plus its own container copies." + [db cid] + (let [heads (mapv :e (d/datoms db :avet :shape/component-id cid)) + own (when-let [comp (d/entity db [:component/id cid])] + (when (:container/id comp) + (container-shape-eids db (:db/id comp))))] + (-> [] + (into (mapcat #(subtree-eids db %)) heads) + (into own) + distinct + vec))) + +(defn- with-component-reresolved + [db cid] + (with-reresolved db (component-affected-eids db cid))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; per-change application ;; @@ -134,11 +261,13 @@ :shape/container ceid :shape/parent peid} (overlay/shape-attrs shape) - (overlay/shape-asset-attrs shape ctx))) - (into (overlay/token-use-entities - tempid (:applied-tokens shape) - (:tokens-by-name ctx))))] - (ok (d/db-with db tx)))))) + (overlay/shape-asset-attrs shape ctx)))) + db' (d/db-with db tx) + new-eid (queries/shape-eid db' ceid id)] + (-> db' + (with-reresolved (if new-eid [new-eid] [])) + (with-renumber ceid) + (ok)))))) (def ^:private plain-attr->overlay {:name :shape/name @@ -146,6 +275,11 @@ :component-file :shape/component-file :shape-ref :shape/shape-ref}) +(def ^:private head-attrs + "Shape attributes whose change moves reference resolution for the whole + subtree below the shape." + #{:component-id :component-file}) + (defn- replace-attr-tx [eid attr val] (if (some? val) @@ -168,6 +302,16 @@ (ctk/get-swap-slot {:touched touched}))] (replace-attr-tx eid :shape/swap-slot slot))) +(defn- applied-tokens-tx + "Replace the folded token attributes from a fresh `:applied-tokens` + value: retract the closed vocabulary, assert the new applications." + [eid applied] + (into (mapv (fn [a] [:db.fn/retractAttribute eid a]) overlay/token-attrs) + (keep (fn [[k v]] + (when-let [attr (overlay/token-attr k)] + [:db/add eid attr v]))) + (or applied {}))) + (defn- set-op-tx "Transaction data for one `:set` / `:set-touched` operation on `eid`. Attributes the overlay does not index yield nil (a designed no-op), @@ -202,8 +346,7 @@ (overlay/content-typography-ref-ids val)))) (= :applied-tokens attr) - (into (mapv (fn [tu] [:db.fn/retractEntity tu]) (token-use-eids db eid)) - (overlay/token-use-entities eid val (:tokens-by-name ctx))) + (applied-tokens-tx eid val) :else nil)) @@ -214,8 +357,14 @@ (if-not eid (skip db :missing-shape) (let [ctx (sync-asset-ctx db) - tx (into [] (mapcat #(set-op-tx db eid ctx %)) operations)] - (ok (cond-> db (seq tx) (d/db-with tx))))))) + 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) + affected (cond + (some head-attrs set-attrs) (subtree-eids db' eid) + (contains? set-attrs :shape-ref) [eid] + :else nil)] + (ok (cond-> db' (seq affected) (with-reresolved affected))))))) (defn- apply-del-obj [db {:keys [id] :as change}] @@ -232,19 +381,21 @@ (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 whole change is one - `:shape/parent` re-point per moved shape." + 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}] (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 [tx (into [] - (keep (fn [sid] - (when-let [eid (queries/shape-eid db ceid sid)] - [:db/add eid :shape/parent peid]))) - shapes)] - (ok (cond-> db (seq tx) (d/db-with tx))))))) + (let [moved (into [] + (keep (fn [sid] (queries/shape-eid db ceid sid))) + shapes) + tx (mapv (fn [eid] [:db/add eid :shape/parent peid]) moved) + db' (cond-> db (seq tx) (d/db-with tx)) + db' (with-renumber db' ceid)] + (ok (with-reresolved db' (into [] (mapcat #(subtree-eids db' %)) moved))))))) (defn- apply-add-page "Mirror of `process-change :add-page`: id+name means a fresh empty page @@ -256,7 +407,7 @@ page-id (:id page)] (if (queries/container-eid db page-id) (ok db) - (let [ctx (sync-asset-ctx db) + (let [ctx (assoc (sync-asset-ctx db) :numbering {} :resolve-ref nil) tid (overlay/container-tempid page-id) tx (into [(cond-> {:db/id tid :container/id page-id @@ -264,8 +415,11 @@ :container/document (doc-eid db)} (some? (:name page)) (assoc :container/name (:name page)))] - (overlay/container-entities tid page-id (:objects page) ctx))] - (ok (d/db-with db tx)))))) + (overlay/container-entities tid page-id (:objects page) ctx)) + db' (d/db-with db tx) + ceid (queries/container-eid db' page-id) + db' (with-renumber db' ceid)] + (ok (with-reresolved db' (container-shape-eids db' ceid))))))) (defn- apply-del-page [db {:keys [id]}] @@ -296,7 +450,7 @@ (ok db) (let [tx (into [{:db/id -1 :component/id id :component/document (doc-eid db)}] (component-attrs-tx -1 change))] - (ok (d/db-with db tx))))) + (ok (with-component-reresolved (d/db-with db tx) id))))) (defn- clear-component-container-tx "Drop a component's own shape copies and its container role, keeping the @@ -311,7 +465,7 @@ (defn- component-container-tx "Give the component entity a container role over `objects`." [db eid component-id objects] - (let [ctx (sync-asset-ctx db)] + (let [ctx (assoc (sync-asset-ctx db) :numbering {} :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)]] @@ -324,19 +478,27 @@ only when the change carries objects." [db {:keys [id objects] :as change}] (if-let [eid (d/entid db [:component/id id])] - (let [tx (-> (component-attrs-tx eid change) - (into (clear-component-container-tx db eid)) - (cond-> (some? objects) - (into (component-container-tx db eid id objects))))] - (ok (cond-> db (seq tx) (d/db-with tx)))) + (let [tx (-> (component-attrs-tx eid change) + (into (clear-component-container-tx db eid)) + (cond-> (some? objects) + (into (component-container-tx db eid id objects)))) + db' (cond-> db (seq tx) (d/db-with tx)) + db' (cond-> db' (some? objects) (with-renumber eid))] + (ok (with-component-reresolved db' id))) (skip db :missing-component))) (defn- entity-shape-attrs "The indexed attrs of a live shape entity, as assertable values (asset - references flattened to eids)." + references flattened to eids; Euler intervals excluded, the copy is + renumbered; the resolved reference excluded, the copy is re-resolved)." [ent] (let [many-ids #(into [] (map :db/id) %)] - (cond-> {:shape/type (:shape/type ent)} + (cond-> (reduce (fn [acc attr] + (if-some [v (get ent attr)] + (assoc acc attr v) + acc)) + {:shape/type (:shape/type ent)} + overlay/token-attrs) (some? (:shape/name ent)) (assoc :shape/name (:shape/name ent)) (some? (:shape/component-id ent)) (assoc :shape/component-id (:shape/component-id ent)) (some? (:shape/component-file ent)) (assoc :shape/component-file (:shape/component-file ent)) @@ -351,9 +513,9 @@ "Mirror of `ctf/load-component-objects`: copy the main-instance subtree from its page into the component's own container, same ids, new (container, shape) entities. The copy is taken from the overlay itself, - which is exactly the identity/type/topology slice the rebuild would - project from the document's copy. Geometry (`delta`) is not indexed, so - the move that accompanies an undo of cut-paste is a designed no-op." + which is exactly the indexed slice the rebuild would project from the + document's copy. Geometry (`delta`) is not indexed, so the move that + accompanies an undo of cut-paste is a designed no-op." [db comp-eid] (let [ent (d/entity db comp-eid) comp-id (:component/id ent) @@ -369,55 +531,55 @@ (into [[:db/add comp-eid :container/id comp-id] [:db/add comp-eid :container/kind :component] [:db/add comp-eid :container/document (doc-eid db)]] - (mapcat (fn [eid] - (let [src (d/entity db eid) - tempid (copy-tempid eid) - parent (:db/id (:shape/parent src)) - copy (merge {:db/id tempid - :shape/id (:shape/id src) - :shape/container comp-eid - :shape/parent (if (contains? eidset parent) - (copy-tempid parent) - comp-eid)} - (entity-shape-attrs src)) - uses (for [tu (token-use-eids db eid)] - (let [tue (d/entity db tu)] - {:token-use/shape tempid - :token-use/token (:db/id (:token-use/token tue)) - :token-use/prop (:token-use/prop tue)}))] - (cons copy uses)))) + (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))))) eids))))) (defn- apply-del-component "Mirror of `ctf/delete-component`: with `skip-undelete?` the component goes entirely; otherwise it is marked deleted and keeps its own copy of - the main-instance subtree." + the main-instance subtree. Either way the resolution targets of every + instance of this component move, so the affected references re-resolve." [db {:keys [id skip-undelete?]}] (if-let [eid (d/entid db [:component/id id])] (if skip-undelete? - (ok (d/db-with db (conj (retract-container-shapes-tx db eid) - [:db.fn/retractEntity eid]))) - (ok (d/db-with db (into [[:db/add eid :component/deleted true]] - (snapshot-component-tx db eid))))) + (let [db' (d/db-with db (conj (retract-container-shapes-tx db eid) + [:db.fn/retractEntity eid]))] + (ok (with-component-reresolved db' id))) + (let [snapshot (snapshot-component-tx db eid) + db' (d/db-with db (into [[:db/add eid :component/deleted true]] + snapshot)) + db' (cond-> db' (seq snapshot) (with-renumber eid))] + (ok (with-component-reresolved db' id)))) (ok db))) (defn- apply-restore-component "Mirror of `ctf/restore-component`: undelete, drop the component's own - copy, optionally repoint the main-instance page." + copy, optionally repoint the main-instance page; the resolution targets + move back to the page, so the affected references re-resolve." [db {:keys [id page-id]}] (if-let [eid (d/entid db [:component/id id])] - (let [tx (cond-> (into [[:db.fn/retractAttribute eid :component/deleted]] - (clear-component-container-tx db eid)) - (some? page-id) - (conj [:db/add eid :component/main-instance-page page-id]))] - (ok (d/db-with db tx))) + (let [tx (cond-> (into [[:db.fn/retractAttribute eid :component/deleted]] + (clear-component-container-tx db eid)) + (some? page-id) + (conj [:db/add eid :component/main-instance-page page-id]))] + (ok (with-component-reresolved (d/db-with db tx) id))) (skip db :missing-component))) (defn- apply-purge-component [db {:keys [id]}] (if-let [eid (d/entid db [:component/id id])] - (ok (d/db-with db (conj (retract-container-shapes-tx db eid) - [:db.fn/retractEntity eid]))) + (let [db' (d/db-with db (conj (retract-container-shapes-tx db eid) + [:db.fn/retractEntity eid]))] + (ok (with-component-reresolved db' id))) (ok db))) (defn- apply-change diff --git a/backend/test/backend_tests/graph_overlay_console_test.clj b/backend/test/backend_tests/graph_overlay_console_test.clj index f0203e1fb1..bf10b4eac5 100644 --- a/backend/test/backend_tests/graph_overlay_console_test.clj +++ b/backend/test/backend_tests/graph_overlay_console_test.clj @@ -78,9 +78,39 @@ #(console/run-query (fixture-db) "[:find ?v :where"))] (t/is (= :graph-query-invalid (:code data))))) +(t/deftest shared-rule-invocations-pass-the-gate + ;; The gate's allowlist derives from `queries/rules` + ;; (`app.graph.overlay.console/check-query!`), so rule renames pass + ;; automatically: the default query proves `instance-of`, and these + ;; hold the door open for `descendant-of` (with rows) and `uses-token` + ;; (the fixture defines no tokens, so the gate acceptance is the + ;; point). + (let [db (fixture-db)] + (let [{:keys [rows]} (console/run-query + db + "[:find ?n :in $ % :where [?p :shape/name \"Main\"] (descendant-of ?d ?p) [?d :shape/name ?n]]")] + (t/is (= #{"Child A" "Child B"} (set (map first rows))))) + (let [{:keys [rows]} (console/run-query + db + "[:find ?name :in $ % :where (uses-token ?s ?tok) [?tok :token/name ?name]]")] + (t/is (empty? rows))))) + +(t/deftest the-old-rule-name-is-rejected + ;; The vocabulary is closed: `is-instance-of` is gone, renamed + ;; `instance-of`, and the old name must not pass the gate — the + ;; allowlist derives from the rule set, not from a hardcoded list. + (let [data (thrown-data + #(console/run-query + (fixture-db) + "[:find ?s :in $ % :where (is-instance-of ?s ?c)]"))] + (t/is (= :graph-query-not-read-only (:code data))) + (t/is (str/includes? (:hint data) "is-instance-of") + "the error must name the old rule"))) + (t/deftest the-default-query-runs-through-the-console - ;; The shipped default invokes the shared `is-instance-of` rule with - ;; `%`; a rule invocation must pass the gate and return rows. + ;; The shipped default invokes the shared `instance-of` rule (renamed + ;; from `is-instance-of` by the retrofit) with `%`; a rule invocation + ;; must pass the gate and return rows. (let [{:keys [columns rows truncated? row-count]} (console/run-query (fixture-db) debug/default-query)] (t/is (= ["component" "instance" "page" "filter_src_id" "filter_tgt_id"] diff --git a/backend/test/backend_tests/graph_overlay_sync_test.clj b/backend/test/backend_tests/graph_overlay_sync_test.clj index c71d50eaff..1537706566 100644 --- a/backend/test/backend_tests/graph_overlay_sync_test.clj +++ b/backend/test/backend_tests/graph_overlay_sync_test.clj @@ -29,6 +29,7 @@ [app.common.types.tokens-lib :as ctob] [app.common.uuid :as uuid] [app.graph.overlay :as overlay] + [app.graph.overlay.queries :as queries] [app.graph.overlay.sync :as sync] [clojure.set :as set] [clojure.test :as t] @@ -97,8 +98,10 @@ 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 - swap slot on a shape inside a copy (`ctk/get-swap-slot`), and the whole - component lifecycle from add to purge." + 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." [{: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})} @@ -141,7 +144,7 @@ :val [(assoc (ths/sample-fill-color :fill-color "#ABCDEF" :fill-opacity 1) :fill-color-ref-id color-id)]}]} - ;; an applied token: one token-use entity (shape, property, token) + ;; an applied token: one folded application (shape, property, name) {:type :mod-obj :page-id page-id :id rect2-id :operations [{:type :set :attr :applied-tokens :val {:fill "brand.primary"} @@ -197,13 +200,17 @@ {:type :set :attr :main-instance :val false}]} ;; a copy of the component on the same page: `shape-ref` marks the - ;; homologue, which is what makes `ctk/in-component-copy?` true + ;; homologue, which is what makes `ctk/in-component-copy?` true. The + ;; copy root carries `:component-file` like `ctn/make-component-instance` + ;; sets it (the local library id), which is what lets + ;; `ctf/find-ref-shape` resolve it at build time. {:type :add-obj :page-id page-id :id copy-root-id :parent-id uuid/zero :frame-id uuid/zero :obj (shape copy-root-id :frame {:name "Copy" :parent-id uuid/zero :frame-id uuid/zero :width 200 :height 200 :shape-ref comp-root-id :component-id comp-id + :component-file file-id :component-root true})} {:type :add-obj :page-id page-id :id copy-child-id @@ -213,6 +220,12 @@ :shape-ref comp-child-id :component-id comp-id})} + ;; repoint a copy child at a different main shape: the resolved + ;; reference must follow on both paths (`:shape/refers-to` re-resolves + ;; through `ctf/find-ref-shape`'s sync mirror) + {:type :mod-obj :page-id page-id :id copy-child-id + :operations [{:type :set :attr :shape-ref :val comp-root-id}]} + ;; 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 @@ -245,8 +258,9 @@ (defn- entity-key "The document key of one entity: `[:document id]`, `[:container id]`, `[:component id]`, `[:shape container-id shape-id]`, `[:color id]`, - `[:typography id]`, `[:token-set id]`, `[:token id]`, or - `[:token-use shape-key token-id prop]`." + `[:typography id]`, `[:token-set id]`, or `[:token id]`. Token-use + entities are gone: the folded encoding stores applied tokens as shape + attributes." [db eid] (let [ent (d/entity db eid)] (cond @@ -274,15 +288,7 @@ [:token-set (:token-set/id ent)] (some? (:token/id ent)) - [:token (:token/id ent)] - - (some? (:token-use/shape ent)) - (let [s (:token-use/shape ent) - t (:token-use/token ent)] - [:token-use - [:shape (:container/id (:shape/container s)) (:shape/id s)] - (:token/id t) - (:token-use/prop ent)])))) + [:token (:token/id ent)]))) (defn- ref-key [keymap ref] @@ -323,17 +329,25 @@ :container/document (ref-key keymap (:container/document ent))} (some? (:shape/id ent)) - {:shape/type (:shape/type ent) - :shape/name (:shape/name ent) - :shape/component-id (:shape/component-id ent) - :shape/component-file (:shape/component-file ent) - :shape/shape-ref (:shape/shape-ref ent) - :shape/swap-slot (:shape/swap-slot ent) - :shape/parent (ref-key keymap (:shape/parent 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))} + (merge {:shape/type (:shape/type ent) + :shape/name (:shape/name ent) + :shape/component-id (:shape/component-id ent) + :shape/component-file (:shape/component-file ent) + :shape/shape-ref (:shape/shape-ref ent) + :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)) + :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))} + ;; 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 + ;; renumber draw them from different DFS orders, so the values are + ;; not comparable — interval containment is the invariant, pinned by + ;; the-intervals-agree-after-the-full-replay (presence is checked + ;; there) (some? (:color/id ent)) {:color/id (:color/id ent) @@ -354,11 +368,7 @@ {:token/id (:token/id ent) :token/name (:token/name ent) :token/type (:token/type ent) - :token/set (ref-key keymap (:token/set ent))} - - ;; a token-use entity: shape, token and property all live in the key - :else {})) - + :token/set (ref-key keymap (:token/set ent))})) (defn- normal-form "The overlay as entity-id-independent data: a set of [entity-key attr-map] pairs." @@ -424,14 +434,19 @@ (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`); - ;; the overlay mirrors it as a component container, on both paths. + ;; the overlay mirrors it as a component container, on both paths. The + ;; copies' builder-resolved references must move with it: after + ;; normalisation the synced and rebuilt forms agree on + ;; `:shape/refers-to`, and both point at the snapshot copies. (let [first-del (first (keep-indexed (fn [i ch] (when (= :del-component (:type ch)) i)) changes)) prefix (subvec changes 0 (inc first-del)) data0 (base-data) result (sync/apply-changes (overlay/build data0) prefix) - rebuilt (overlay/build (cp/process-changes data0 prefix false))] + rebuilt (overlay/build (cp/process-changes data0 prefix false)) + synced-m (into {} (normal-form (:db result))) + rebuilt-m (into {} (normal-form rebuilt))] (doseq [form [(normal-form (:db result)) (normal-form rebuilt)]] (let [keys (into #{} (map first) form)] (t/is (contains? keys [:shape comp-id comp-root-id]) @@ -449,14 +464,25 @@ :container/id comp-id :container/kind :component :container/name nil - :container/document [:document file-id]}])))))) + :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) + (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] + (get-in synced-m [[:shape page-id copy-child-id] :shape/refers-to]))))) (t/deftest the-diff-catches-an-injected-sync-bug ;; The round trip is only worth running if it fails when sync is wrong. ;; Drop the reparenting :mov-objects from the list the overlay sees, ;; keep it in the list the document sees, and the moved shape's entity ;; key must appear in the difference: the check is locatable, not just - ;; boolean. + ;; boolean. Euler intervals are out of the normal form, so it is the + ;; parent ref (the moved shape's `:shape/parent` key) that names it. (let [data0 (base-data) data1 (cp/process-changes data0 changes false) crippled (remove #(and (= :mov-objects (:type %)) @@ -469,3 +495,48 @@ moved (into #{} (map first) diff)] (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-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 + ;; global maximum with a different DFS order than the builder + ;; (`app.graph.overlay.sync/renumber-container-tx`), so interval + ;; values are not comparable between the two paths — containment is. + ;; Here: every shape of every container carries an interval, the + ;; interval form answers the recursive walk exactly, and intervals are + ;; disjoint-or-nested file-wide (a partial overlap is the signature of + ;; a per-container counter). + (let [db (-> (base-data) (overlay/build) (sync/apply-changes changes) :db) + containers (d/q '[:find [?c ...] :where [?c :container/id _]] db)] + + ;; presence: every shape of every container carries a fresh interval + (doseq [seid (d/q '[:find [?s ...] :where [?s :shape/container _]] db)] + (let [e (d/entity db seid)] + (t/is (and (some? (:shape/enter e)) (some? (:shape/exit e))) + (str "shape " (pr-str (:shape/id e)) " lost its interval")))) + + ;; containment: the interval form answers the recursive walk, per + ;; container, per shape + (doseq [ceid containers + :let [cid (:container/id (d/entity db ceid))] + seid (d/q '[:find [?s ...] :in $ ?c + :where [?s :shape/container ?c]] + db ceid) + :let [sid (:shape/id (d/entity db seid))]] + (t/is (= (queries/descendant-ids db cid sid) + (queries/descendant-ids-walk db cid sid)) + (str "interval vs walk in container " cid " shape " sid))) + + ;; the global-counter claim across all containers + (let [enters (into {} (map (juxt :e :v)) (d/datoms db :avet :shape/enter)) + exits (into {} (map (juxt :e :v)) (d/datoms db :avet :shape/exit)) + intervals (mapv (fn [[eid enter]] [enter (get exits eid)]) enters) + ok? (fn [[e0 e1] [f0 f1]] + (or (<= e1 f0) (<= f1 e0) + (and (< e0 f0) (< f1 e1)) + (and (< f0 e0) (< e1 f1))))] + (doseq [i (range (count intervals)) + j (range (inc i) (count intervals))] + (t/is (ok? (nth intervals i) (nth intervals j)) + (str "intervals " (pr-str (nth intervals i)) " and " + (pr-str (nth intervals j)) " partially overlap")))))) diff --git a/backend/test/backend_tests/graph_overlay_test.clj b/backend/test/backend_tests/graph_overlay_test.clj index 52d333767a..146e64c0e3 100644 --- a/backend/test/backend_tests/graph_overlay_test.clj +++ b/backend/test/backend_tests/graph_overlay_test.clj @@ -30,6 +30,7 @@ [app.common.types.component :as ctk] [app.common.types.components-list :as ctkl] [app.common.types.container :as ctn] + [app.common.types.file :as ctf] [app.common.types.shape :as cts] [app.common.types.text :as txt] [app.common.types.tokens-lib :as ctob] @@ -37,6 +38,7 @@ [app.graph.overlay :as overlay] [app.graph.overlay.queries :as queries] [clojure.test :as t] + [datascript.built-ins :as bi] [datascript.core :as d])) (t/use-fixtures :each thi/test-fixture) @@ -84,17 +86,44 @@ (assoc :content (refs-content "Typography sample" typography-id color-id) :position-data nil))) +(defn- oracle-containers + "The builder's resolution containers, one per page plus one per + component that carries its own `:objects` snapshot, as [ctn-container + container-id] pairs (`app.graph.overlay/ref-resolver`)." + [data] + (concat (map (fn [[id page]] [(ctn/make-container page :page) id]) + (:pages-index data)) + (keep (fn [[cid component]] + (when (seq (:objects component)) + [(ctn/make-container component :component) cid])) + (:components data)))) + (defn- document-containers "Every [container-id objects] pair the overlay indexes: the pages, plus the `:objects` snapshot a deleted component carries (`app.common.types.file/load-component-objects`)." [data] - (concat (map (fn [page] [(:id page) (:objects page)]) - (vals (:pages-index data))) - (keep (fn [[cid component]] - (when (seq (:objects component)) - [cid (:objects component)])) - (:components data)))) + (map (fn [[container cid]] [cid (:objects container)]) + (oracle-containers data))) + +(defn- oracle-refs + "`ctf/find-ref-shape`'s answer for every copy shape, as + [src-container src-id tgt-container tgt-id]: the oracle behind the + builder-resolved `:shape/refers-to` (`:include-deleted? true`, + `:with-context? true`)." + [data] + (let [file {:id (:id data) :data data}] + (into #{} + (for [[container cid] (oracle-containers data) + shape (vals (:objects container)) + :when (:shape-ref shape) + :let [ref (ctf/find-ref-shape file container {} shape + :include-deleted? true + :with-context? true)] + :when (some? ref)] + [cid (:id shape) + (:id (:container (meta ref))) + (:id ref)])))) (defn- semantic-fixture "One rich file exercising every indexed attribute: @@ -267,16 +296,21 @@ ;; the inventory the rest of the suite leans on, pinned once: ;; 22 page shapes + 2 root frames + 2 snapshot shapes = 26 shape - ;; entities; 2 pages + the deleted component's snapshot = 3 containers - (t/is (= {:documents 1 - :containers 3 - :shapes 26 - :components 5 - :colors 3 - :typographies 2 - :token-sets 2 - :tokens 4 - :token-uses 4} + ;; entities; 2 pages + the deleted component's snapshot = 3 + ;; containers; 5 folded token applications (the 4 resolvable uses + ;; plus the ghost name, which the encoding stores); 6 copy shapes + ;; carrying a shape-ref, all 6 resolved by the builder + (t/is (= {:documents 1 + :containers 3 + :shapes 26 + :components 5 + :colors 3 + :typographies 2 + :token-sets 2 + :tokens 4 + :token-uses 5 + :refs-resolved 6 + :refs-carried 6} (dissoc (queries/stats db) :datoms))))) (t/deftest components-are-children-of-the-document @@ -292,47 +326,28 @@ (t/is (= (count (:components data)) (count attached))) (t/is (every? #(= doc-eid (second %)) attached)))) -(t/deftest refers-to-pairs-match-shape-refs +(t/deftest refers-to-pairs-match-find-ref-shape ;; beadpot:tests/graph/transform/test_components.py::test_refers_to_edges_match_shape_refs - ;; One RefersTo per resolvable shape-ref, each pointing at the referenced - ;; shape. Oracle: `ctk/is-main-of?` on the page objects. The rule itself - ;; is unscoped; the page scoping here mirrors the Ladybug projection, - ;; which materialises page shapes only. + ;; One RefersTo per copy shape the helper resolves, each pointing at the + ;; shape `ctf/find-ref-shape` names. Oracle: `ctf/find-ref-shape` with + ;; `:include-deleted? true` and `:with-context? true`, per copy shape, + ;; per container. The builder-resolution retrofit replaced the id-join + ;; encoding (`:shape/shape-ref` joined on `:shape/id`) with the helper's + ;; answer materialised at build time; the consumer texts (`queries/refers-to-pairs` + ;; and the `refers-to` rule) did not move. (let [{:keys [data db]} (semantic-fixture) - pages (vals (:pages-index data)) - pairs (d/q '[:find ?sid ?tid - :in $ % - :where - (on-page ?s) - (refers-to ?s ?t) - (on-page ?t) - [?s :shape/id ?sid] - [?t :shape/id ?tid]] - db queries/rules) - shapes (mapcat #(vals (:objects %)) pages) - refs (filter :shape-ref shapes) - on-page? (fn [id] (some #(contains? (:objects %) id) pages))] + pairs (set (queries/refers-to-pairs db))] - ;; every on-page shape with a resolvable :shape-ref has an outgoing pair - (t/is (= (set (map :id (filter #(on-page? (:shape-ref %)) refs))) - (set (map first pairs)))) - - ;; every pair is a main link in the oracle's reading, and the target id - ;; equals the source's :shape-ref - (doseq [[sid tid] pairs] - (let [objects (some (fn [p] (when (contains? (:objects p) sid) (:objects p))) - pages) - source (get objects sid) - target (get objects tid)] - (t/is (some? source)) - (t/is (ctk/is-main-of? target source)))) + ;; every pair is the helper's answer: target container and id from + ;; the context the helper attaches + (t/is (= (oracle-refs data) pairs)) ;; all six copy shapes on the fixture resolve (t/is (= 6 (count pairs))))) (t/deftest instance-heads-link-only-to-live-components ;; beadpot:tests/graph/transform/test_components.py::test_all_instance_heads_linked_to_their_component - ;; Oracle: `ctk/instance-of?`. The is-instance-of rule scoped to page + ;; Oracle: `ctk/instance-of?`. The `instance-of` rule scoped to page ;; shapes must equal a scan of the predicate over the live component ;; records. The deleted component contributes nothing, even though its ;; orphaned main root still passes the raw predicate. @@ -342,7 +357,7 @@ :in $ % :where (on-page ?s) - (is-instance-of ?s ?c) + (instance-of ?s ?c) [?c :component/id ?cid] [?s :shape/id ?sid]] db queries/rules)) @@ -360,7 +375,7 @@ (t/is (empty? (d/q '[:find [?sid ...] :in $ % ?cid :where - (is-instance-of ?s ?c) + (instance-of ?s ?c) [?c :component/id ?cid] [?s :shape/id ?sid]] db queries/rules deleted-id))) @@ -413,18 +428,27 @@ (t/deftest instances-of-matches-an-instance-of-scan ;; beadpot:tests/graph/transform/test_components.py::test_all_instance_heads_linked_to_their_component ;; (the exhaustive complement: the query against the scan) - ;; Oracle: `ctk/instance-of?` over every page's objects. The query is the - ;; raw index lookup: it does not check whether the component record is - ;; live, which is the is-instance-of rule's business, so the scan runs - ;; over every component record, deleted ones included. + ;; Oracle: `ctk/instance-of?` over every page's objects. The standing + ;; query traverses the `instance-of` rule, whose live-component guard + ;; is the rule's business, so the scan runs over the live component + ;; records only; the deleted component's orphaned main root is pinned + ;; below to answer nothing. (let [{:keys [data db]} (semantic-fixture)] - (doseq [component (vals (:components data))] + (doseq [component (ctkl/components-seq data)] (let [expected (set (for [[pid page] (:pages-index data) [sid shape] (:objects page) :when (ctk/instance-of? shape (:id data) (:id component))] [pid sid]))] (t/is (= expected (set (queries/instances-of db (:id component) (:id data)))) - (str "instances of " (:name component))))))) + (str "instances of " (:name component))))) + + ;; the deleted component: the rule's live guard answers nothing, + ;; while the raw predicate still sees the orphaned main root + (let [deleted-id (thi/id :comp-2)] + (t/is (empty? (queries/instances-of db deleted-id (:id data)))) + (let [main-root (get-in data [:pages-index (thi/id :main-page) + :objects (thi/id :comp-2-root)])] + (t/is (ctk/instance-of? main-root (:id data) deleted-id)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; descendants and identity @@ -438,7 +462,7 @@ ;; must resolve through `queries/shape-eid`. The overlay does NOT ;; denormalize component-id downward (beadpot and Ladybug do): the ;; [?a :shape/component-id _] datom must equal `ctk/instance-head?` - ;; exactly, or the is-instance-of rule stops answering `ctk/instance-of?`. + ;; exactly, or the `instance-of` rule stops answering `ctk/instance-of?`. ;; Oracle: `cfh/get-children-ids` and `ctk/instance-head?`. (let [{:keys [data db]} (semantic-fixture) page1-id (thi/id :main-page) @@ -487,6 +511,46 @@ (when (:component-id shape) (t/is (= (:component-id shape) (:shape/component-id entity)))))))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Euler-tour numbering +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(t/deftest euler-intervals-equal-the-walk-and-are-globally-disjoint-or-nested + ;; No beadpot counterpart. The Euler-tour retrofit's two invariants: + ;; (1) the interval form answers the recursive form, and both equal + ;; `cfh/get-children-ids` (the oracle) for every frame of every + ;; container; (2) one global counter numbers every container + ;; (`app.graph.overlay/euler-numbering` threads it file-wide), so + ;; [enter exit] intervals across the whole file are pairwise + ;; disjoint-or-nested — a partial overlap is the signature of the + ;; per-container-counter bug the 20260820 report guards against. + (let [{:keys [data db]} (semantic-fixture)] + (doseq [[cid objects] (document-containers data) + shape (vals objects) + :when (= :frame (:type shape))] + (let [sid (:id shape) + expected (set (cfh/get-children-ids objects sid))] + (t/is (= expected (queries/descendant-ids db cid sid)) + (str "interval descendants of " sid)) + (t/is (= expected (queries/descendant-ids-walk db cid sid)) + (str "walk descendants of " sid)))) + + ;; the global-counter claim: every [enter exit] pair across all + ;; containers is disjoint or properly nested, never partially + ;; overlapping + (let [enters (into {} (map (juxt :e :v)) (d/datoms db :avet :shape/enter)) + exits (into {} (map (juxt :e :v)) (d/datoms db :avet :shape/exit)) + intervals (mapv (fn [[eid enter]] [enter (get exits eid)]) enters) + ok? (fn [[e0 e1] [f0 f1]] + (or (<= e1 f0) (<= f1 e0) + (and (< e0 f0) (< f1 e1)) + (and (< f0 e0) (< e1 f1))))] + (doseq [i (range (count intervals)) + j (range (inc i) (count intervals))] + (t/is (ok? (nth intervals i) (nth intervals j)) + (str "intervals " (pr-str (nth intervals i)) " and " + (pr-str (nth intervals j)) " partially overlap")))))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; swap slots ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -573,9 +637,10 @@ ;; plus ::test_shared_token_has_multiple_incoming_edges and ;; ::test_same_token_two_attributes_yields_two_edges ;; Oracle: a scan of every container's :applied-tokens, restricted to - ;; names the lib defines; the overlay's token-use entities must equal it. - ;; beadpot's enum-key parsing test is a document-format concern that - ;; Clojure keywords make moot. + ;; names the lib defines. The consumer texts are unchanged; underneath, + ;; the token-use entities are gone and the `uses-token` rule reads the + ;; folded token attributes instead. beadpot's enum-key parsing test is a + ;; document-format concern that Clojure keywords make moot. (let [{:keys [data db]} (semantic-fixture) lib-names (into #{} (map :name) (ctob/get-all-tokens (:tokens-lib data))) expected (set (for [[cid objects] (document-containers data) @@ -586,7 +651,10 @@ actual (set (mapcat #(queries/shapes-using-token db %) lib-names))] (t/is (= expected actual)) - (t/is (= 4 (:token-uses (queries/stats db)))) + + ;; 5 folded applications on the fixture: the 4 resolvable uses the + ;; rule surfaces, plus the ghost name the encoding still stores + (t/is (= 5 (:token-uses (queries/stats db)))) ;; a token applied by two shapes has two uses (let [shared (queries/shapes-using-token db "color.fill")] @@ -599,8 +667,16 @@ (t/is (= 1 (count (set (map second two-attrs))))) (t/is (= #{:width :height} (set (map #(nth % 2) two-attrs))))) - ;; a name the lib never defines produces no edge - (t/is (empty? (queries/shapes-using-token db "ghost.token"))))) + ;; a name the lib never defines produces no edge... + (t/is (empty? (queries/shapes-using-token db "ghost.token"))) + + ;; ...but the folded encoding stores it: the datom is present, the + ;; rule hides it (its join on :token/name finds no entity) + (let [ghost-eid (queries/shape-eid db (queries/container-eid db (thi/id :main-page)) + (thi/id :ghost-rect))] + (t/is (= "ghost.token" (:token/fill (d/entity db ghost-eid)))) + (t/is (= [[:token/fill "ghost.token"]] + (map (juxt :a :v) (d/datoms db :eavt ghost-eid :token/fill))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; colors and typographies @@ -660,6 +736,96 @@ (t/is (empty? (queries/shapes-using-color db (thi/id :color-ghost)))) (t/is (empty? (queries/shapes-using-typography db (thi/id :typo-ghost)))))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; the R1 invariance pin +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def ^:private control-symbols + "Clause heads that structure a query rather than call a function, the + console gate's own list (`app.graph.overlay.console`)." + '#{not not-join or or-join and pull}) + +(def ^:private rule-names + (into #{} (map (comp first first)) queries/rules)) + +(def ^:private allowed-query-symbols + "The closed call vocabulary: the shared rules, datascript's built-in + query fns and aggregates, and the control forms — exactly the set the + console gate admits." + (-> #{} + (into (keys bi/query-fns)) + (into (keys bi/aggregates)) + (into control-symbols) + (into rule-names))) + +(defn- query-call-symbols + "Every symbol in call position: heads of list clauses (rule + invocations, predicates, control forms). Mirrors the console gate's + walk over the query form." + [form] + (cond + (seq? form) + (into (if (symbol? (first form)) [(first form)] []) + (mapcat query-call-symbols) + (rest form)) + + (coll? form) + (into [] (mapcat query-call-symbols) form) + + :else [])) + +(t/deftest consumer-query-texts-invoke-only-shared-rules + ;; The R1 invariance claim. The 20260820 report verified the same + ;; consumer query texts across the pre-retrofit and post-retrofit + ;; encodings (docs.local/graph/20260820-report-graph-overlay-datascript.md); + ;; this test holds two of them — instances inside a subtree, shapes + ;; using a token — written once, runs them against the current + ;; encoding, and pins that their call positions name only shared rules + ;; and datascript built-ins. A text that cannot see an encoding cannot + ;; break when the encoding changes. + (let [{:keys [data db]} (semantic-fixture) + lib-names (into #{} (map :name) (ctob/get-all-tokens (:tokens-lib data))) + instances-in-subtree + '[:find ?pid ?id + :in $ % ?cid ?sid + :where + [?c :container/id ?cid] + [?s :shape/container ?c] + [?s :shape/id ?sid] + (descendant-of ?i ?s) + (instance-of ?i ?comp) + [?i :shape/container ?pc] + [?pc :container/id ?pid] + [?i :shape/id ?id]] + shapes-using-token + '[:find ?cid ?id + :in $ % ?name + :where + [?tok :token/name ?name] + (uses-token ?s ?tok) + [?s :shape/container ?c] + [?c :container/id ?cid] + [?s :shape/id ?id]]] + + ;; the texts answer on the current encoding: instances inside + ;; comp-c's root are exactly the nested comp-a head + (t/is (= #{[(thi/id :main-page) (thi/id :nested-a)]} + (set (d/q instances-in-subtree db queries/rules + (thi/id :main-page) (thi/id :comp-c-root))))) + + ;; and every token text's answer equals the standing fn's + (doseq [name lib-names] + (t/is (= (set (map #(subvec % 0 2) (queries/shapes-using-token db name))) + (set (d/q shapes-using-token db queries/rules name))) + (str "token query text on " name))) + + ;; the texts only reference rule names: every list-clause head is a + ;; shared rule or a datascript built-in, nothing else + (doseq [q [instances-in-subtree shapes-using-token]] + (doseq [sym (query-call-symbols q)] + (t/is (contains? allowed-query-symbols sym) + (str "call symbol " sym " in " (pr-str q))))))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; parity counting ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -669,13 +835,20 @@ ;; so the parity fn itself is pinned: page shapes minus root frames, ;; pages, and live components. 22 page shapes + 2 pages + 4 live ;; components = 28 IsChildOf; 8 on-page instance heads against live - ;; components; 6 on-page resolvable shape-refs; 1 on-page swap slot. + ;; components; 1 on-page swap slot. `:refers-to` now counts the + ;; builder-resolved page->page references (the `refers-to` rule scoped + ;; to page shapes on both sides), not id-join pairs: the derivation + ;; below reads `ctf/find-ref-shape`'s answer per copy shape and keeps + ;; the page->page ones. On this fixture every copy resolves to a live + ;; main on a page, so the count is still 6 — the encoding changed, the + ;; number did not. (let [{:keys [data db]} (semantic-fixture) pages (vals (:pages-index data)) page-shapes (remove #(= uuid/zero (:id %)) (mapcat #(vals (:objects %)) pages)) live-comps (ctkl/components-seq data) - on-page? (fn [id] (some #(contains? (:objects %) id) pages)) + shape-on-page? (fn [id] (some #(contains? (:objects %) id) pages)) + page-container? (fn [cid] (contains? (:pages-index data) cid)) live-head? (fn [shape] (some (fn [component] (ctk/instance-of? shape (:id data) (:id component))) @@ -684,11 +857,11 @@ (count pages) (count live-comps)) :is-instance-of (count (filter live-head? page-shapes)) - :refers-to (count (filter #(and (:shape-ref %) - (on-page? (:shape-ref %))) - page-shapes)) + :refers-to (count (filter (fn [[_scid _sid tcid _tid]] + (page-container? tcid)) + (oracle-refs data))) :fills-swap-slot (count (filter #(let [slot (ctk/get-swap-slot %)] - (and slot (on-page? slot))) + (and slot (shape-on-page? slot))) page-shapes))}] (t/is (= derived (queries/ladybug-parity-counts db)))