From 0d1647841f42d774bdac42932f00490a877eccd9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=C3=81lvaro=20Tejero=20Cantero?= Date: Fri, 21 Aug 2026 02:27:16 +0200 Subject: [PATCH] :tada: Add datascript graph overlay over the document An index of identity, type, and topology in datascript, replacing the per-file Ladybug database for reverse and cross-container questions. Entity identity is the (container, shape) pair, never the shape id alone: uuid/zero keys every page's root frame, duplicated pages share non-root ids, and deleted components keep their own copy of the main-instance subtree under the same ids. app.graph.overlay projects a file's data into the index: pages and component containers, shapes, components, and the asset node kinds the Ladybug projection never gained (colors, typographies, token sets, tokens), with their link transforms from beadpot's ledger (UsesColor, UsesTypography, UsesToken) as reference attributes and relation entities. Color references are stored per source (fill, stroke, text content) so the sync path can rebuild each contribution from a single :set operation. app.graph.overlay.queries holds the shared rule set and the standing question set. The four Cypher edge kinds are rules over indexed attributes, so they cannot drift from what they restate. The helpers in app.common.types.component and friends stay the oracle: instance-head? is the [?s :shape/component-id _] clause, never a reimplementation, and the local upward walk stays with ctn/get-parent-heads when the caller holds the document, because the pointer chain beats the rule walk by three orders of magnitude. app.graph.overlay.sync applies Penpot change vectors to the index, pure db-to-db, mirroring app.common.files.changes/process-change per clause, including load-component-objects on soft component deletion. app.graph.overlay.console parses, gates, and formats free-form Datalog: datascript resolves namespace-qualified symbols in call position via resolve, so every call symbol must be a built-in, an aggregate, or a shared rule. The suites pin: overlay answers identical to the helpers on constructed fixtures (177 assertions, beadpot's graph tests backported with each claim verified against a helper), synced index equal to a rebuilt one after every prefix of a 29-change replay covering all 12 supported change types, and the console gate. Measured on the Pencil design system (49 pages, 21 256 shapes, 730 components): build 1.63 s, 157 893 datoms, about 7.5 MB retained, answers identical to the helpers across 724 components, 1 000 sampled parent-head chains, and 5 549 frame subtrees; sync p95 0.28 ms per commit. The Ladybug session tier measured 33 to 43 s and 144 MB for a 20k-shape file the projection can ingest; the projection still rejects every real file at the Path node. AI-assisted-by: claude-fable-5 --- backend/src/app/graph/overlay.clj | 359 +++++++++ backend/src/app/graph/overlay/console.clj | 155 ++++ backend/src/app/graph/overlay/queries.clj | 374 ++++++++++ backend/src/app/graph/overlay/sync.clj | 454 ++++++++++++ .../graph_overlay_console_test.clj | 120 +++ .../backend_tests/graph_overlay_sync_test.clj | 471 ++++++++++++ .../test/backend_tests/graph_overlay_test.clj | 699 ++++++++++++++++++ 7 files changed, 2632 insertions(+) create mode 100644 backend/src/app/graph/overlay.clj create mode 100644 backend/src/app/graph/overlay/console.clj create mode 100644 backend/src/app/graph/overlay/queries.clj create mode 100644 backend/src/app/graph/overlay/sync.clj create mode 100644 backend/test/backend_tests/graph_overlay_console_test.clj create mode 100644 backend/test/backend_tests/graph_overlay_sync_test.clj create mode 100644 backend/test/backend_tests/graph_overlay_test.clj diff --git a/backend/src/app/graph/overlay.clj b/backend/src/app/graph/overlay.clj new file mode 100644 index 0000000000..f7ab3e7a4d --- /dev/null +++ b/backend/src/app/graph/overlay.clj @@ -0,0 +1,359 @@ +;; This Source Code Form is subject to the terms of the Mozilla Public +;; License, v. 2.0. If a copy of the MPL was not distributed with this +;; file, You can obtain one at http://mozilla.org/MPL/2.0/. +;; +;; Copyright (c) KALEIDOS INC Sucursal en España SL + +(ns app.graph.overlay + "Datascript index over a Penpot document: identity, type, and topology. + + The overlay is an index over what Penpot's helpers read, never a + reimplementation of them. `app.common.types.component/instance-head?`, + `app.common.types.container/get-parent-heads`, + `app.common.types.file/find-ref-shape` and their relatives stay the + correctness oracle; the overlay's job is to make the questions those + helpers answer by scanning cheap to reach at scale + (docs.local/graph/20260819-report-graph-overlay-datascript.md). + + Entity identity is the (container, shape) pair, never the shape id + alone. Shape ids are stable but repeat across containers: `uuid/zero` + keys the root frame of every page, duplicated pages share non-root ids, + and a deleted component keeps its own copy of the main-instance subtree + under the same ids (`app.common.types.file/load-component-objects`). + The builder therefore mints one entity per (container, shape) pair, and + parent links are datascript entity references, so topology is interned + by construction. + + 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.tokens-lib :as ctob] + [datascript.core :as d])) + +(def schema-version + "penpot-graph-overlay-1") + +(def schema + "Only identity, type, topology, and the attributes a standing query has + asked for. Heavy attributes (geometry, style payloads) stay in the + document, which the holder of the overlay already has. + + Color references are stored per source (`fill`, `stroke`, text content) + 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." + {;; document + :document/id {:db/unique :db.unique/identity} + ;; containers: pages, and components that carry their own :objects + :container/id {:db/unique :db.unique/identity} + :container/document {:db/valueType :db.type/ref} + ;; shapes: identity is the (container, shape) pair + :shape/id {:db/index true} + :shape/container {:db/valueType :db.type/ref} + :shape/parent {:db/valueType :db.type/ref} + :shape/name {:db/index true} + :shape/component-id {:db/index true} + :shape/component-file {:db/index true} + :shape/shape-ref {:db/index true} + :shape/swap-slot {: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} + :shape/stroke-color {:db/valueType :db.type/ref + :db/cardinality :db.cardinality/many} + :shape/text-color {:db/valueType :db.type/ref + :db/cardinality :db.cardinality/many} + :shape/uses-typography {:db/valueType :db.type/ref + :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} + ;; library assets + :color/id {:db/unique :db.unique/identity} + :color/document {:db/valueType :db.type/ref} + :typography/id {:db/unique :db.unique/identity} + :typography/document {:db/valueType :db.type/ref} + :token-set/id {:db/unique :db.unique/identity} + :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}}) + +(def shape-type->table + "The Ladybug projection's node table names, kept for parity counting and + for console labels (`app.graph.schema.nodes/shape-node-types`)." + {:frame "Frame" + :group "Group" + :bool "Boolean" + :svg-raw "SVGRaw" + :rect "Rectangle" + :circle "Circle" + :path "Path" + :text "Text" + :image "Image"}) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; tempids +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def doc-tempid "doc") + +(defn container-tempid + [container-id] + (str "c/" container-id)) + +(defn shape-tempid + [container-id shape-id] + (str "s/" container-id "/" shape-id)) + +(defn color-tempid [id] (str "col/" id)) +(defn typography-tempid [id] (str "typ/" id)) +(defn token-set-tempid [id] (str "ts/" id)) +(defn token-tempid [id] (str "tk/" id)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; reference extraction +;; +;; These read exactly the attributes Penpot's own code reads: fill and +;; stroke color refs as `app.common.types.color/stroke->color` does, +;; typography refs from text content nodes as +;; `app.common.types.typography` does via `txt/node-seq`, swap slots via +;; `ctk/get-swap-slot`. None of the predicates is reimplemented. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defn fill-color-ref-ids + "Library color ids referenced by a `:fills` vector." + [fills] + (into #{} (keep :fill-color-ref-id) fills)) + +(defn stroke-color-ref-ids + "Library color ids referenced by a `:strokes` vector." + [strokes] + (into #{} (keep :stroke-color-ref-id) strokes)) + +(defn content-color-ref-ids + "Library color ids referenced by fills inside text `content` nodes." + [content] + (into #{} + (comp (mapcat :fills) (keep :fill-color-ref-id)) + (some-> content txt/node-seq))) + +(defn content-typography-ref-ids + "Typography ids referenced by text `content` nodes." + [content] + (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. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defn- resolvable-parent? + [objects shape] + (let [parent-id (:parent-id shape)] + (and (some? parent-id) + (not= parent-id (:id shape)) + (contains? objects parent-id)))) + +(defn shape-asset-attrs + "The asset-edge attributes of one shape, resolved through `asset-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))) + 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))] + (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)))) + +(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)} + (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)) + (some? (:shape-ref shape)) (assoc :shape/shape-ref (:shape-ref shape)) + (some? swap-slot) (assoc :shape/swap-slot swap-slot)))) + +(defn shape-entity + "Entity map for one shape of one container. + + `container-ref` is the container entity reference: the container tempid + at build time, the resolved eid on the sync path. The parent reference + falls back to it when the parent is absent from `objects` or + 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})) + +(defn container-entities + "Entities for every shape of one container's `:objects` map, plus the + applied-token relation entities. + + 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] + (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))))) + (vals objects))) + +(defn component-entity + [component] + (cond-> {:db/id (container-tempid (:id component)) + :component/id (:id component) + :component/document doc-tempid} + (some? (:name component)) + (assoc :component/name (:name component)) + (:deleted component) + (assoc :component/deleted true) + (some? (:main-instance-id component)) + (assoc :component/main-instance-id (:main-instance-id component)) + (some? (:main-instance-page component)) + (assoc :component/main-instance-page (:main-instance-page component)))) + +(defn- component-tx + "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] + (let [objects (:objects component)] + (cond-> [(component-entity component)] + (seq objects) + (-> (conj {:db/id (container-tempid (:id component)) + :container/id (:id component) + :container/kind :component + :container/document doc-tempid}) + (into (container-entities (container-tempid (:id component)) + (:id component) objects asset-ctx)))))) + +(defn- page-tx + [page asset-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))) + +(defn- tokens-tx + "Token set and token entities from the file's tokens lib. + + Only identity, type and set membership: values, resolution and themes + stay in the lib, which `app.common.types.tokens-lib` already answers." + [tokens-lib] + (into [] + (mapcat (fn [set*] + (let [set-id (ctob/get-id set*) + set-name (ctob/get-name set*)] + (cons {:db/id (token-set-tempid set-id) + :token-set/id set-id + :token-set/name set-name + :token-set/document doc-tempid} + (for [token (vals (ctob/get-tokens- set*))] + {:db/id (token-tempid (:id token)) + :token/id (:id token) + :token/name (:name token) + :token/type (:type token) + :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- build-asset-ctx + [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))}) + +(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." + [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)))))) + +(defn build + "Project file `data` into a fresh overlay. Pure: returns a datascript + database value." + ([data] (build data nil)) + ([data file] + (d/db-with (d/empty-db schema) (build-tx data file)))) diff --git a/backend/src/app/graph/overlay/console.clj b/backend/src/app/graph/overlay/console.clj new file mode 100644 index 0000000000..455df30e9b --- /dev/null +++ b/backend/src/app/graph/overlay/console.clj @@ -0,0 +1,155 @@ +;; This Source Code Form is subject to the terms of the Mozilla Public +;; License, v. 2.0. If a copy of the MPL was not distributed with this +;; file, You can obtain one at http://mozilla.org/MPL/2.0/. +;; +;; Copyright (c) KALEIDOS INC Sucursal en España SL + +(ns app.graph.overlay.console + "Free-form Datalog for the debug graph console: parse, gate, run, + format. + + The gate replaces the Cypher binder gate + (`app.graph.ladybug/validate-on-connection!`) with the equivalent + guarantee for datascript: a console query can read anything and execute + nothing. `d/q` cannot transact, so mutation is off the table by + construction; what remains is function clauses. Datascript resolves a + namespace-qualified symbol in call position through `resolve`, which + would hand the console arbitrary code execution + (`[(clojure.core/eval ...)]`), so every symbol in call position must be + a datascript built-in, a built-in aggregate, or a rule from the shared + rule set. Unknown symbols are rejected before the query runs, with the + binder's own courtesy: the error names the symbol." + (:require + [app.common.exceptions :as ex] + [app.graph.overlay.queries :as queries] + [clojure.edn :as edn] + [datascript.built-ins :as bi] + [datascript.core :as d])) + +(def max-rows + "Row cap for console query results; far above expected per-file counts." + 10000) + +(def ^:private control-symbols + "Clause heads that structure a query rather than call a function." + '#{not not-join or or-join and pull}) + +(def ^:private rule-names + (into #{} (map (comp first first)) queries/rules)) + +(def ^:private allowed-call-symbols + (-> #{} + (into (keys bi/query-fns)) + (into (keys bi/aggregates)) + (into control-symbols) + (into rule-names))) + +(defn- collect-call-symbols + "Every symbol in call position anywhere in `form`: heads of seqs (rule + invocations, aggregates, control forms) and of function/predicate + clauses." + [form] + (cond + (seq? form) + (let [head (first form)] + (into (if (symbol? head) [head] []) + (mapcat collect-call-symbols) + (rest form))) + + (coll? form) + (into [] (mapcat collect-call-symbols) form) + + :else [])) + +(defn parse-query + "Parse the console text as EDN. Only data readers for uuid are honoured; + everything else is inert data." + [text] + (try + (let [q (edn/read-string {:readers {'uuid parse-uuid}} text)] + (when-not (or (vector? q) (map? q)) + (ex/raise :type :validation + :code :graph-query-invalid + :hint "a datalog query is a vector or a map")) + q) + (catch clojure.lang.ExceptionInfo e (throw e)) + (catch Exception e + (ex/raise :type :validation + :code :graph-query-invalid + :hint (str "unreadable query: " (ex-message e)))))) + +(defn check-query! + "The gate: reject any call-position symbol that is not a datascript + built-in, aggregate, control form, or shared rule." + [query] + (let [unknown (into (sorted-set) + (remove allowed-call-symbols) + (collect-call-symbols query))] + (when (seq unknown) + (ex/raise :type :validation + :code :graph-query-not-read-only + :hint (str "unknown function(s) in query: " + (pr-str (vec unknown)) + " — the console runs datascript built-ins and the shared rules only"))) + query)) + +(defn- query-sections + "Normalize the vector query form into its keyword sections." + [query] + (if (map? query) + query + (loop [acc {} section nil forms (seq query)] + (if-let [form (first forms)] + (if (keyword? form) + (recur acc form (rest forms)) + (recur (update acc section (fnil conj []) form) section (rest forms))) + acc)))) + +(defn- find-columns + "Column names from the :find clause; `?foo` renders as `foo`, so the + console's `filter_*` graph-view convention carries over verbatim." + [query] + (mapv (fn [el] + (cond + (symbol? el) (let [n (name el)] + (cond-> n (.startsWith ^String n "?") (subs 1))) + :else (pr-str el))) + (remove '#{. ...} (:find (query-sections query))))) + +(defn- wants-rules? + [query] + (some #{'%} (:in (query-sections query)))) + +(defn- normalize-rows + "d/q returns a relation (set of tuples), a scalar, a collection, or a + single tuple depending on the find spec; the console table always wants + rows of cells." + [result] + (cond + (set? result) (mapv vec result) + (sequential? result) (if (and (seq result) (sequential? (first result))) + (mapv vec result) + (mapv vector result)) + (nil? result) [] + :else [[result]])) + +(defn run-query + "Parse, gate, and run `text` against overlay `db`. + + `$` is always supplied; `%` (the shared rule set of + `app.graph.overlay.queries`) is supplied when the query's :in asks for + it. Returns {:columns [...] :rows [...] :truncated? bool :row-count n} + in the shape the console template renders." + [db text] + (let [query (-> text parse-query check-query!) + rows (normalize-rows + (if (wants-rules? query) + (d/q query db queries/rules) + (d/q query db))) + over? (> (count rows) max-rows) + rows (if over? (into [] (take max-rows) rows) rows) + columns (find-columns query)] + {:columns columns + :rows rows + :truncated? over? + :row-count (count rows)})) diff --git a/backend/src/app/graph/overlay/queries.clj b/backend/src/app/graph/overlay/queries.clj new file mode 100644 index 0000000000..540c4b8491 --- /dev/null +++ b/backend/src/app/graph/overlay/queries.clj @@ -0,0 +1,374 @@ +;; This Source Code Form is subject to the terms of the Mozilla Public +;; License, v. 2.0. If a copy of the MPL was not distributed with this +;; file, You can obtain one at http://mozilla.org/MPL/2.0/. +;; +;; 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. + + 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." + (:require + [app.common.uuid :as uuid] + [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 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)] + + ;; 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)] + + ;; 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])] + + ;; 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]] + + ;; 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]] + + ;; UsesToken: the relation entity flattened to an edge + [(uses-token ?s ?t) + [?u :token-use/shape ?s] + [?u :token-use/token ?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]]]) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; entity resolution +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defn container-eid + [db container-id] + (d/entid db [:container/id container-id])) + +(defn shape-eid + "Resolve the (container, shape) pair to its entity id. + + An AVET lookup on `:shape/id` narrowed by container: the id alone is + not identity (`uuid/zero` keys every page's root frame)." + [db container-eid shape-id] + (some (fn [datom] + (let [e (:e datom)] + (when (= container-eid (:db/id (:shape/container (d/entity db e)))) + e))) + (d/datoms db :avet :shape/id shape-id))) + +(defn shape-eids + "Every entity carrying `shape-id`, across containers." + [db shape-id] + (mapv :e (d/datoms db :avet :shape/id shape-id))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; the standing question set +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defn- entity-depth + [db eid] + (loop [e (d/entity db eid) n 0] + (if-let [p (:shape/parent e)] + (recur p (inc n)) + n))) + +(defn parent-heads + "Component heads that are ancestors of (container, shape), self + included, top-down: the overlay formulation of `ctn/get-parent-heads`. + + Adoption note: a caller holding the page objects should call the helper + directly; the pointer chain beats the rule walk by three orders of + magnitude. This exists for index-only callers and as the semantic pin + that the overlay's topology equals the document's." + [db container-id shape-id] + (let [heads (d/q '[:find [?a ...] + :in $ % ?cid ?sid + :where + [?c :container/id ?cid] + [?s :shape/container ?c] + [?s :shape/id ?sid] + (anc-or-self ?s ?a) + [?a :shape/component-id _]] + db rules container-id shape-id)] + (->> heads + (sort-by #(entity-depth db %)) + (mapv #(:shape/id (d/entity db %)))))) + +(defn instances-of + "Every instance head of (component, file) on any page, as + [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." + [db component-id file-id] + (d/q '[:find ?pid ?id + :in $ ?cid ?fid + :where + [?e :shape/component-id ?cid] + [?e :shape/component-file ?fid] + [?e :shape/container ?c] + [?c :container/kind :page] + [?c :container/id ?pid] + [?e :shape/id ?id]] + db component-id file-id)) + +(defn descendant-ids + "Descendant shape ids of (container, shape), self excluded: the overlay + formulation of `cfh/get-children-ids`, as a set (z-order is the + document's business; the index answers membership)." + [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] + (desc ?s ?d) + [?d :shape/id ?id]] + db rules container-id shape-id))) + +(defn descendant-ids-of-type + "Descendants of (container, shape) whose `:shape/type` is `type`: the + composition the report names as the overlay's advantage — a predicate + is one more clause, not one more function." + [db container-id shape-id type] + (set (d/q '[:find [?id ...] + :in $ % ?cid ?sid ?type + :where + [?c :container/id ?cid] + [?s :shape/container ?c] + [?s :shape/id ?sid] + (desc ?s ?d) + [?d :shape/type ?type] + [?d :shape/id ?id]] + db rules container-id shape-id type))) + +(defn shapes-by-name + "Shapes named exactly `name`, as [container-id shape-id] pairs, from + one AVET lookup." + [db name] + (d/q '[:find ?cid ?id + :in $ ?name + :where + [?s :shape/name ?name] + [?s :shape/container ?c] + [?c :container/id ?cid] + [?s :shape/id ?id]] + db name)) + +(defn instance-heads + "Every instance head on any page, as [page-id shape-id] pairs + (`ctk/instance-head?` over the whole document)." + [db] + (d/q '[:find ?pid ?id + :where + [?s :shape/component-id _] + [?s :shape/container ?c] + [?c :container/kind :page] + [?c :container/id ?pid] + [?s :shape/id ?id]] + db)) + +(defn shapes-using-color + "Shapes referencing library color `color-id`, as [container-id shape-id] + pairs (the LinkUsedColors question)." + [db color-id] + (d/q '[:find ?cid ?id + :in $ % ?colid + :where + [?col :color/id ?colid] + (uses-color ?s ?col) + [?s :shape/container ?c] + [?c :container/id ?cid] + [?s :shape/id ?id]] + db rules color-id)) + +(defn shapes-using-typography + "Shapes referencing `typography-id`, as [container-id shape-id] pairs + (the LinkUsedTypographies question)." + [db typography-id] + (d/q '[:find ?cid ?id + :in $ ?tid + :where + [?t :typography/id ?tid] + [?s :shape/uses-typography ?t] + [?s :shape/container ?c] + [?c :container/id ?cid] + [?s :shape/id ?id]] + db typography-id)) + +(defn shapes-using-token + "Applied-token uses of the token named `token-name`, as + [container-id shape-id property] triples (the LinkAppliedTokens + question)." + [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)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; inventory and parity +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defn- attr-count + [db attr] + (count (d/datoms db :avet attr))) + +(defn stats + "Entity and edge inventory of the overlay." + [db] + {:datoms (count db) + :documents (attr-count db :document/id) + :containers (attr-count db :container/id) + :shapes (attr-count db :shape/id) + :components (attr-count db :component/id) + :colors (attr-count db :color/id) + :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)}) + +(defn edge-counts + "Count of every edge kind under the overlay's own conventions (all + containers, deleted components included where a rule does not exclude + them)." + [db] + {: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)] + db rules)) + :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)}) + +(defn ladybug-parity-counts + "Edge counts under the Ladybug projection's own conventions, for the + roadmap's structure check: page shapes only (component containers are + 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." + [db] + (let [zero uuid/zero + page-shapes (d/q '[:find [?s ...] + :in $ ?zero + :where + [?s :shape/container ?c] + [?c :container/kind :page] + (not [?s :shape/id ?zero])] + db zero) + pages (count (d/q '[:find [?c ...] + :where [?c :container/kind :page]] + db)) + live-comps (count (d/q '[:find [?c ...] + :where + [?c :component/id _] + (not [?c :component/deleted true])] + db))] + {:is-child-of (+ (count page-shapes) pages live-comps) + :is-instance-of (count (d/q '[:find ?s ?c + :in $ % + :where + (on-page ?s) + (is-instance-of ?s ?c)] + db rules)) + :refers-to (count (d/q '[:find ?s ?t + :in $ % + :where + (on-page ?s) + (refers-to ?s ?t) + (on-page ?t)] + db rules)) + :fills-swap-slot (count (d/q '[:find ?s ?t + :in $ % + :where + (on-page ?s) + (fills-swap-slot ?s ?t) + (on-page ?t)] + db rules))})) + +(defn component-main-instances + "[component-id main-instance-page main-instance-id] for every live + component that declares a main instance (the beadpot main-instance + linkage claim)." + [db] + (d/q '[:find ?id ?pid ?mid + :where + [?c :component/id ?id] + [?c :component/main-instance-page ?pid] + [?c :component/main-instance-id ?mid] + (not [?c :component/deleted true])] + db)) diff --git a/backend/src/app/graph/overlay/sync.clj b/backend/src/app/graph/overlay/sync.clj new file mode 100644 index 0000000000..7756e008e4 --- /dev/null +++ b/backend/src/app/graph/overlay/sync.clj @@ -0,0 +1,454 @@ +;; This Source Code Form is subject to the terms of the Mozilla Public +;; License, v. 2.0. If a copy of the MPL was not distributed with this +;; file, You can obtain one at http://mozilla.org/MPL/2.0/. +;; +;; Copyright (c) KALEIDOS INC Sucursal en España SL + +(ns app.graph.overlay.sync + "Incremental overlay updates from Penpot change vectors. + + The invariant this namespace defends: an overlay maintained from change + vectors equals an overlay rebuilt from the changed document. The change + semantics are `app.common.files.changes/process-change`'s, mirrored + clause by clause and cited per function; where a change touches state + the overlay does not index (geometry, style payloads), the mirror is a + no-op by design. + + Everything here is pure: db value in, db value out. The session layer + owns the atom and the revision bookkeeping." + (:require + [app.common.types.component :as ctk] + [app.common.types.page :as ctp] + [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-page :del-page :mod-page + :add-component :mod-component :del-component + :restore-component :purge-component}) + +(defn supported-change? + [change] + (contains? supported-change-types (:type change))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; resolution against the live db +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defn- doc-eid + [db] + (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." + [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))}) + +(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))) + +(defn- child-eids + [db eid] + (mapv :e (d/datoms db :avet :shape/parent eid))) + +(defn- subtree-eids + "The shape entity plus every descendant, via the reverse parent index." + [db root-eid] + (loop [acc [] + frontier [root-eid]] + (if-let [eid (peek frontier)] + (recur (conj acc eid) + (into (pop frontier) (child-eids db eid))) + acc))) + +(defn- container-shape-eids + [db container-eid] + (mapv :e (d/datoms db :avet :shape/container container-eid))) + +(defn- retract-container-shapes-tx + [db container-eid] + (into [] + (mapcat #(retract-shape-tx db %)) + (container-shape-eids db container-eid))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; per-change application +;; +;; Each function returns {:db db :applied? bool :reason kw?}. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defn- ok + [db] + {:db db :applied? true}) + +(defn- skip + [db reason] + {:db db :applied? false :reason reason}) + +(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}] + (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) + ctx (sync-asset-ctx db) + shape (assoc obj :id id) + tempid (overlay/shape-tempid container-id id) + existing (queries/shape-eid db ceid id) + tx (-> (if existing (retract-shape-tx db existing) []) + (conj (merge {:db/id tempid + :shape/id id + :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)))))) + +(def ^:private plain-attr->overlay + {:name :shape/name + :component-id :shape/component-id + :component-file :shape/component-file + :shape-ref :shape/shape-ref}) + +(defn- replace-attr-tx + [eid attr val] + (if (some? val) + [[:db/add eid attr val]] + [[:db.fn/retractAttribute eid attr]])) + +(defn- replace-many-tx + [eid attr refs] + (into [[:db.fn/retractAttribute eid attr]] + (map (fn [r] [:db/add eid attr r])) + refs)) + +(defn- swap-slot-tx + "Mirror of `process-operation :set-touched`: `touched` only sticks on a + shape inside a component copy, and the overlay only indexes the swap + slot `ctk/get-swap-slot` extracts from it." + [db eid touched] + (let [in-copy? (some? (:shape/shape-ref (d/entity db eid))) + slot (when (and in-copy? (seq touched)) + (ctk/get-swap-slot {:touched touched}))] + (replace-attr-tx eid :shape/swap-slot slot))) + +(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), + mirroring `ctn/set-shape-attr` only for the indexed slice." + [db eid ctx {:keys [type attr val touched]}] + (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) + + (= :touched attr) + (swap-slot-tx db eid val) + + (= :fills attr) + (replace-many-tx eid :shape/fill-color + (keep (:colors ctx) (overlay/fill-color-ref-ids val))) + + (= :strokes attr) + (replace-many-tx eid :shape/stroke-color + (keep (:colors ctx) (overlay/stroke-color-ref-ids val))) + + (= :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)))) + + (= :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))) + + :else nil)) + +(defn- apply-mod-obj + [db {:keys [id operations] :as change}] + (let [ceid (queries/container-eid db (change-container-id change)) + eid (when ceid (queries/shape-eid db ceid id))] + (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))))))) + +(defn- apply-del-obj + [db {:keys [id] :as change}] + (let [ceid (queries/container-eid db (change-container-id change)) + eid (when ceid (queries/shape-eid db ceid id))] + (if-not eid + ;; 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))))))) + +(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." + [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))))))) + +(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." + [db {:keys [id name page]}] + (let [page (if (and (string? name) (uuid? id)) + (ctp/make-empty-page {:id id :name name}) + page) + page-id (:id page)] + (if (queries/container-eid db page-id) + (ok db) + (let [ctx (sync-asset-ctx db) + tid (overlay/container-tempid page-id) + tx (into [(cond-> {:db/id tid + :container/id page-id + :container/kind :page + :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)))))) + +(defn- apply-del-page + [db {:keys [id]}] + (if-let [ceid (queries/container-eid db id)] + (ok (d/db-with db (conj (retract-container-shapes-tx db ceid) + [:db.fn/retractEntity ceid]))) + (skip db :missing-page))) + +(defn- apply-mod-page + [db {:keys [id name]}] + (let [ceid (queries/container-eid db id)] + (cond + (nil? ceid) (skip db :missing-page) + (not (string? name)) (ok db) + :else (ok (d/db-with db [[:db/add ceid :container/name name]]))))) + +(defn- component-attrs-tx + [eid {:keys [name main-instance-id main-instance-page]}] + (cond-> [] + (some? name) (conj [:db/add eid :component/name name]) + (some? main-instance-id) (conj [:db/add eid :component/main-instance-id main-instance-id]) + (some? main-instance-page) (conj [:db/add eid :component/main-instance-page main-instance-page]))) + +(defn- apply-add-component + "Mirror of `ctkl/add-component`; objects never ride an add." + [db {:keys [id] :as change}] + (if (d/entid db [:component/id id]) + (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))))) + +(defn- clear-component-container-tx + "Drop a component's own shape copies and its container role, keeping the + component record (mirror of the `dissoc :objects` in + `ctkl/mod-component` and `ctf/restore-component`)." + [db eid] + (into (retract-container-shapes-tx db eid) + [[:db.fn/retractAttribute eid :container/id] + [:db.fn/retractAttribute eid :container/kind] + [:db.fn/retractAttribute eid :container/document]])) + +(defn- component-container-tx + "Give the component entity a container role over `objects`." + [db eid component-id objects] + (let [ctx (sync-asset-ctx db)] + (into [[:db/add eid :container/id component-id] + [:db/add eid :container/kind :component] + [:db/add eid :container/document (doc-eid db)]] + (overlay/container-entities eid component-id objects ctx)))) + +(defn- apply-mod-component + "Mirror of `ctkl/mod-component`, including its sharpest edge: a + `:mod-component` without `:objects` dissocs the component's own copy, + so the overlay drops the component container either way and rebuilds it + 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)))) + (skip db :missing-component))) + +(defn- entity-shape-attrs + "The indexed attrs of a live shape entity, as assertable values (asset + references flattened to eids)." + [ent] + (let [many-ids #(into [] (map :db/id) %)] + (cond-> {:shape/type (:shape/type ent)} + (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)) + (some? (:shape/shape-ref ent)) (assoc :shape/shape-ref (:shape/shape-ref ent)) + (some? (:shape/swap-slot ent)) (assoc :shape/swap-slot (:shape/swap-slot ent)) + (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)))))) + +(defn- snapshot-component-tx + "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." + [db comp-eid] + (let [ent (d/entity db comp-eid) + comp-id (:component/id ent) + mid (:component/main-instance-id ent) + mpg (:component/main-instance-page ent) + pceid (when mpg (queries/container-eid db mpg)) + root (when (and pceid mid) (queries/shape-eid db pceid mid))] + (when (and root (empty? (container-shape-eids db comp-eid))) + (let [eids (subtree-eids db root) + eidset (set eids) + copy-tempid (fn [eid] + (overlay/shape-tempid comp-id (:shape/id (d/entity db eid))))] + (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)))) + 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." + [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))))) + (ok db))) + +(defn- apply-restore-component + "Mirror of `ctf/restore-component`: undelete, drop the component's own + copy, optionally repoint the main-instance page." + [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))) + (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]))) + (ok db))) + +(defn- apply-change + [db change] + (case (:type change) + :add-obj (apply-add-obj db change) + :mod-obj (apply-mod-obj db change) + :del-obj (apply-del-obj db change) + :mov-objects (apply-mov-objects db change) + :add-page (apply-add-page db change) + :del-page (apply-del-page db change) + :mod-page (apply-mod-page db change) + :add-component (apply-add-component db change) + :mod-component (apply-mod-component db change) + :del-component (apply-del-component db change) + :restore-component (apply-restore-component db change) + :purge-component (apply-purge-component db change) + (skip db :unsupported-type))) + +(defn apply-changes + "Apply Penpot `changes` to overlay `db`. Pure. + + Returns `{:db db' :applied [types...] :skipped [{:type .. :reason ..}]}`." + [db changes] + (reduce (fn [acc change] + (let [{:keys [db applied? reason]} (apply-change (:db acc) change)] + (-> acc + (assoc :db db) + (cond-> + applied? (update :applied conj (:type change)) + (not applied?) (update :skipped conj {:type (:type change) + :reason reason}))))) + {:db db :applied [] :skipped []} + changes)) diff --git a/backend/test/backend_tests/graph_overlay_console_test.clj b/backend/test/backend_tests/graph_overlay_console_test.clj new file mode 100644 index 0000000000..f0203e1fb1 --- /dev/null +++ b/backend/test/backend_tests/graph_overlay_console_test.clj @@ -0,0 +1,120 @@ +;; This Source Code Form is subject to the terms of the Mozilla Public +;; License, v. 2.0. If a copy of the MPL was not distributed with this +;; file, You can obtain one at http://mozilla.org/MPL/2.0/. +;; +;; Copyright (c) KALEIDOS INC Sucursal en España SL + +(ns backend-tests.graph-overlay-console-test + "Pure tests over the console's parse-gate-run pipeline + (`app.graph.overlay.console/run-query`) and the default query it ships + (`app.graph.debug/default-query`). + + The gate exists so the console cannot run arbitrary Clojure; these + tests hold it shut against namespace-qualified functions and unknown + bare symbols, and hold it open for the shared rules, datascript + built-ins, and aggregates. No session, no msgbus: one overlay built + from a test-helper file and one function call per case." + (:require + [app.common.features :as ffeat] + [app.common.test-helpers.components :as thc] + [app.common.test-helpers.files :as thf] + [app.common.test-helpers.ids-map :as thi] + [app.common.test-helpers.shapes :as ths] + [app.graph.debug :as debug] + [app.graph.overlay :as overlay] + [app.graph.overlay.console :as console] + [clojure.string :as str] + [clojure.test :as t] + [datascript.core :as d])) + +(t/use-fixtures :each thi/test-fixture) + +(defn- fixture-db + "One overlay of a file with one component and one instance of it, plus + enough named shapes that the row-cap test has rows to cap." + [] + (binding [ffeat/*current* #{"components/v2"}] + (let [file (-> (thf/sample-file "console fixture") + (ths/add-sample-shape "main" :type :frame :name "Main") + (ths/add-sample-shape "child-a" :type :rect :name "Child A" + :parent-label "main") + (ths/add-sample-shape "child-b" :type :circle :name "Child B" + :parent-label "main") + (thc/make-component "comp" "main") + (thc/instantiate-component "comp" "copy"))] + (overlay/build (:data file) file)))) + +(defn- thrown-data + "The ex-data of the ExceptionInfo `body` throws, or nil when it does + not throw." + [body] + (try + (body) + nil + (catch clojure.lang.ExceptionInfo e + (ex-data e)))) + +(t/deftest the-gate-rejects-namespace-qualified-functions + (let [data (thrown-data + #(console/run-query + (fixture-db) + "[:find ?v :where [(clojure.core/eval (quote (+ 1 1))) ?v]]"))] + (t/is (some? data) "the gate must throw") + (t/is (= :graph-query-not-read-only (:code data))) + (t/is (str/includes? (:hint data) "clojure.core/eval") + "the error must name the offending symbol"))) + +(t/deftest the-gate-rejects-unknown-bare-symbols + (let [data (thrown-data + #(console/run-query + (fixture-db) + "[:find ?v :where [?e :shape/id ?v] [(slurpish ?v)]]"))] + (t/is (= :graph-query-not-read-only (:code data))) + (t/is (str/includes? (:hint data) "slurpish") + "the error must name the offending symbol"))) + +(t/deftest unreadable-text-is-a-parse-error + (let [data (thrown-data + #(console/run-query (fixture-db) "[:find ?v :where"))] + (t/is (= :graph-query-invalid (:code data))))) + +(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. + (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"] + columns)) + (t/is (pos? row-count)) + (t/is (false? truncated?)) + (t/is (every? (fn [row] + (every? #(re-matches #"\d+" (str %)) (subvec row 3))) + rows) + "the filter columns must carry node eids, rendered as decimal strings"))) + +(t/deftest scalar-and-collection-finds-normalize-to-rows + (let [scalar (console/run-query (fixture-db) + "[:find ?n . :where [?e :shape/name ?n]]") + coll (console/run-query (fixture-db) + "[:find [?n ...] :where [?e :shape/name ?n]]")] + (t/is (= ["n"] (:columns scalar))) + (t/is (= 1 (count (:rows scalar)))) + (t/is (= 1 (count (first (:rows scalar))))) + (t/is (= 1 (count (:columns coll)))) + (t/is (pos? (count (:rows coll)))) + (t/is (every? #(= 1 (count %)) (:rows coll))))) + +(t/deftest the-row-cap-truncates-and-says-so + (let [{:keys [rows truncated? row-count]} + (with-redefs [console/max-rows 3] + (console/run-query (fixture-db) "[:find ?n :where [?e :shape/name ?n]]"))] + (t/is (true? truncated?)) + (t/is (= 3 row-count)) + (t/is (= 3 (count rows))))) + +(t/deftest aggregates-are-allowed + (let [db (fixture-db) + expected (count (d/datoms db :avet :shape/id)) + {:keys [rows]} (console/run-query db + "[:find (count ?s) :where [?s :shape/id _]]")] + (t/is (= [[expected]] rows)))) diff --git a/backend/test/backend_tests/graph_overlay_sync_test.clj b/backend/test/backend_tests/graph_overlay_sync_test.clj new file mode 100644 index 0000000000..c71d50eaff --- /dev/null +++ b/backend/test/backend_tests/graph_overlay_sync_test.clj @@ -0,0 +1,471 @@ +;; This Source Code Form is subject to the terms of the Mozilla Public +;; License, v. 2.0. If a copy of the MPL was not distributed with this +;; file, You can obtain one at http://mozilla.org/MPL/2.0/. +;; +;; Copyright (c) KALEIDOS INC Sucursal en España SL + +(ns backend-tests.graph-overlay-sync-test + "Cold build and incremental sync are two implementations of one mapping, + and this namespace holds them to it. + + `app.graph.overlay/build` projects a whole file into a fresh overlay. + `app.graph.overlay.sync/apply-changes` replays the change vocabulary the + editor emits onto an overlay that is already open. The overlay the second + one maintains must equal the overlay the first one would build from the + changed document, or the console shows a graph no rebuild reproduces. + + The round trip: build the fixture file into A, apply a change list to A + and the same list to the file data, rebuild the result into B, and + compare A against B in an entity-id-independent normal form. + `app.common.files.changes/process-changes` is the document oracle. No + Ladybug, no Postgres, no session: two datascript database values and + pure functions." + (:require + [app.common.features :as ffeat] + [app.common.files.changes :as cp] + [app.common.test-helpers.shapes :as ths] + [app.common.types.file :as ctf] + [app.common.types.library :as ctl] + [app.common.types.tokens-lib :as ctob] + [app.common.uuid :as uuid] + [app.graph.overlay :as overlay] + [app.graph.overlay.sync :as sync] + [clojure.set :as set] + [clojure.test :as t] + [datascript.core :as d])) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; the fixture file +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; Fixed ids: a failure should read the same on every run. +(def ^:private file-id #uuid "00000000-0000-0000-0000-00000000f11e") +(def ^:private page-id #uuid "00000000-0000-0000-0000-0000000000a1") +(def ^:private page2-id #uuid "00000000-0000-0000-0000-0000000000a2") +(def ^:private frame-id #uuid "00000000-0000-0000-0000-0000000000f1") +(def ^:private rect-id #uuid "00000000-0000-0000-0000-0000000000b1") +(def ^:private circ-id #uuid "00000000-0000-0000-0000-0000000000b2") +(def ^:private text-id #uuid "00000000-0000-0000-0000-0000000000b3") +(def ^:private rect2-id #uuid "00000000-0000-0000-0000-0000000000b4") +(def ^:private subchild-id #uuid "00000000-0000-0000-0000-0000000000b5") +(def ^:private p2-shape-id #uuid "00000000-0000-0000-0000-0000000000b6") +(def ^:private comp-root-id #uuid "00000000-0000-0000-0000-0000000000c1") +(def ^:private comp-child-id #uuid "00000000-0000-0000-0000-0000000000c2") +(def ^:private copy-root-id #uuid "00000000-0000-0000-0000-0000000000c3") +(def ^:private copy-child-id #uuid "00000000-0000-0000-0000-0000000000c4") +(def ^:private comp-id #uuid "00000000-0000-0000-0000-0000000000e1") +(def ^:private color-id #uuid "00000000-0000-0000-0000-0000000000d1") +(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") + +(defn- shape + "A valid shape for an `:add-obj` payload, from + `app.common.test-helpers.shapes/sample-shape`: `process-change :add-obj` + hard-validates on the JVM (`app.common.files.changes/validate-shape`), + and hand-rolled maps do not survive it." + [id type & {:as attrs}] + (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." + [] + (binding [ffeat/*current* #{"components/v2"}] + (-> (ctf/make-file-data file-id page-id) + (ctl/add-color {:id color-id :name "Fixture green" + :color "#00FF00" :opacity 1}) + (assoc :tokens-lib + (-> (ctob/make-tokens-lib) + (ctob/add-set + (ctob/make-token-set + :id token-set-id + :name "Brand" + :tokens {"brand.primary" (ctob/make-token + :id token-id + :name "brand.primary" + :type :color + :value "#FF00FF")}))))))) + +(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 + swap slot on a shape inside a copy (`ctk/get-swap-slot`), 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})} + + {:type :add-obj :page-id page-id :id rect-id + :parent-id frame-id :frame-id frame-id + :obj (shape rect-id :rect {:name "Rect" :parent-id frame-id :frame-id frame-id + :width 100 :height 50})} + + {:type :add-obj :page-id page-id :id circ-id + :parent-id frame-id :frame-id frame-id + :obj (shape circ-id :circle {:name "Circle" :parent-id frame-id :frame-id frame-id + :width 40 :height 40})} + + ;; nested inside circ: the subtree :del-obj removes along with it + {:type :add-obj :page-id page-id :id subchild-id + :parent-id circ-id :frame-id frame-id + :obj (shape subchild-id :rect {:name "Sub child" :parent-id circ-id :frame-id frame-id + :width 10 :height 10})} + + {:type :add-obj :page-id page-id :id text-id + :parent-id frame-id :frame-id frame-id + :obj (shape text-id :text {:name "Label" :parent-id frame-id :frame-id frame-id})} + + {:type :add-obj :page-id page-id :id rect2-id + :parent-id frame-id :frame-id frame-id + :obj (shape rect2-id :rect {:name "Rect two" :parent-id frame-id :frame-id frame-id + :width 20 :height 20})} + + ;; a rename, plus two attributes whose values are falsy: `blocked false` + ;; and `opacity 0` are values, not absences, on both paths + {:type :mod-obj :page-id page-id :id rect-id + :operations [{:type :set :attr :name :val "Renamed rect"} + {:type :set :attr :blocked :val false} + {:type :set :attr :opacity :val 0}]} + + ;; a fill carrying a library colour ref: the overlay links it + {:type :mod-obj :page-id page-id :id rect2-id + :operations [{:type :set :attr :fills + :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) + {:type :mod-obj :page-id page-id :id rect2-id + :operations [{:type :set :attr :applied-tokens + :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) + {: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]} + + ;; delete with survivors: circ and its subtree go, the frame's other + ;; children stay + {:type :del-obj :page-id page-id :id circ-id} + + {:type :add-page :id page2-id :name "Page two"} + + {:type :add-obj :page-id page2-id :id p2-shape-id + :parent-id uuid/zero :frame-id uuid/zero + :obj (shape p2-shape-id :rect {:name "Page two shape" :width 50 :height 50})} + + {:type :mod-page :id page-id :name "Page one, renamed"} + + ;; the deleted page carries shapes: the whole container must go + {:type :del-page :id page2-id} + + ;; the main instance: root and child land on the page first, exactly + ;; as the editor's change builder emits them (`pcb/add-component`) + {:type :add-obj :page-id page-id :id comp-root-id + :parent-id uuid/zero :frame-id uuid/zero + :obj (shape comp-root-id :frame {:name "Main" :width 200 :height 200})} + + {:type :add-obj :page-id page-id :id comp-child-id + :parent-id comp-root-id :frame-id comp-root-id + :obj (shape comp-child-id :rect {:name "Main child" :parent-id comp-root-id + :frame-id comp-root-id :width 60 :height 40})} + + {:type :add-component :id comp-id :name "Fixture component" :path "Fixture component" + :main-instance-id comp-root-id :main-instance-page page-id} + + ;; the component membership ops the editor emits next to :add-component + {:type :mod-obj :page-id page-id :id comp-root-id + :operations [{:type :set :attr :component-id :val comp-id} + {:type :set :attr :component-file :val nil} + {:type :set :attr :component-root :val true} + {:type :set :attr :main-instance :val true} + {:type :set :attr :shape-ref :val nil}]} + + {:type :mod-obj :page-id page-id :id comp-child-id + :operations [{:type :set :attr :component-id :val comp-id} + {: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 + {: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-root true})} + + {:type :add-obj :page-id page-id :id copy-child-id + :parent-id copy-root-id :frame-id copy-root-id + :obj (shape copy-child-id :rect {:name "Copy child" :parent-id copy-root-id + :frame-id copy-root-id :width 60 :height 40 + :shape-ref comp-child-id + :component-id comp-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 + :operations [{:type :set-touched :touched #{swap-slot-kw}}]} + + {:type :mod-component :id comp-id :name "Fixture component, renamed"} + + ;; soft delete: the component keeps the main-instance subtree as its + ;; own container copy (`ctf/load-component-objects`), in the rebuilt + ;; overlay and the synced one alike + {:type :del-component :id comp-id} + + {:type :restore-component :id comp-id :page-id page-id} + + {:type :del-component :id comp-id} + + {:type :purge-component :id comp-id}]) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; the normal form +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; Entity ids are datascript internals that depend on insertion order, so +;; a parity check cannot compare them. The normal form keys every entity +;; by what identifies it in the document and replaces every reference +;; value with the target's key; cardinality-many refs become sets of +;; keys. The result is a set of [entity-key attr-map] pairs, and two +;; overlays are equal exactly when their normal forms are `=`. + +(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]`." + [db eid] + (let [ent (d/entity db eid)] + (cond + (some? (:document/id ent)) + [:document (:document/id ent)] + + ;; a component entity may also carry a container role; the + ;; component key wins + (some? (:component/id ent)) + [:component (:component/id ent)] + + (some? (:container/id ent)) + [:container (:container/id ent)] + + (some? (:shape/id ent)) + [:shape (:container/id (:shape/container ent)) (:shape/id ent)] + + (some? (:color/id ent)) + [:color (:color/id ent)] + + (some? (:typography/id ent)) + [:typography (:typography/id ent)] + + (some? (:token-set/id ent)) + [: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)])))) + +(defn- ref-key + [keymap ref] + (when-let [eid (:db/id ref)] + (get keymap eid))) + +(defn- ref-keys + [keymap refs] + (into #{} (map #(ref-key keymap %)) refs)) + +(defn- attr-map + "The indexed attributes of one entity with refs replaced by keys. + Identity attributes carried by the key itself are omitted. Attributes + the entity does not carry appear as nil, so a presence difference + between the two paths shows up instead of hiding." + [keymap ent] + (cond + (some? (:document/id ent)) + {:document/id (:document/id ent) + :document/name (:document/name ent)} + + (some? (:component/id ent)) + {:component/id (:component/id ent) + :component/name (:component/name ent) + :component/deleted (:component/deleted ent) + :component/main-instance-id (:component/main-instance-id ent) + :component/main-instance-page (:component/main-instance-page ent) + :component/document (ref-key keymap (:component/document ent)) + :container/id (:container/id ent) + :container/kind (:container/kind ent) + :container/name (:container/name ent) + :container/document (ref-key keymap (:container/document ent))} + + (some? (:container/id ent)) + {:container/id (:container/id ent) + :container/kind (:container/kind ent) + :container/name (:container/name ent) + :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))} + + (some? (:color/id ent)) + {:color/id (:color/id ent) + :color/name (:color/name ent) + :color/document (ref-key keymap (:color/document ent))} + + (some? (:typography/id ent)) + {:typography/id (:typography/id ent) + :typography/name (:typography/name ent) + :typography/document (ref-key keymap (:typography/document ent))} + + (some? (:token-set/id ent)) + {:token-set/id (:token-set/id ent) + :token-set/name (:token-set/name ent) + :token-set/document (ref-key keymap (:token-set/document ent))} + + (some? (:token/id ent)) + {: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 {})) + +(defn- normal-form + "The overlay as entity-id-independent data: a set of + [entity-key attr-map] pairs." + [db] + (let [keymap (into {} + (map (fn [eid] [eid (entity-key db eid)])) + (distinct (map :e (d/datoms db :eavt))))] + (into #{} (map (fn [[eid key]] [key (attr-map keymap (d/entity db eid))])) + keymap))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; the round trip +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defn- round-trip + "Sync `change-list` into A, rebuild the changed document into B, return + the normal-form difference and the apply-changes report." + [change-list] + (let [data0 (base-data) + data1 (cp/process-changes data0 change-list false) + result (sync/apply-changes (overlay/build data0) change-list) + synced (normal-form (:db result)) + rebuilt (normal-form (overlay/build data1))] + {:diff (set/union (set/difference synced rebuilt) + (set/difference rebuilt synced)) + :applied (:applied result) + :skipped (:skipped result)})) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; the tests +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(t/deftest the-fixture-exercises-every-supported-change-type + (t/is (= sync/supported-change-types (set (map :type changes))))) + +(t/deftest every-change-in-the-list-is-applied + (let [{:keys [applied skipped]} (round-trip changes)] + (t/is (empty? skipped) + (str "the fixture must exercise the sync path, not the skip path: " + (pr-str skipped))) + (t/is (= (map :type changes) applied)))) + +(t/deftest synced-graph-equals-rebuilt-graph + (let [{:keys [diff]} (round-trip changes)] + (t/is (empty? diff) + (str "synced and rebuilt overlays disagree on " (pr-str diff))))) + +(t/deftest every-prefix-stays-in-sync + ;; The end state can agree while a middle state does not (an ordering + ;; bug). Replay every prefix of the list and hold both paths equal at + ;; every step. + (let [data0 (base-data)] + (doseq [n (range (inc (count changes)))] + (let [prefix (subvec changes 0 n) + result (sync/apply-changes (overlay/build data0) prefix) + synced (normal-form (:db result)) + rebuilt (normal-form (overlay/build (cp/process-changes data0 prefix false)))] + (t/is (and (empty? (:skipped result)) + (= synced rebuilt)) + (str "prefix of length " n " diverges; skipped " + (pr-str (:skipped result)))))))) + +(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. + (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))] + (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]) + "the component container must hold the main-instance root copy") + (t/is (contains? keys [:shape comp-id comp-child-id]) + "the component container must hold the main-instance child copy") + (t/is (contains? form + [[:component comp-id] + {:component/id comp-id + :component/name "Fixture component, renamed" + :component/deleted true + :component/main-instance-id comp-root-id + :component/main-instance-page page-id + :component/document [:document file-id] + :container/id comp-id + :container/kind :component + :container/name nil + :container/document [:document file-id]}])))))) + +(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. + (let [data0 (base-data) + data1 (cp/process-changes data0 changes false) + crippled (remove #(and (= :mov-objects (:type %)) + (some #{text-id} (:shapes %))) + changes) + synced (normal-form (:db (sync/apply-changes (overlay/build data0) crippled))) + rebuilt (normal-form (overlay/build data1)) + diff (set/union (set/difference synced rebuilt) + (set/difference rebuilt synced)) + 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"))) diff --git a/backend/test/backend_tests/graph_overlay_test.clj b/backend/test/backend_tests/graph_overlay_test.clj new file mode 100644 index 0000000000..52d333767a --- /dev/null +++ b/backend/test/backend_tests/graph_overlay_test.clj @@ -0,0 +1,699 @@ +;; This Source Code Form is subject to the terms of the Mozilla Public +;; License, v. 2.0. If a copy of the MPL was not distributed with this +;; file, You can obtain one at http://mozilla.org/MPL/2.0/. +;; +;; Copyright (c) KALEIDOS INC Sucursal en España SL + +(ns backend-tests.graph-overlay-test + "The semantic suite of the datascript graph overlay: the beadpot graph + test suite (beadpot:tests/graph/transform) ported from Cypher to + Datalog, one fixture file. + + Every deftest names the beadpot test it ports and the Penpot helper + that is the correctness oracle. A backported assertion that disagrees + with a helper is a beadpot bug: the helper's answer is asserted and the + divergence is noted in the docstring. Beadpot's idempotency tests have + no port here: `app.graph.overlay/build` is a pure function of the + document, so linking twice cannot duplicate an edge by construction. + + The fixture is built exclusively with the common test helpers + (`app.common.test-helpers.*`), so it stays a legal file + (`thf/validate-file!` runs before the overlay is built)." + (:require + [app.common.files.helpers :as cfh] + [app.common.test-helpers.components :as thc] + [app.common.test-helpers.compositions :as tho] + [app.common.test-helpers.files :as thf] + [app.common.test-helpers.ids-map :as thi] + [app.common.test-helpers.shapes :as ths] + [app.common.test-helpers.tokens :as tht] + [app.common.types.component :as ctk] + [app.common.types.components-list :as ctkl] + [app.common.types.container :as ctn] + [app.common.types.shape :as cts] + [app.common.types.text :as txt] + [app.common.types.tokens-lib :as ctob] + [app.common.uuid :as uuid] + [app.graph.overlay :as overlay] + [app.graph.overlay.queries :as queries] + [clojure.test :as t] + [datascript.core :as d])) + +(t/use-fixtures :each thi/test-fixture) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; the fixture file +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defn- sample-fill + "A fill carrying a library color reference." + [color-id] + {:fill-color "#000000" + :fill-opacity 1 + :fill-color-ref-id color-id}) + +(defn- sample-stroke + "A stroke carrying a library color reference." + [color-id] + {:stroke-style :solid + :stroke-alignment :inner + :stroke-width 1 + :stroke-color "#000000" + :stroke-opacity 1 + :stroke-color-ref-id color-id}) + +(defn- refs-content + "Text content whose text nodes carry `:typography-ref-id` and, when + `color-id` is given, a fill referencing it. Only text nodes are touched: + the content schema forbids these attributes on the root and + paragraph-set nodes." + [text typography-id color-id] + (let [content (txt/change-text nil text)] + (txt/transform-nodes + txt/is-text-node? + (fn [node] + (cond-> (assoc node :typography-ref-id typography-id) + (some? color-id) + (assoc :fills [(sample-fill color-id)]))) + content))) + +(defn- refs-text-shape + "A text shape whose content nodes carry the given references." + [typography-id color-id] + (-> (cts/setup-shape {:type :text :x 0 :y 0}) + (assoc :content (refs-content "Typography sample" typography-id color-id) + :position-data nil))) + +(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)))) + +(defn- semantic-fixture + "One rich file exercising every indexed attribute: + + - page 1 holds a board with three children, two text shapes whose + content nodes reference a typography (one of them an undefined id), + and a rect referencing an undefined colour; + - :comp-1 (frame, child, grandchild) has a copy with labelled children; + - :comp-2 is deleted through a raw :del-component change, so its record + keeps the main-instance subtree in its own :objects; + - :comp-a/:comp-b/:comp-c model a variant swap: the copy of :comp-c + carries a nested instance of :comp-a which is swapped for :comp-b, + seeding the swapped-in head with a swap slot; + - two token sets hold four tokens; three are applied to shapes, one of + them under two attributes, and one applied name the lib never defines; + - page 2 holds one rect referencing a library colour. + + Returns {:file file :data data :db db}." + [] + ;; Asset ids that are labelled but never added to the library: references + ;; to them must produce no edge. + (thi/new-id! :color-ghost) + (thi/new-id! :typo-ghost) + + (let [file (-> (thf/sample-file :semantic-file :page-label :main-page) + (ths/add-sample-library-color :color-fill :name "Fill red" :color "#ff0000") + (ths/add-sample-library-color :color-stroke :name "Stroke blue" :color "#0000ff") + (ths/add-sample-library-color :color-unused :name "Unused green" :color "#00ff00") + (ths/add-sample-typography :typo-main :name "Main typography") + (ths/add-sample-typography :typo-unused :name "Unused typography") + (tho/add-frame :board :name "Board") + (ths/add-sample-shape :board-rect {:type :rect + :name "Board rect" + :parent-label :board + :fills [(sample-fill (thi/id :color-fill))] + :strokes [(sample-stroke (thi/id :color-stroke))]}) + (ths/add-sample-shape :board-circle {:type :circle + :name "Board circle" + :parent-label :board + :fills [(sample-fill (thi/id :color-ghost))]}) + (tho/add-text :board-text "Board label" :text-params {:parent-label :board}) + (ths/add-sample-shape :typo-text (refs-text-shape (thi/id :typo-main) (thi/id :color-fill))) + (ths/add-sample-shape :ghost-typo-text (refs-text-shape (thi/id :typo-ghost) nil)) + (ths/add-sample-shape :ghost-rect {:type :rect + :name "Ghost rect" + :fills [(sample-fill (thi/id :color-ghost))]}) + (tho/add-frame :comp-1-root :name "C1 root") + (ths/add-sample-shape :comp-1-child {:type :rect + :name "C1 child" + :parent-label :comp-1-root}) + (ths/add-sample-shape :comp-1-grandchild {:type :circle + :name "C1 grandchild" + :parent-label :comp-1-child}) + (thc/make-component :comp-1 :comp-1-root) + (thc/instantiate-component :comp-1 :comp-1-copy + :children-labels [:comp-1-copy-child :comp-1-copy-grandchild]) + (tho/add-frame :comp-2-root :name "C2 root") + (ths/add-sample-shape :comp-2-child {:type :rect + :name "C2 child" + :parent-label :comp-2-root}) + (thc/make-component :comp-2 :comp-2-root))] + + (let [file (thf/apply-changes file {:redo-changes [{:type :del-component + :id (thi/id :comp-2)}]}) + file (-> file + (tho/add-frame :comp-a-root :name "CA root") + (thc/make-component :comp-a :comp-a-root) + (tho/add-frame :comp-b-root :name "CB root") + (thc/make-component :comp-b :comp-b-root) + (tho/add-frame :comp-c-root :name "CC root") + (thc/instantiate-component :comp-a :nested-a :parent-label :comp-c-root) + (thc/make-component :comp-c :comp-c-root) + (thc/instantiate-component :comp-c :comp-c-copy :children-labels [:nested-a-copy]) + (thc/component-swap :nested-a-copy :comp-b :swapped-b)) + + file (-> file + (tht/add-tokens-lib) + (tht/update-tokens-lib + (fn [lib] + (-> lib + (ctob/add-set (ctob/make-token-set :id (thi/new-id! :token-set-a) + :name "core")) + (ctob/add-set (ctob/make-token-set :id (thi/new-id! :token-set-b) + :name "layout")) + (ctob/add-token (thi/id :token-set-a) + (ctob/make-token :id (thi/new-id! :token-color-fill) + :name "color.fill" + :type :color + :value "#112233")) + (ctob/add-token (thi/id :token-set-a) + (ctob/make-token :id (thi/new-id! :token-color-stroke) + :name "color.stroke" + :type :color + :value "#445566")) + (ctob/add-token (thi/id :token-set-b) + (ctob/make-token :id (thi/new-id! :token-size) + :name "size.dim" + :type :dimensions + :value 100)) + (ctob/add-token (thi/id :token-set-b) + (ctob/make-token :id (thi/new-id! :token-spacing) + :name "spacing.gap" + :type :spacing + :value 8)))))) + + file (-> file + ;; one token applied under two attributes: two uses + (tht/apply-token-to-shape :board-rect "size.dim" [:width :height] [:width :height] 100) + ;; one token applied by two shapes: two uses + (tht/apply-token-to-shape :board-rect "color.fill" [:fill] [:fill] "#112233") + (tht/apply-token-to-shape :board-circle "color.fill" [:fill] [:fill] "#112233") + ;; an applied name the lib never defines: no use + (tht/apply-token-to-shape :ghost-rect "ghost.token" [:fill] [:fill] "#000000")) + + file (-> file + (thf/add-sample-page :second-page :name "Second page") + (ths/add-sample-shape :page2-rect {:type :rect + :name "P2 rect" + :fills [(sample-fill (thi/id :color-fill))]}))] + + (thf/validate-file! file) + {:file file + :data (:data file) + :db (overlay/build (:data file) file)}))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; components +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(t/deftest component-inventory-matches-the-component-record-map + ;; beadpot:tests/graph/transform/test_components.py::test_component_nodes_created + ;; Oracle: the `:components` map of the data, and `ctkl/get-component` + ;; include-deleted behaviour. The overlay indexes every record, deleted + ;; ones included; the Ladybug projection drops deleted components, so the + ;; two counts diverge on this fixture by design. + (let [{:keys [data db]} (semantic-fixture) + records (:components data) + deleted-id (thi/id :comp-2) + deleted (ctkl/get-component data deleted-id true)] + + (t/is (= (count records) (:components (queries/stats db)))) + (t/is (= (count (ctkl/components-seq data)) + (- (:components (queries/stats db)) + (count (ctkl/deleted-components-seq data))))) + + ;; the deleted record is an entity flagged :component/deleted + (t/is (true? (:deleted deleted))) + (t/is (true? (:component/deleted (d/entity db (d/entid db [:component/id deleted-id]))))) + + ;; the oracle: include-deleted? controls visibility; the overlay keeps it + (t/is (nil? (ctkl/get-component data deleted-id))) + (t/is (some? (ctkl/get-component data deleted-id true))) + + ;; the :del-component change snapshotted the main-instance subtree into + ;; the record's own :objects, so the overlay has a component container + ;; over that copy + (t/is (seq (:objects deleted))) + (let [container-eid (queries/container-eid db deleted-id) + snapshot-ids (d/q '[:find [?s ...] + :in $ ?id + :where + [?s :shape/container ?c] + [?c :container/id ?id]] + db deleted-id)] + (t/is (= :component (:container/kind (d/entity db container-eid)))) + (t/is (= (count (:objects deleted)) (count snapshot-ids))) + (doseq [sid (keys (:objects deleted))] + (t/is (some? (queries/shape-eid db container-eid sid)) + (str "snapshot shape " sid)))) + + ;; 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} + (dissoc (queries/stats db) :datoms))))) + +(t/deftest components-are-children-of-the-document + ;; beadpot:tests/graph/transform/test_components.py::test_component_nodes_are_children_of_document + ;; Oracle: the document entity of the overlay. Every component record, + ;; deleted ones included, is a child of the one document entity. + (let [{:keys [data db]} (semantic-fixture) + doc-eid (d/entid db [:document/id (:id data)]) + attached (d/q '[:find ?c ?d + :where + [?c :component/document ?d]] + db)] + (t/is (= (count (:components data)) (count attached))) + (t/is (every? #(= doc-eid (second %)) attached)))) + +(t/deftest refers-to-pairs-match-shape-refs + ;; 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. + (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))] + + ;; 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)))) + + ;; 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 + ;; 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. + (let [{:keys [data db]} (semantic-fixture) + live-comps (ctkl/components-seq data) + rule-pairs (set (d/q '[:find ?cid ?sid + :in $ % + :where + (on-page ?s) + (is-instance-of ?s ?c) + [?c :component/id ?cid] + [?s :shape/id ?sid]] + db queries/rules)) + expected (set (for [component live-comps + [pid page] (:pages-index data) + [sid shape] (:objects page) + :when (ctk/instance-of? shape (:id data) (:id component))] + [(:id component) sid])) + deleted-id (thi/id :comp-2)] + + (t/is (= expected rule-pairs)) + (t/is (= 8 (count rule-pairs))) + + ;; no link to the deleted component + (t/is (empty? (d/q '[:find [?sid ...] + :in $ % ?cid + :where + (is-instance-of ?s ?c) + [?c :component/id ?cid] + [?s :shape/id ?sid]] + db queries/rules deleted-id))) + + ;; but its orphaned main root still passes the raw predicate + (let [main-root (get-in data [:pages-index (thi/id :main-page) + :objects (thi/id :comp-2-root)])] + (t/is (some? main-root)) + (t/is (ctk/instance-of? main-root (:id data) deleted-id))))) + +(t/deftest main-instance-frames-are-among-the-linked-heads + ;; beadpot:tests/graph/transform/test_components.py::test_main_instances_are_linked + ;; Oracle: the component records' :main-instance-page/:main-instance-id. + ;; One main instance per live component, and each of those frames is an + ;; instance head linked through `queries/instances-of`. + (let [{:keys [data db]} (semantic-fixture) + triples (queries/component-main-instances db) + live (ctkl/components-seq data)] + + (t/is (= (set (map :id (filter #(and (:main-instance-id %) + (:main-instance-page %)) + live))) + (set (map first triples)))) + (t/is (= (count live) (count triples))) + (doseq [[cid pid mid] triples] + (t/is (contains? (set (queries/instances-of db cid (:id data))) + [pid mid]))))) + +(t/deftest parent-heads-match-the-container-walk + ;; No beadpot counterpart: this is the overlay's own pin that its parent + ;; topology equals the document's. Oracle: `ctn/get-parent-heads` over the + ;; page objects, order included (top-down), for every shape on every page. + (let [{:keys [data db]} (semantic-fixture)] + (doseq [[pid page] (:pages-index data) + [sid shape] (:objects page)] + (let [expected (mapv :id (ctn/get-parent-heads (:objects page) shape)) + actual (queries/parent-heads db pid sid)] + (t/is (= expected actual) + (str "parent heads of " sid)))) + + ;; a copy's descendant: the copy root is its only head + (t/is (= [(thi/id :comp-1-copy)] + (queries/parent-heads db (thi/id :main-page) + (thi/id :comp-1-copy-grandchild)))) + + ;; a nested instance: two heads, outer first + (t/is (= [(thi/id :comp-c-root) (thi/id :nested-a)] + (queries/parent-heads db (thi/id :main-page) (thi/id :nested-a)))))) + +(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. + (let [{:keys [data db]} (semantic-fixture)] + (doseq [component (vals (:components 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))))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; descendants and identity +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(t/deftest descendants-and-shape-identity-match-the-document + ;; beadpot:tests/graph/transform/test_denormalization.py, the page_id and + ;; component_id denormalization suite, mapped onto the overlay's identity + ;; claim: shape ids are not unique, the (container, shape) pair is, so + ;; every page object, the uuid/zero root frame of every page included, + ;; 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?`. + ;; Oracle: `cfh/get-children-ids` and `ctk/instance-head?`. + (let [{:keys [data db]} (semantic-fixture) + page1-id (thi/id :main-page) + page1 (get-in data [:pages-index page1-id]) + board-id (thi/id :board) + objects (:objects page1)] + + ;; descendants: the overlay formulation of cfh/get-children-ids + (t/is (= (set (cfh/get-children-ids objects board-id)) + (queries/descendant-ids db page1-id board-id))) + (t/is (= (set (filter #(= :rect (:type (get objects %))) + (cfh/get-children-ids objects board-id))) + (queries/descendant-ids-of-type db page1-id board-id :rect))) + (t/is (= (set (filter #(= :text (:type (get objects %))) + (cfh/get-children-ids objects board-id))) + (queries/descendant-ids-of-type db page1-id board-id :text))) + (t/is (= #{} (queries/descendant-ids db page1-id (thi/id :board-rect)))) + + ;; identity: every object of every page resolves, uuid/zero included + (doseq [[pid page] (:pages-index data) + [sid _shape] (:objects page)] + (let [container-eid (queries/container-eid db pid) + shape-eid (queries/shape-eid db container-eid sid)] + (t/is (some? shape-eid) + (str "shape " sid " of page " pid)))) + + ;; uuid/zero keys the root frame of every page: two distinct entities + (let [p1-root (queries/shape-eid db (queries/container-eid db page1-id) + uuid/zero) + p2-root (queries/shape-eid db (queries/container-eid db (thi/id :second-page)) + uuid/zero)] + (t/is (some? p1-root)) + (t/is (some? p2-root)) + (t/is (not= p1-root p2-root)) + (t/is (= 2 (count (queries/shape-eids db uuid/zero))))) + + ;; no downward denormalization: the overlay stores component-id iff the + ;; helper sees a head + (doseq [[pid page] (:pages-index data) + [sid shape] (:objects page)] + (let [entity (d/entity db (queries/shape-eid db (queries/container-eid db pid) + sid))] + (t/is (= (boolean (ctk/instance-head? shape)) + (boolean (some? (:shape/component-id entity)))) + (str "component-id denormalization on " sid)) + (when (:component-id shape) + (t/is (= (:component-id shape) (:shape/component-id entity)))))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; swap slots +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(t/deftest fills-swap-slot-matches-swap-slot-entries + ;; beadpot:tests/graph/transform/test_variants.py::test_fills_swap_slot_count_matches_fixture + ;; and ::test_fills_swap_slot_id_matches_touched_entry + ;; Oracle: `ctk/get-swap-slot` over the document. The swapped-in nested + ;; copy root carries the replaced shape's id as its swap slot; the overlay + ;; surfaces exactly one FillsSwapSlot per document swap-slot entry whose + ;; target resolves. beadpot's test_swap_slot_entries_stripped_from_touched + ;; is vacuous here: the overlay never stores :touched, so there is nothing + ;; to strip. + (let [{:keys [data db]} (semantic-fixture) + pairs (d/q '[:find ?sid ?sslot ?tid + :in $ % + :where + (on-page ?s) + (fills-swap-slot ?s ?t) + (on-page ?t) + [?s :shape/id ?sid] + [?s :shape/swap-slot ?sslot] + [?t :shape/id ?tid]] + db queries/rules) + slots (for [[_cid objects] (document-containers data) + shape (vals objects) + :let [slot (ctk/get-swap-slot shape)] + :when (some? slot)] + [(:id shape) slot])] + + ;; the count matches the swap-slot entries the helper finds + (t/is (= (count slots) (count pairs))) + + ;; one swapped-in head, one slot, one edge + (t/is (= 1 (count pairs))) + + (doseq [[sid sslot tid] pairs] + ;; the slot names the replaced shape: source and target differ, and + ;; the target is a shape on a page + (t/is (= sslot tid)) + (t/is (not= sid tid)) + (t/is (= (thi/id :swapped-b) sid)) + (t/is (= (thi/id :nested-a) tid))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; tokens +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(t/deftest token-inventory-matches-the-tokens-lib + ;; beadpot:tests/graph/transform/test_tokens.py::test_graph_round_trip_preserves_token_inventory + ;; and ::test_graph_all_tokens_present + ;; Oracle: the tokens lib itself. The overlay stores identity, type and + ;; set membership; values and themes stay in the lib. + (let [{:keys [data db]} (semantic-fixture) + lib (:tokens-lib data) + tokens (ctob/get-all-tokens lib) + graph-names (set (d/q '[:find [?n ...] + :where + [?t :token/name ?n]] + db)) + graph-types (into {} (d/q '[:find ?type (count ?t) + :where + [?t :token/type ?type]] + db))] + + (t/is (= (set (map :name tokens)) graph-names)) + (t/is (= (frequencies (map :type tokens)) graph-types)) + (t/is (= (count (ctob/get-sets lib)) (:token-sets (queries/stats db)))) + (t/is (= 4 (:tokens (queries/stats db)))) + + ;; token -> set membership, per the lib's own getters + (doseq [set* (ctob/get-sets lib) + token (vals (ctob/get-tokens- set*))] + (let [set-eid (d/entid db [:token-set/id (ctob/get-id set*)]) + tok-eid (d/entid db [:token/id (:id token)])] + (t/is (some? tok-eid)) + (t/is (= set-eid (:db/id (:token/set (d/entity db tok-eid)))) + (str "set of token " (:name token))) + (t/is (= (ctob/get-name set*) + (:token-set/name (d/entity db set-eid)))))))) + +(t/deftest applied-tokens-produce-exactly-the-resolvable-uses + ;; beadpot:tests/graph/transform/test_tokens.py::test_link_applied_tokens_creates_exact_edge_set + ;; 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. + (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) + shape (vals objects) + [prop name] (:applied-tokens shape) + :when (contains? lib-names name)] + [cid (:id shape) prop])) + actual (set (mapcat #(queries/shapes-using-token db %) lib-names))] + + (t/is (= expected actual)) + (t/is (= 4 (:token-uses (queries/stats db)))) + + ;; a token applied by two shapes has two uses + (let [shared (queries/shapes-using-token db "color.fill")] + (t/is (= #{(thi/id :board-rect) (thi/id :board-circle)} + (set (map second shared))))) + + ;; one shape applying one token under two attributes yields two triples + (let [two-attrs (queries/shapes-using-token db "size.dim")] + (t/is (= 2 (count two-attrs))) + (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"))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; colors and typographies +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(t/deftest used-colors-and-typographies-match-the-raw-refs + ;; beadpot's LinkUsedColors and LinkUsedTypographies transforms, verified + ;; against the raw shape maps. Oracle: the shapes whose fills, strokes, or + ;; text-content fills carry the color's ref id, and the shapes whose text + ;; content carries the typography's ref id, read straight off the maps. + ;; Unresolvable refs (id not in the library) produce no edge, mirroring + ;; beadpot's node_exists guard. + (let [{:keys [data db]} (semantic-fixture) + containers (document-containers data) + fill-refs (fn [fills] (into #{} (keep :fill-color-ref-id) fills)) + stroke-refs (fn [strokes] (into #{} (keep :stroke-color-ref-id) strokes)) + node-fill-refs (fn [content] + (into #{} (comp (mapcat :fills) (keep :fill-color-ref-id)) + (txt/node-seq content))) + node-typo-refs (fn [content] + (into #{} (keep :typography-ref-id) (txt/node-seq content))) + color-users (fn [color-id] + (set (for [[cid objects] containers + shape (vals objects) + :when (or (contains? (fill-refs (:fills shape)) color-id) + (contains? (stroke-refs (:strokes shape)) color-id) + (contains? (node-fill-refs (:content shape)) color-id))] + [cid (:id shape)]))) + typo-users (fn [typo-id] + (set (for [[cid objects] containers + shape (vals objects) + :when (contains? (node-typo-refs (:content shape)) typo-id)] + [cid (:id shape)])))] + + (doseq [color-id (keys (:colors data))] + (t/is (= (color-users color-id) + (set (queries/shapes-using-color db color-id))) + (str "users of color " color-id))) + + (doseq [typo-id (keys (:typographies data))] + (t/is (= (typo-users typo-id) + (set (queries/shapes-using-typography db typo-id))) + (str "users of typography " typo-id))) + + ;; pinned membership: fill, text-content fill, and cross-page use + (t/is (= #{[(thi/id :main-page) (thi/id :board-rect)] + [(thi/id :main-page) (thi/id :typo-text)] + [(thi/id :second-page) (thi/id :page2-rect)]} + (set (queries/shapes-using-color db (thi/id :color-fill))))) + (t/is (= #{[(thi/id :main-page) (thi/id :board-rect)]} + (set (queries/shapes-using-color db (thi/id :color-stroke))))) + (t/is (= #{[(thi/id :main-page) (thi/id :typo-text)]} + (set (queries/shapes-using-typography db (thi/id :typo-main))))) + (t/is (empty? (queries/shapes-using-typography db (thi/id :typo-unused)))) + + ;; unresolvable refs produce no edge + (t/is (empty? (queries/shapes-using-color db (thi/id :color-ghost)))) + (t/is (empty? (queries/shapes-using-typography db (thi/id :typo-ghost)))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; parity counting +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(t/deftest ladybug-parity-counts-pin-the-fixture + ;; Hand-computed expectations under the Ladybug projection's conventions, + ;; 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. + (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)) + live-head? (fn [shape] + (some (fn [component] + (ctk/instance-of? shape (:id data) (:id component))) + live-comps)) + derived {:is-child-of (+ (count page-shapes) + (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)) + :fills-swap-slot (count (filter #(let [slot (ctk/get-swap-slot %)] + (and slot (on-page? slot))) + page-shapes))}] + + (t/is (= derived (queries/ladybug-parity-counts db))) + (t/is (= {:is-child-of 28 + :is-instance-of 8 + :refers-to 6 + :fills-swap-slot 1} + (queries/ladybug-parity-counts db)))))