mirror of
https://github.com/penpot/penpot.git
synced 2026-11-12 13:00:37 +00:00
a41feaaa19
The three test namespaces still carried graph-overlay in their names and files. They are backend-tests.relation-overlay-test, -sync-test, and -console-test now, so the branch carries no old holder name outside dated records and the storage literal. AI-assisted-by: glm-5.3-flash Signed-off-by: Álvaro Tejero Cantero <alvorithm@teje.ro>
946 lines
47 KiB
Clojure
946 lines
47 KiB
Clojure
;; 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.relation-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.relation-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.file :as ctf]
|
|
[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.relation-overlay :as overlay]
|
|
[app.graph.relation-overlay.queries :as queries]
|
|
[clojure.test :as t]
|
|
[datascript.built-ins :as bi]
|
|
[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- oracle-containers
|
|
"The builder's resolution containers, one per page plus one per
|
|
component that carries its own `:objects` snapshot, as [ctn-container
|
|
container-id] pairs (`app.graph.relation-overlay/ref-resolver`)."
|
|
[data]
|
|
(concat (map (fn [[id page]] [(ctn/make-container page :page) id])
|
|
(:pages-index data))
|
|
(keep (fn [[cid component]]
|
|
(when (seq (:objects component))
|
|
[(ctn/make-container component :component) cid]))
|
|
(:components data))))
|
|
|
|
(defn- document-containers
|
|
"Every [container-id objects] pair the overlay indexes: the pages, plus
|
|
the `:objects` snapshot a deleted component carries
|
|
(`app.common.types.file/load-component-objects`)."
|
|
[data]
|
|
(map (fn [[container cid]] [cid (:objects container)])
|
|
(oracle-containers data)))
|
|
|
|
(defn- oracle-refs
|
|
"`ctf/find-ref-shape`'s answer for every copy shape, as
|
|
[src-container src-id tgt-container tgt-id]: the oracle behind the
|
|
builder-resolved `:shape/refers-to` (`:include-deleted? true`,
|
|
`:with-context? true`)."
|
|
[data]
|
|
(let [file {:id (:id data) :data data}]
|
|
(into #{}
|
|
(for [[container cid] (oracle-containers data)
|
|
shape (vals (:objects container))
|
|
:when (:shape-ref shape)
|
|
:let [ref (ctf/find-ref-shape file container {} shape
|
|
:include-deleted? true
|
|
:with-context? true)]
|
|
:when (some? ref)]
|
|
[cid (:id shape)
|
|
(:id (:container (meta ref)))
|
|
(:id ref)]))))
|
|
|
|
(defn- semantic-fixture
|
|
"One rich file exercising every indexed attribute:
|
|
|
|
- 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; 5 folded token applications (the 4 resolvable uses
|
|
;; plus the ghost name, which the encoding stores); 6 copy shapes
|
|
;; carrying a shape-ref, all 6 resolved by the builder
|
|
(t/is (= {:documents 1
|
|
:containers 3
|
|
:shapes 26
|
|
:components 5
|
|
:colors 3
|
|
:typographies 2
|
|
:token-sets 2
|
|
:tokens 4
|
|
:token-uses 5
|
|
:refs-resolved 6
|
|
:refs-carried 6}
|
|
(dissoc (queries/stats db) :datoms)))))
|
|
|
|
(t/deftest components-are-children-of-the-document
|
|
;; 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-find-ref-shape
|
|
;; beadpot:tests/graph/transform/test_components.py::test_refers_to_edges_match_shape_refs
|
|
;; One RefersTo per copy shape the helper resolves, each pointing at the
|
|
;; shape `ctf/find-ref-shape` names. Oracle: `ctf/find-ref-shape` with
|
|
;; `:include-deleted? true` and `:with-context? true`, per copy shape,
|
|
;; per container. The builder-resolution retrofit replaced the id-join
|
|
;; encoding (`:shape/shape-ref` joined on `:shape/id`) with the helper's
|
|
;; answer materialised at build time; the consumer texts (`queries/refers-to-pairs`
|
|
;; and the `refers-to` rule) did not move.
|
|
(let [{:keys [data db]} (semantic-fixture)
|
|
pairs (set (queries/refers-to-pairs db))]
|
|
|
|
;; every pair is the helper's answer: target container and id from
|
|
;; the context the helper attaches
|
|
(t/is (= (oracle-refs data) pairs))
|
|
|
|
;; all six copy shapes on the fixture resolve
|
|
(t/is (= 6 (count pairs)))))
|
|
|
|
(t/deftest instance-heads-link-only-to-live-components
|
|
;; beadpot:tests/graph/transform/test_components.py::test_all_instance_heads_linked_to_their_component
|
|
;; Oracle: `ctk/instance-of?`. The `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)
|
|
(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
|
|
(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 standing
|
|
;; query traverses the `instance-of` rule, whose live-component guard
|
|
;; is the rule's business, so the scan runs over the live component
|
|
;; records only; the deleted component's orphaned main root is pinned
|
|
;; below to answer nothing.
|
|
(let [{:keys [data db]} (semantic-fixture)]
|
|
(doseq [component (ctkl/components-seq data)]
|
|
(let [expected (set (for [[pid page] (:pages-index data)
|
|
[sid shape] (:objects page)
|
|
:when (ctk/instance-of? shape (:id data) (:id component))]
|
|
[pid sid]))]
|
|
(t/is (= expected (set (queries/instances-of db (:id component) (:id data))))
|
|
(str "instances of " (:name component)))))
|
|
|
|
;; the deleted component: the rule's live guard answers nothing,
|
|
;; while the raw predicate still sees the orphaned main root
|
|
(let [deleted-id (thi/id :comp-2)]
|
|
(t/is (empty? (queries/instances-of db deleted-id (:id data))))
|
|
(let [main-root (get-in data [:pages-index (thi/id :main-page)
|
|
:objects (thi/id :comp-2-root)])]
|
|
(t/is (ctk/instance-of? main-root (:id data) deleted-id))))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; descendants and identity
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(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 `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))))))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Euler-tour numbering
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(t/deftest euler-intervals-equal-the-walk-and-are-globally-disjoint-or-nested
|
|
;; No beadpot counterpart. The Euler-tour retrofit's two invariants:
|
|
;; (1) the interval form answers the recursive form, and both equal
|
|
;; `cfh/get-children-ids` (the oracle) for every frame of every
|
|
;; container; (2) one global counter numbers every container
|
|
;; (`app.graph.relation-overlay/euler-numbering` threads it file-wide), so
|
|
;; [enter exit] intervals across the whole file are pairwise
|
|
;; disjoint-or-nested — a partial overlap is the signature of the
|
|
;; per-container-counter bug the 20260820 report guards against.
|
|
(let [{:keys [data db]} (semantic-fixture)]
|
|
(doseq [[cid objects] (document-containers data)
|
|
shape (vals objects)
|
|
:when (= :frame (:type shape))]
|
|
(let [sid (:id shape)
|
|
expected (set (cfh/get-children-ids objects sid))]
|
|
(t/is (= expected (queries/descendant-ids db cid sid))
|
|
(str "interval descendants of " sid))
|
|
(t/is (= expected (queries/descendant-ids-walk db cid sid))
|
|
(str "walk descendants of " sid))))
|
|
|
|
;; the global-counter claim: every [enter exit] pair across all
|
|
;; containers is disjoint or properly nested, never partially
|
|
;; overlapping
|
|
(let [enters (into {} (map (juxt :e :v)) (d/datoms db :avet :shape/enter))
|
|
exits (into {} (map (juxt :e :v)) (d/datoms db :avet :shape/exit))
|
|
intervals (mapv (fn [[eid enter]] [enter (get exits eid)]) enters)
|
|
ok? (fn [[e0 e1] [f0 f1]]
|
|
(or (<= e1 f0) (<= f1 e0)
|
|
(and (< e0 f0) (< f1 e1))
|
|
(and (< f0 e0) (< e1 f1))))]
|
|
(doseq [i (range (count intervals))
|
|
j (range (inc i) (count intervals))]
|
|
(t/is (ok? (nth intervals i) (nth intervals j))
|
|
(str "intervals " (pr-str (nth intervals i)) " and "
|
|
(pr-str (nth intervals j)) " partially overlap"))))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; swap slots
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(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 consumer texts are unchanged; underneath,
|
|
;; the token-use entities are gone and the `uses-token` rule reads the
|
|
;; folded token attributes instead. beadpot's enum-key parsing test is a
|
|
;; document-format concern that Clojure keywords make moot.
|
|
(let [{:keys [data db]} (semantic-fixture)
|
|
lib-names (into #{} (map :name) (ctob/get-all-tokens (:tokens-lib data)))
|
|
expected (set (for [[cid objects] (document-containers data)
|
|
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))
|
|
|
|
;; 5 folded applications on the fixture: the 4 resolvable uses the
|
|
;; rule surfaces, plus the ghost name the encoding still stores
|
|
(t/is (= 5 (:token-uses (queries/stats db))))
|
|
|
|
;; a token applied by two shapes has two uses
|
|
(let [shared (queries/shapes-using-token db "color.fill")]
|
|
(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")))
|
|
|
|
;; ...but the folded encoding stores it: the datom is present, the
|
|
;; rule hides it (its join on :token/name finds no entity)
|
|
(let [ghost-eid (queries/shape-eid db (queries/container-eid db (thi/id :main-page))
|
|
(thi/id :ghost-rect))]
|
|
(t/is (= "ghost.token" (:token/fill (d/entity db ghost-eid))))
|
|
(t/is (= [[:token/fill "ghost.token"]]
|
|
(map (juxt :a :v) (d/datoms db :eavt ghost-eid :token/fill)))))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; colors and typographies
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(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))))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; the R1 invariance pin
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(def ^:private control-symbols
|
|
"Clause heads that structure a query rather than call a function, the
|
|
console gate's own list (`app.graph.relation-overlay.console`)."
|
|
'#{not not-join or or-join and pull})
|
|
|
|
(def ^:private rule-names
|
|
(into #{} (map (comp first first)) queries/rules))
|
|
|
|
(def ^:private allowed-query-symbols
|
|
"The closed call vocabulary: the shared rules, datascript's built-in
|
|
query fns and aggregates, and the control forms — exactly the set the
|
|
console gate admits."
|
|
(-> #{}
|
|
(into (keys bi/query-fns))
|
|
(into (keys bi/aggregates))
|
|
(into control-symbols)
|
|
(into rule-names)))
|
|
|
|
(defn- query-call-symbols
|
|
"Every symbol in call position: heads of list clauses (rule
|
|
invocations, predicates, control forms). Mirrors the console gate's
|
|
walk over the query form."
|
|
[form]
|
|
(cond
|
|
(seq? form)
|
|
(into (if (symbol? (first form)) [(first form)] [])
|
|
(mapcat query-call-symbols)
|
|
(rest form))
|
|
|
|
(coll? form)
|
|
(into [] (mapcat query-call-symbols) form)
|
|
|
|
:else []))
|
|
|
|
(t/deftest consumer-query-texts-invoke-only-shared-rules
|
|
;; The R1 invariance claim. The 20260820 report verified the same
|
|
;; consumer query texts across the pre-retrofit and post-retrofit
|
|
;; encodings (docs.local/graph/20260820-report-graph-overlay-datascript.md);
|
|
;; this test holds two of them — instances inside a subtree, shapes
|
|
;; using a token — written once, runs them against the current
|
|
;; encoding, and pins that their call positions name only shared rules
|
|
;; and datascript built-ins. A text that cannot see an encoding cannot
|
|
;; break when the encoding changes.
|
|
(let [{:keys [data db]} (semantic-fixture)
|
|
lib-names (into #{} (map :name) (ctob/get-all-tokens (:tokens-lib data)))
|
|
instances-in-subtree
|
|
'[:find ?pid ?id
|
|
:in $ % ?cid ?sid
|
|
:where
|
|
[?c :container/id ?cid]
|
|
[?s :shape/container ?c]
|
|
[?s :shape/id ?sid]
|
|
(descendant-of ?i ?s)
|
|
(instance-of ?i ?comp)
|
|
[?i :shape/container ?pc]
|
|
[?pc :container/id ?pid]
|
|
[?i :shape/id ?id]]
|
|
shapes-using-token
|
|
'[:find ?cid ?id
|
|
:in $ % ?name
|
|
:where
|
|
[?tok :token/name ?name]
|
|
(uses-token ?s ?tok ?a)
|
|
[?s :shape/container ?c]
|
|
[?c :container/id ?cid]
|
|
[?s :shape/id ?id]]]
|
|
|
|
;; the texts answer on the current encoding: instances inside
|
|
;; comp-c's root are exactly the nested comp-a head
|
|
(t/is (= #{[(thi/id :main-page) (thi/id :nested-a)]}
|
|
(set (d/q instances-in-subtree db queries/rules
|
|
(thi/id :main-page) (thi/id :comp-c-root)))))
|
|
|
|
;; and every token text's answer equals the standing fn's
|
|
(doseq [name lib-names]
|
|
(t/is (= (set (map #(subvec % 0 2) (queries/shapes-using-token db name)))
|
|
(set (d/q shapes-using-token db queries/rules name)))
|
|
(str "token query text on " name)))
|
|
|
|
;; the texts only reference rule names: every list-clause head is a
|
|
;; shared rule or a datascript built-in, nothing else
|
|
(doseq [q [instances-in-subtree shapes-using-token]]
|
|
(doseq [sym (query-call-symbols q)]
|
|
(t/is (contains? allowed-query-symbols sym)
|
|
(str "call symbol " sym " in " (pr-str q)))))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; parity counting
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(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; 1 on-page swap slot. `:refers-to` now counts the
|
|
;; builder-resolved page->page references (the `refers-to` rule scoped
|
|
;; to page shapes on both sides), not id-join pairs: the derivation
|
|
;; below reads `ctf/find-ref-shape`'s answer per copy shape and keeps
|
|
;; the page->page ones. On this fixture every copy resolves to a live
|
|
;; main on a page, so the count is still 6 — the encoding changed, the
|
|
;; number did not.
|
|
(let [{:keys [data db]} (semantic-fixture)
|
|
pages (vals (:pages-index data))
|
|
page-shapes (remove #(= uuid/zero (:id %))
|
|
(mapcat #(vals (:objects %)) pages))
|
|
live-comps (ctkl/components-seq data)
|
|
shape-on-page? (fn [id] (some #(contains? (:objects %) id) pages))
|
|
page-container? (fn [cid] (contains? (:pages-index data) cid))
|
|
live-head? (fn [shape]
|
|
(some (fn [component]
|
|
(ctk/instance-of? shape (:id data) (:id component)))
|
|
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 (fn [[_scid _sid tcid _tid]]
|
|
(page-container? tcid))
|
|
(oracle-refs data)))
|
|
:fills-swap-slot (count (filter #(let [slot (ctk/get-swap-slot %)]
|
|
(and slot (shape-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)))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; the build path
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(t/deftest the-bulk-build-and-a-transaction-produce-one-graph
|
|
;; `overlay/build` assigns entity ids itself and loads the index bottom-up,
|
|
;; where transacting the same entity maps lets datascript assign them. The
|
|
;; two must index the same graph, and a transform that read the half-built
|
|
;; index instead of the document is the way that stops being true: the
|
|
;; bulk path has no half-built index to read, so such a transform would
|
|
;; silently see nothing here and see something on the transact path.
|
|
;;
|
|
;; Entity ids differ between the paths and carry no meaning, so the
|
|
;; comparison reads every id back through the tempid that minted it.
|
|
(let [{:keys [file]} (semantic-fixture)
|
|
tx (overlay/build-tx (:data file) file)
|
|
transacted (d/with (d/empty-db overlay/schema) tx)
|
|
by-tempid (fn [tempids]
|
|
(into {} (map (fn [[tempid eid]] [eid tempid]))
|
|
(dissoc tempids :db/current-tx)))
|
|
ref-attr? (into #{}
|
|
(keep (fn [[attr decl]]
|
|
(when (= :db.type/ref (:db/valueType decl)) attr)))
|
|
overlay/schema)
|
|
canonical (fn [db eid->tempid]
|
|
(into #{}
|
|
(map (fn [datom]
|
|
[(get eid->tempid (:e datom) (:e datom))
|
|
(:a datom)
|
|
(if (ref-attr? (:a datom))
|
|
(get eid->tempid (:v datom) (:v datom))
|
|
(:v datom))]))
|
|
(d/datoms db :eavt)))
|
|
bulk (overlay/build (:data file) file)
|
|
bulk-ids (reduce (fn [acc entity]
|
|
(let [tempid (:db/id entity)]
|
|
(if (contains? acc tempid)
|
|
acc
|
|
(assoc acc tempid (inc (count acc))))))
|
|
{}
|
|
tx)]
|
|
(t/is (= (count (d/datoms (:db-after transacted) :eavt))
|
|
(count (d/datoms bulk :eavt))))
|
|
(t/is (= (canonical (:db-after transacted) (by-tempid (:tempids transacted)))
|
|
(canonical bulk (by-tempid (into {} (map (fn [[t e]] [t e])) bulk-ids)))))
|
|
(t/is (= (queries/stats (:db-after transacted)) (queries/stats bulk)))
|
|
(t/is (= (queries/edge-counts (:db-after transacted)) (queries/edge-counts bulk)))))
|
|
|
|
(t/deftest a-reference-to-an-undefined-tempid-is-refused-on-both-paths
|
|
;; `ref-resolver` answers with the tempid of whatever shape
|
|
;; `ctf/find-ref-shape` names, and that shape can sit in a container the
|
|
;; builder skipped, so a reference may name a tempid the transaction never
|
|
;; defines. `d/db-with` refuses such a transaction outright, so the bulk
|
|
;; path must refuse it too: resolving the target to nil would index a
|
|
;; nil-valued reference, and allocating an entity for it would index an
|
|
;; edge to nothing, and neither would say so. This is a unit test of the
|
|
;; flattener rather than of a document, because no fixture reaches the
|
|
;; case and the risk lives here.
|
|
(let [tx [{:db/id "doc" :document/id (uuid/next)}
|
|
{:db/id "c/1" :container/id (uuid/next) :container/document "doc"}
|
|
{:db/id "s/1" :shape/id (uuid/next) :shape/container "c/1"
|
|
:shape/refers-to "s/absent"}]]
|
|
(t/is (thrown? clojure.lang.ExceptionInfo (overlay/tx->datoms tx)))
|
|
(t/is (= :projection/dangling-reference
|
|
(:error (ex-data (try (overlay/tx->datoms tx) (catch Throwable e e)))))
|
|
"the refusal names the defect rather than the symptom")
|
|
(t/is (thrown? clojure.lang.ExceptionInfo (d/with (d/empty-db overlay/schema) tx))
|
|
"as the transact path always did")
|
|
(let [whole (conj tx {:db/id "s/absent" :shape/id (uuid/next) :shape/container "c/1"})]
|
|
(t/is (= (count (d/datoms (:db-after (d/with (d/empty-db overlay/schema) whole)) :eavt))
|
|
(count (d/datoms (d/init-db (overlay/tx->datoms whole) overlay/schema) :eavt)))
|
|
"and with the target defined, both paths carry the same datoms"))))
|