From ff3d57c6718824b471e5f8e78036f998b7253ef6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=C3=81lvaro=20Tejero=20Cantero?= Date: Fri, 7 Aug 2026 01:34:46 +0200 Subject: [PATCH] :bug: Keep a synced graph equal to a rebuilt one Cold projection and incremental sync are two implementations of one mapping and nothing checked that they agree. They did not. `backend-tests.graph-sync-parity-test` projects a file into one `:memory:` database, applies a change list to that database and the same list to the file data, projects the result into a second database, and diffs the two down to the row and the column. It found four disagreements, each fixed here. **Sibling order was inverted.** A container's stored `:shapes` list runs bottom to top and `IsChildOf.position` numbers children in Penpot z-order, so appending to the list means taking position 0 and pushing every sibling up. Sync instead handed each new child the next free number, so any container edited live carried its children in the opposite order to a rebuild, and a delete left a gap where a rebuild renumbers densely. `insert-position` and `renumber-siblings` put the two paths on the same rule for `:add-obj`, `:mov-objects` and `:del-obj`, including a block move and `:after-shape`. **A moved shape kept its old parent.** `:mov-objects` moved the edge and left the shape's own `parent_id` and `frame_id` columns pointing at the container it came from. Both now follow, and `frame_id` follows through the whole subtree the shape carries, as `app.common.files.changes` does for `:mov-objects`. A top-level shape's column holds `uuid/zero`, the page's root frame, while its edge points at the Page. **A container's `shapes` column went stale.** Nothing maintained it after an add, a move or a delete. It is now rebuilt from the sibling order on every change that touches a container. **Pages came out backwards.** `projection-data` reversed `:pages` before numbering them, which is right for child shapes and wrong for pages: `:pages` is the tab order and has no second ordering to undo. `Page.index` and the page's `IsChildOf.position` are now that order. One defect the test does not reach, fixed on the way past: `index-add-shape!` accepted `:component-ctx` and dropped it, so a shape added under an instance head added in the same session inherited no `component-id`. AI-assisted-by: mixed models --- backend/src/app/graph/project/document.clj | 6 +- backend/src/app/graph/sync.clj | 346 +++++++++++++----- .../backend_tests/graph_sync_parity_test.clj | 280 ++++++++++++++ 3 files changed, 534 insertions(+), 98 deletions(-) create mode 100644 backend/test/backend_tests/graph_sync_parity_test.clj diff --git a/backend/src/app/graph/project/document.clj b/backend/src/app/graph/project/document.clj index e6fbd3f2c1..edf47ccbec 100644 --- a/backend/src/app/graph/project/document.clj +++ b/backend/src/app/graph/project/document.clj @@ -188,7 +188,11 @@ [data file] (let [doc-id (or (:id data) (:id file)) doc-node (nodes/project-attrs "Document" (document-attrs file data)) - pages (seq (reverse (:pages data))) + ;; `:pages` is the tab order the user sees, and `Page.index` and the + ;; page's `IsChildOf.position` are that order. Child shapes are + ;; reversed on the way in (`child-shape-ids`) because their stored + ;; list runs bottom to top; pages have no such second ordering. + pages (seq (:pages data)) comps (seq (:components data)) acc0 (-> (initial-acc) (update-in [:nodes "Document"] (fnil conj []) doc-node) diff --git a/backend/src/app/graph/sync.clj b/backend/src/app/graph/sync.clj index a3820c5ccc..1ce844d3ed 100644 --- a/backend/src/app/graph/sync.clj +++ b/backend/src/app/graph/sync.clj @@ -112,6 +112,7 @@ :parent-id parent-id :parent-table parent-table :position (long (:position edge 0)) + :frame-id (:frame-id attrs) ;; The projection already denormalized these; re-deriving ;; page-id from the parent chain would only be a second way to ;; get the same answer. `:component-ctx` is what later @@ -268,21 +269,20 @@ (when (get-in index [:pages pid]) {:parent-id pid :parent-table "Page"}))))) -(defn- default-position - [index parent-id] - (count (get-in index [:children parent-id] #{}))) - (defn- index-add-shape! - [index {:keys [id name table parent-id parent-table position page-id]}] + [index {:keys [id name table parent-id parent-table position page-id + frame-id component-ctx]}] (-> index (assoc-in [:shapes id] - {:id id - :name name - :table table - :parent-id parent-id - :parent-table parent-table - :position position - :page-id page-id}) + {:id id + :name name + :table table + :parent-id parent-id + :parent-table parent-table + :position position + :frame-id frame-id + :component-ctx component-ctx + :page-id page-id}) (update :children update parent-id (fnil conj #{}) id))) (defn- index-remove-shape! @@ -302,16 +302,120 @@ (update :children update doc-id (fnil conj #{}) id))) (defn- index-move-shape! - [index shape-id {:keys [parent-id parent-table position page-id]}] + [index shape-id {:keys [parent-id parent-table position page-id frame-id]}] (let [old-parent (get-in index [:shapes shape-id :parent-id])] (-> index (assoc-in [:shapes shape-id :parent-id] parent-id) (assoc-in [:shapes shape-id :parent-table] parent-table) (assoc-in [:shapes shape-id :position] position) + (assoc-in [:shapes shape-id :frame-id] frame-id) (cond-> page-id (assoc-in [:shapes shape-id :page-id] page-id)) (update :children update old-parent #(disj (or % #{}) shape-id)) (update :children update parent-id (fnil conj #{}) shape-id)))) +;; --- the columns that restate parenthood +;; +;; A shape carries `parent_id` and `frame_id`, and a container carries the +;; ordered `shapes` list. All three restate what `IsChildOf` already says, and +;; the cold projection writes them from the file, so this path has to keep +;; them in step or a synced graph stops matching a rebuilt one. + +(defn- shape-parent-id + "The `parent_id` a shape's own column holds. + + A top-level shape's parent in the file is the page's root frame, which the + graph does not materialize, so `IsChildOf` points at the Page while the + column holds `uuid/zero`." + [parent-id parent-table] + (if (= "Page" parent-table) uuid/zero parent-id)) + +(defn- frame-id-under + "The `frame_id` a shape gets when its parent is `parent-id`. + + Penpot's rule, from `app.common.files.changes` `:mov-objects`: the parent + itself when the parent is a Frame, the parent's own frame otherwise." + [index parent-id parent-table] + (cond + (= "Page" parent-table) uuid/zero + (= "Frame" parent-table) parent-id + :else (get-in index [:shapes parent-id :frame-id] uuid/zero))) + +(defn- frame-id-updates + "`[shape-id frame-id]` for a moved shape and everything that follows it. + + A Frame keeps its descendants pointing at itself, so the walk stops there. + Any other shape carries its subtree onto the new frame." + [index shape-id frame-id] + (into [[shape-id frame-id]] + (when (not= "Frame" (get-in index [:shapes shape-id :table])) + (mapcat #(frame-id-updates index % frame-id) + (get-in index [:children shape-id] #{}))))) + +(defn- child-shapes-value + "A container's stored `shapes` list, rebuilt from the index. + + `IsChildOf.position` counts from the last entry of that list + (`app.graph.project.document/child-shape-ids` reverses it), so reversing the + children ordered by position gives the list back." + [index parent-id] + (->> (get-in index [:children parent-id] #{}) + (sort-by #(get-in index [:shapes % :position] 0)) + reverse + vec)) + +(defn- insert-position + "The graph position the lowest of `k` shapes takes when they are inserted + into a parent that already holds `n-before` children. + + A container's stored `:shapes` list runs bottom to top, and the graph + numbers children in Penpot z-order, so the two run opposite ways. An append + to the stored list, which is what `:add-obj` does without an `:index`, is + therefore position 0 and pushes every sibling up by one. The block occupies + the result and the `k - 1` positions above it, the first shape highest." + [n-before {:keys [index]} after-position] + (cond + (some? after-position) (long after-position) + (some? index) (max 0 (- n-before (long index))) + :else 0)) + +(defn- renumber-siblings + "Shift `parent-id`'s children at or above `from` by `delta`. + + Returns `[index statements]`. `except` names children the caller is placing + itself." + [index parent-id parent-table from delta except] + (reduce + (fn [[idx stmts] child-id] + (let [pos (get-in idx [:shapes child-id :position])] + (if (and (some? pos) (not (contains? except child-id)) (>= (long pos) (long from))) + (let [pos' (+ (long pos) (long delta))] + [(assoc-in idx [:shapes child-id :position] pos') + (conj stmts (set-edge-position-statement + {:from-table (get-in idx [:shapes child-id :table]) + :from-id child-id + :to-table parent-table + :to-id parent-id + :position pos'}))]) + [idx stmts]))) + [index []] + (vec (get-in index [:children parent-id] #{})))) + +(defn- set-children-statements + "Refresh the `shapes` column of every container in `parent-ids`. + + A Page has no such column: its top-level shapes hang off a root frame the + graph never materializes." + [index parent-ids] + (into [] + (comp (distinct) + (keep (fn [parent-id] + (let [table (get-in index [:shapes parent-id :table])] + (when (contains? nodes/container-tables table) + (set-node-attr-statement + table parent-id :shapes + (child-shapes-value index parent-id))))))) + parent-ids)) + (defn- mov-object-ids [shapes] (let [coll (cond @@ -328,15 +432,17 @@ (if (uuid? shape) shape (:id shape))))) coll))) -(defn- mov-position - [idx parent-id {:keys [index after-shape]}] - (cond - (some? index) (long index) - after-shape (let [after-pos (get-in idx [:shapes after-shape :position])] - (if (some? after-pos) - (inc (long after-pos)) - (default-position idx parent-id))) - :else (default-position idx parent-id))) +(defn- detach-shape + "Take `shape-id` out of its current parent and close the gap it leaves. + + Returns `[index statements]`. The edge itself is left alone: the caller + either replaces it or deletes it." + [index shape-id] + (let [{:keys [parent-id parent-table position]} (get-in index [:shapes shape-id]) + index (update-in index [:children parent-id] #(disj (or % #{}) shape-id)) + [index stmts] (renumber-siblings index parent-id parent-table + (inc (long (or position 0))) -1 #{})] + [(assoc-in index [:shapes shape-id :position] nil) stmts])) (defn- apply-mov-objects [index {:keys [shapes page-id] :as change}] @@ -353,48 +459,79 @@ {:index index :statements [] :applied? false :reason :missing-parent} :else - (let [base-position (mov-position index (:parent-id parent) change) - parent-id (:parent-id parent) - parent-table (:parent-table parent) - page-id' (or page-id - (when (= parent-table "Page") parent-id) - (get-in index [:shapes (first shape-ids) :page-id]))] - (loop [index index - statements [] - shape-ids (map-indexed vector shape-ids)] - (if-let [[offset shape-id] (first shape-ids)] - (if-let [shape (get-in index [:shapes shape-id])] - (let [position (+ base-position (long offset)) - same-edge? (and (= parent-id (:parent-id shape)) - (= parent-table (:parent-table shape)) - (= position (:position shape))) - edge {:from-table (:table shape) + (let [parent-id (:parent-id parent) + parent-table (:parent-table parent) + page-id' (or page-id + (when (= parent-table "Page") parent-id) + (get-in index [:shapes (first shape-ids) :page-id])) + known (filterv #(get-in index [:shapes %]) shape-ids) + old-parents (mapv #(get-in index [:shapes % :parent-id]) known) + ;; Penpot removes the shapes from wherever they were, then inserts + ;; the block into the target, so the target's width is measured + ;; after the removals. + [index detach-stmts] + (reduce (fn [[idx stmts] shape-id] + (let [[idx' s] (detach-shape idx shape-id)] + [idx' (into stmts s)])) + [index []] + known) + n-before (count (get-in index [:children parent-id] #{})) + after-pos (get-in index [:shapes (:after-shape change) :position]) + lowest (insert-position n-before change after-pos) + k (count known) + [index shift-stmts] + (renumber-siblings index parent-id parent-table lowest k #{})] + (loop [index index + statements (into detach-stmts shift-stmts) + entries (map-indexed vector known)] + (if-let [[offset shape-id] (first entries)] + (let [shape (get-in index [:shapes shape-id]) + position (+ lowest (- k 1 (long offset))) + frame-id (frame-id-under index parent-id parent-table) + frame-writes (frame-id-updates index shape-id frame-id) + edge {:from-table (:table shape) :from-id shape-id :to-table parent-table :to-id parent-id :position position} - statements (if same-edge? + moved? (not= parent-id (:parent-id shape)) + statements (-> statements + (cond-> moved? + (conj (delete-edge-statement + {:from-table (:table shape) + :from-id shape-id + :to-table (:parent-table shape) + :to-id (:parent-id shape)}))) + (conj (if moved? + (create-edge-statement edge) + (set-edge-position-statement edge)))) + ;; The shape's own columns restate the edge, and the frame + ;; follows the whole subtree the shape carries with it. + statements (if-not moved? statements - (into statements - (if (= parent-id (:parent-id shape)) - [(set-edge-position-statement edge)] - [(delete-edge-statement - {:from-table (:table shape) - :from-id shape-id - :to-table (:parent-table shape) - :to-id (:parent-id shape)}) - (create-edge-statement edge)]))) - index (if same-edge? - index - (index-move-shape! index shape-id - {:parent-id parent-id - :parent-table parent-table - :position position - :page-id page-id'}))] - (recur index statements (rest shape-ids))) - (recur index statements (rest shape-ids))) + (into (conj statements + (set-node-attr-statement + (:table shape) shape-id :parent-id + (shape-parent-id parent-id parent-table))) + (map (fn [[sid fid]] + (set-node-attr-statement + (get-in index [:shapes sid :table]) + sid :frame-id fid))) + frame-writes)) + index (index-move-shape! index shape-id + {:parent-id parent-id + :parent-table parent-table + :position position + :frame-id frame-id + :page-id page-id'}) + index (reduce (fn [idx [sid fid]] + (assoc-in idx [:shapes sid :frame-id] fid)) + index + frame-writes)] + (recur index statements (rest entries))) {:index index - :statements statements + :statements (into statements + (set-children-statements index (conj old-parents parent-id))) :applied? true})))))) (defn- index-remove-page! @@ -411,44 +548,52 @@ (defn- apply-add-obj [index change] - (let [{:keys [id obj page-id] pos :index} change + (let [{:keys [id obj page-id]} change table (shape-table obj)] (if-not table {:index index :statements [] :applied? false :reason :unsupported-shape-type} (let [parent (resolve-parent-for-add index change)] (if-not parent {:index index :statements [] :applied? false :reason :missing-parent} - (let [position (long (or pos (default-position index (:parent-id parent)))) + (let [parent-id (:parent-id parent) + parent-table (:parent-table parent) + n-before (count (get-in index [:children parent-id] #{})) + position (insert-position n-before change nil) + [index shift-stmts] + (renumber-siblings index parent-id parent-table position 1 #{}) ;; The same denormalizations the cold projection performs, so ;; a live-synced graph and a rebuilt one carry equal columns. resolved-page-id (or page-id - (when (= (:parent-table parent) "Page") (:parent-id parent)) - (get-in index [:shapes (:parent-id parent) :page-id])) - parent-ctx (get-in index [:shapes (:parent-id parent) :component-ctx]) + (when (= parent-table "Page") parent-id) + (get-in index [:shapes parent-id :page-id])) + parent-ctx (get-in index [:shapes parent-id :component-ctx]) shape (project.document/denormalized-shape (assoc obj :id id) resolved-page-id parent-ctx) attrs (nodes/project-attrs table shape) - edge (merge {:from-table table - :from-id id - :to-table (:parent-table parent) - :to-id (:parent-id parent) - :position position}) - stmts (into [(create-node-statement table attrs) - (create-edge-statement edge)] - (instance-of-statements table id (:component-id attrs)))] - {:index (index-add-shape! index - {:id id - :name (:name attrs) - :table table - :parent-id (:parent-id parent) - :parent-table (:parent-table parent) - :position position - :component-ctx (project.document/descend-component-ctx - table shape parent-ctx) - :page-id resolved-page-id}) - :statements stmts - :applied? true})))))) + edge {:from-table table + :from-id id + :to-table parent-table + :to-id parent-id + :position position} + stmts (-> shift-stmts + (conj (create-node-statement table attrs)) + (conj (create-edge-statement edge)) + (into (instance-of-statements table id (:component-id attrs)))) + index' (index-add-shape! index + {:id id + :name (:name attrs) + :table table + :parent-id parent-id + :parent-table parent-table + :position position + :frame-id (:frame-id attrs) + :component-ctx (project.document/descend-component-ctx + table shape parent-ctx) + :page-id resolved-page-id})] + {:index index' + :statements (into stmts (set-children-statements index' [parent-id])) + :applied? true})))))) (defn- apply-mod-obj [index {:keys [id operations]}] @@ -485,22 +630,29 @@ (defn- apply-del-obj [index {:keys [id]}] - (if (get-in index [:shapes id]) + (if-let [root (get-in index [:shapes id])] (let [to-delete (delete-order-deepest-first (:children index) id) statements - (vec (concat - (mapcat (fn [shape-id] - (let [{:keys [table parent-id parent-table]} - (get-in index [:shapes shape-id])] - [(delete-edge-statement - {:from-table table - :from-id shape-id - :to-table parent-table - :to-id parent-id}) - (delete-node-statement table shape-id)])) - to-delete)))] - {:index (reduce index-remove-shape! index to-delete) - :statements statements + (vec (mapcat (fn [shape-id] + (let [{:keys [table parent-id parent-table]} + (get-in index [:shapes shape-id])] + [(delete-edge-statement + {:from-table table + :from-id shape-id + :to-table parent-table + :to-id parent-id}) + (delete-node-statement table shape-id)])) + to-delete)) + index' (reduce index-remove-shape! index to-delete) + ;; Only the deleted subtree's own parent survives to be renumbered: + ;; every other parent in `to-delete` goes with it. + [index' shift-stmts] + (renumber-siblings index' (:parent-id root) (:parent-table root) + (inc (long (or (:position root) 0))) -1 #{})] + {:index index' + :statements (-> statements + (into shift-stmts) + (into (set-children-statements index' [(:parent-id root)]))) :applied? true}) ;; Penpot emits one :del-obj per selected shape; an earlier change in the ;; same batch may have already removed this node (e.g. parent + child). diff --git a/backend/test/backend_tests/graph_sync_parity_test.clj b/backend/test/backend_tests/graph_sync_parity_test.clj new file mode 100644 index 0000000000..f9de78d831 --- /dev/null +++ b/backend/test/backend_tests/graph_sync_parity_test.clj @@ -0,0 +1,280 @@ +;; 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-sync-parity-test + "Cold projection and incremental sync are two implementations of one mapping, + and this namespace holds them to it. + + `app.graph.project.document/projection-data` reads a whole file and produces + the whole graph. `app.graph.sync/apply-changes!` takes the change vocabulary + the editor emits and mutates an already open graph. A graph the second one + maintained must equal a graph the first one would build from the same file, + or the console shows a graph no rebuild reproduces. + + The round trip: project a file cold into A, apply a change list to A and the + same list to the file data, project the resulting data cold into B, and diff + A against B. Two `:memory:` databases, no Postgres, no session." + (:require + [app.common.features :as ffeat] + [app.common.files.changes :as cfc] + [app.common.time :as ct] + [app.common.types.file :as ctf] + [app.common.types.shape :as cts] + [app.common.uuid :as uuid] + [app.graph.arrow :as arrow] + [app.graph.ladybug :as ladybug] + [app.graph.project.document :as project.document] + [app.graph.project.transforms :as project.transforms] + [app.graph.schema.nodes :as nodes] + [app.graph.sync :as sync] + [clojure.test :as t])) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; 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 base-revn 1) + +(defn- file-row + "The `file` map the projection reads, as `bfc/get-file` returns it minus the + data blob." + [revn] + {:id file-id + :name "graph sync parity fixture" + :revn revn + :version 70 + :features #{"components/v2"} + :created-at (ct/inst "2026-01-01T00:00:00Z") + :modified-at (ct/inst "2026-01-02T00:00:00Z")}) + +(defn- base-data + [] + (binding [ffeat/*current* #{"components/v2"}] + (ctf/make-file-data file-id page-id))) + +(defn- shape + [id type attrs] + (cts/setup-shape (merge {:id id + :type type + :frame-id uuid/zero + :parent-id uuid/zero} + attrs))) + +(def ^:private changes + "One change of every kind the sync path claims to support that this fixture + can exercise, in the order an editing session would emit them. + + Four siblings in one container, then a reorder, a reparent, and a delete: + sibling order is where the two paths are easiest to get wrong, because the + stored `:shapes` list and `IsChildOf.position` run opposite ways." + [{: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})} + + {: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, and 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}]} + + ;; Reorder inside the same container: the edge keeps its endpoints and + ;; every sibling it passes has to move. + {:type :mov-objects :page-id page-id :parent-id frame-id :index 0 :shapes [circ-id]} + + ;; Reparent to the page's root frame: the edge moves, and so do the + ;; shape's own `parent_id` and `frame_id`. + {:type :mov-objects :page-id page-id :parent-id uuid/zero :index 0 :shapes [text-id]} + + ;; Delete with survivors: the gap in the sibling numbering has to close. + {:type :del-obj :page-id page-id :id rect-id} + + {:type :add-page :id page2-id :name "Page two"} + {:type :mod-page :id page-id :name "Page one, renamed"}]) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; projecting and reading back +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defn- load-graph! + "Create the schema on `conn`, project `data` into it, run the transforms. + + Returns the projection, which is also what the sync index is built from." + [conn data file] + (let [projection (project.document/projection-data data file)] + (ladybug/exec-on-connection! conn (nodes/ddl-statements)) + (arrow/with-allocator! + (fn [allocator] (arrow/load-projection! conn projection allocator))) + (project.transforms/apply-transforms! nil conn data file) + projection)) + +(defn- rel-tables + [conn] + (mapv first (:rows (ladybug/query-on-connection! + conn "CALL show_tables() WHERE type = 'REL' RETURN name;" + :max-rows 1000)))) + +(defn- rel-properties + "Property names on rel table `rel`, in catalog order." + [conn rel] + (mapv (comp str second) + (:rows (ladybug/query-on-connection! + conn (str "CALL table_info('" rel "') RETURN *;") + :max-rows 1000)))) + +(defn- node-rows + [conn table] + (:rows (ladybug/query-on-connection! + conn (str "MATCH (n:" (nodes/match-label table) ") RETURN n.* ORDER BY n.id;") + :max-rows 100000))) + +(defn- edge-rows + [conn rel props] + (let [returns (into ["a.id" "b.id"] (map #(str "r.`" % "`")) props)] + (:rows (ladybug/query-on-connection! + conn (str "MATCH (a)-[r:`" rel "`]->(b) " + "RETURN " (clojure.string/join ", " returns) " " + "ORDER BY a.id, b.id;") + :max-rows 100000)))) + +(defn- keyed-rows + "Rows as `{key {column value}}`, so a difference names a row and a column. + + Values are stringified: both connections hand a value back through the same + reader, so any difference in the strings is a difference in the graph." + [columns key-columns rows] + (into {} + (map (fn [row] + (let [cells (zipmap columns (map str row))] + [(mapv cells key-columns) cells]))) + rows)) + +(defn- snapshot + "Every node row and every edge row in the database, keyed by table." + [conn] + {:nodes (into {} + (map (fn [{:keys [table]}] + (let [columns (nodes/columns table)] + [table (keyed-rows columns ["id"] (node-rows conn table))]))) + nodes/node-types) + :edges (into {} + (map (fn [rel] + (let [columns (into ["from" "to"] (rel-properties conn rel))] + [rel (keyed-rows columns ["from" "to"] + (edge-rows conn rel (rel-properties conn rel)))]))) + (rel-tables conn))}) + +(defn- row-diff + [rows-a rows-b] + (into {} + (for [k (sort (into #{} (concat (keys rows-a) (keys rows-b)))) + :let [a (get rows-a k) + b (get rows-b k)] + :when (not= a b)] + [k (cond + (nil? a) {:only-in :rebuilt} + (nil? b) {:only-in :synced} + :else (into {} + (for [c (sort (into #{} (concat (keys a) (keys b)))) + :when (not= (get a c) (get b c))] + [c {:synced (get a c) :rebuilt (get b c)}])))]))) + +(defn- diff + "Where the two snapshots disagree, down to the row and the column." + [a b] + (into {} + (for [kind [:nodes :edges] + table (sort (into #{} (concat (keys (get a kind)) (keys (get b kind))))) + :let [d (row-diff (get-in a [kind table]) (get-in b [kind table]))] + :when (seq d)] + [[kind table] d]))) + +(defn- with-two-connections + [f] + (ladybug/with-connection! ":memory:" + (fn [conn-a] + (ladybug/with-connection! ":memory:" + (fn [conn-b] + (f conn-a conn-b)))))) + +(defn- round-trip + "Sync `change-list` into A, rebuild the same file into B, return the diff." + [change-list] + (let [data0 (base-data) + data1 (cfc/process-changes data0 change-list) + revn1 (inc base-revn)] + (with-two-connections + (fn [conn-a conn-b] + (let [projection (load-graph! conn-a data0 (file-row base-revn)) + index (sync/build-index file-id base-revn projection) + result (sync/apply-changes! conn-a index change-list revn1)] + (load-graph! conn-b data1 (file-row revn1)) + {:diff (diff (snapshot conn-a) (snapshot conn-b)) + :applied (:applied result) + :skipped (:skipped result)}))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; the tests +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(t/deftest every-change-in-the-list-is-supported + (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 (= (count changes) (count applied))))) + +(t/deftest synced-graph-equals-rebuilt-graph + (let [{:keys [diff]} (round-trip changes)] + (t/is (empty? diff) + (str "cold projection and sync replay disagree on " + (pr-str (keys diff)) "\n" (pr-str diff))))) + +(t/deftest the-diff-catches-an-injected-sync-bug + ;; The round trip is only worth running if it fails when sync is wrong. + ;; `apply-mov-objects` maintains `IsChildOf`; drop the change from the list + ;; sync sees, keep it in the list the file sees, and the edge must differ. + (let [data0 (base-data) + data1 (cfc/process-changes data0 changes) + crippled (remove #(= :mov-objects (:type %)) changes) + revn1 (inc base-revn) + result (with-two-connections + (fn [conn-a conn-b] + (let [projection (load-graph! conn-a data0 (file-row base-revn)) + index (sync/build-index file-id base-revn projection)] + (sync/apply-changes! conn-a index crippled revn1) + (load-graph! conn-b data1 (file-row revn1)) + (diff (snapshot conn-a) (snapshot conn-b)))))] + (t/is (contains? result [:edges "IsChildOf"]) + "a sync that skips a reparent must show up as an IsChildOf difference")))