✨ Add graph provenance, column naming and two transforms

A projected graph is a cache of one file at one revision, built by one
schema, and nothing in it said so. `GraphMeta` records the file, the
revision, the schema version and the producer, and is written last, so
its presence also marks the build complete and its contents say whether
a cached database is still worth opening.

- `graph/meta.clj`: the `GraphMeta` table and its writer.
- `graph/schema/contract.clj`: one place that maps a Penpot key to its
  graph column. The rule is snake_case of the key; every exception, be
  it a rename, a drop or a type override, is recorded there with its
  reason, so a divergence is a diff to review rather than a silent
  rename.
- `graph/project/document.clj`: `page-id` and the inherited
  `component-id` are written during the tree walk, which already knows
  both, rather than by a post-ingest statement. `graph/sync.clj` does
  the same on the incremental path, so a live-synced graph matches a
  rebuild.
- `graph/project/transforms.clj`: a registry, so adding a derived-link
  pass is one entry. Adds `RefersTo` (from `shape-ref`) and
  `FillsSwapSlot` (from `swap-slot-*` entries in `touched`, then
  stripped as `ctk/normal-touched-groups` does).
- `graph/debug.clj`, `graph/stats.clj`: enumerate relationship tables
  from the catalog instead of naming them, so the console's graph view
  and the ingest counts pick up new edge types without being told.
- `graph/debug.clj`, `http/debug.clj`: `graph-export` gains
  `source=session`, which snapshots the live in-memory console graph
  through EXPORT/IMPORT DATABASE. Live sync moves that graph away from a
  fresh projection, and taking it away to query elsewhere is the point
  of asking for it.

AI-assisted-by: mixed models
This commit is contained in:
Álvaro Tejero Cantero 2026-07-26 06:35:48 +02:00 committed by Andrey Antukh
parent 8f32c6af33
commit a70977adc6
12 changed files with 626 additions and 104 deletions

View File

@ -99,7 +99,10 @@
(let [columns (nodes/column-keys table)
types (mapv #(nodes/column-ladybug-type table %) columns)]
(with-open [w (io/writer file :encoding "UTF-8")]
(.write w (str (str/join "," (map name columns)) "\n"))
;; COPY binds columns positionally (HEADER=true only skips the row), so
;; this header is documentation — but it carries the beadpot column
;; names, so a staged CSV reads the same as the table it loads into.
(.write w (str (str/join "," (map #(nodes/column-name table %) columns)) "\n"))
(doseq [row rows]
(.write w (str (str/join "," (map (fn [k t] (csv-typed-cell t (get row k)))
columns types))

View File

@ -15,6 +15,7 @@
[app.graph.schema.nodes :as nodes]
[app.graph.sync :as graph.sync]
[app.msgbus :as mbus]
[clojure.java.io :as io]
[clojure.string :as str]
[promesa.exec.csp :as sp])
(:import
@ -235,25 +236,44 @@
{:nodes [] :truncated? false}
nodes/node-types))
(defn rel-tables
"Every relationship table in the open database, with whether it carries a
`position` property.
Read from the catalog rather than listed here, so a newly ported transform's
rel table appears in the graph view without the console being told about it."
[conn]
(for [[table] (:rows (ladybug/query-on-connection!
conn "CALL show_tables() WHERE type = 'REL' RETURN name;"
:max-rows 1000))
:let [props (->> (ladybug/query-on-connection!
conn (str "CALL table_info('" table "') RETURN *;")
:max-rows 1000)
:rows
(into #{} (map (comp str second))))]]
{:table table :position? (contains? props "position")}))
(defn- export-edges
[conn]
(let [child-stmt (str "MATCH (a)-[r:IsChildOf]->(b) "
"RETURN a.id AS source, b.id AS target, r.position AS position, "
"'IsChildOf' AS rel;")
inst-stmt (str "MATCH (a)-[r:IsInstanceOf]->(b) "
"RETURN a.id AS source, b.id AS target, NULL AS position, "
"'IsInstanceOf' AS rel;")
child (ladybug/query-on-connection! conn child-stmt :max-rows export-max-rows)
inst (ladybug/query-on-connection! conn inst-stmt :max-rows export-max-rows)
->edge (fn [[source target position rel]]
(cond-> {:source (str source)
:target (str target)
:rel (str rel)}
(some? position) (assoc :position position)))]
{:edges (into (mapv ->edge (:rows child))
(map ->edge)
(:rows inst))
:truncated? (boolean (or (:truncated? child) (:truncated? inst)))}))
(reduce
(fn [acc {:keys [table position?]}]
(let [stmt (str "MATCH (a)-[r:`" table "`]->(b) "
"RETURN a.id AS source, b.id AS target, "
(if position? "r.position" "NULL") " AS position, "
"'" table "' AS rel;")
{:keys [rows truncated?]}
(ladybug/query-on-connection! conn stmt :max-rows export-max-rows)]
(-> acc
(update :edges into
(map (fn [[source target position rel]]
(cond-> {:source (str source)
:target (str target)
:rel (str rel)}
(some? position) (assoc :position position))))
rows)
(update :truncated? #(or % truncated?)))))
{:edges [] :truncated? false}
(rel-tables conn)))
(defn- bm-usage-bytes
"Buffer-manager memory in use by this session's in-memory database
@ -280,6 +300,47 @@
:nodes nodes
:edges edges}))))
(defn- delete-tree!
[^java.io.File file]
(when (.exists file)
(doseq [f (reverse (file-seq file))]
(.delete ^java.io.File f))))
(defn export-session-database!
"Materialize the in-memory session graph of `profile-id` as a `.lbug` file.
The console's graph is in-memory and live-synced, so it can differ from a
fresh projection of the same file — which is exactly when someone wants to
take it away and query it elsewhere. There is no \"save this database\"
primitive, so the transfer goes through Ladybug's `EXPORT DATABASE` (Parquet
per table) into a fresh on-disk database via `IMPORT DATABASE`.
Note the round-trip drops table comments; beadpot resolves such tables by
name (`beadpot.graph.context/_adopt_node_table`), so this is not load-bearing.
Returns the path of the written database, or nil when no session is loaded.
The caller owns the file and must delete it once streamed."
[profile-id]
(when-let [{:keys [conn lock file-id]} (get @sessions (session-key profile-id))]
(let [stamp (System/nanoTime)
staging (io/file (System/getProperty "java.io.tmpdir")
(str "penpot-graph-session-" file-id "-" stamp))
db-path (str (io/file (System/getProperty "java.io.tmpdir")
(str file-id "-session-" stamp ".lbug")))]
(try
(locking lock
(ladybug/exec-on-connection!
conn [(str "EXPORT DATABASE '" (.getAbsolutePath staging)
"' (format='parquet');")]))
(ladybug/with-connection! db-path
(fn [target]
(ladybug/exec-on-connection!
target [(str "IMPORT DATABASE '" (.getAbsolutePath staging) "';")
"CHECKPOINT;"])))
db-path
(finally
(delete-tree! staging))))))
(defn- hide-filter-columns
"Drop `filter_*` columns from a query result before HTML table render;
they exist to feed node ids to the graph-view filter, not for reading.

View File

@ -14,6 +14,7 @@
[app.db :as db]
[app.graph.bulk :as bulk]
[app.graph.ladybug :as ladybug]
[app.graph.meta :as graph.meta]
[app.graph.project.document :as project.document]
[app.graph.project.transforms :as project.transforms]
[app.graph.schema :as schema]
@ -58,17 +59,21 @@
(ladybug/exec-on-connection! conn ddl)
(bulk/load-projection! conn {:nodes nodes :edges edges} staging-path)
(ladybug/exec-on-connection! conn ["CHECKPOINT;"])
{:file-id file-id
:revn (:revn file)
:name (or (:name data) (:name file))
:db-path db-path
:schema-version schema/schema-version
:projection {:stats stats
:nodes nodes
:edges edges}
:transforms (project.transforms/apply-transforms! system conn data file)
:stats (when-not skip-stats?
(stats/summarize-connection conn))})))
(let [transforms (project.transforms/apply-transforms! system conn data file)]
;; Written last: its presence doubles as the build-complete marker.
(graph.meta/write! conn {:file-id file-id
:revn (:revn file)})
{:file-id file-id
:revn (:revn file)
:name (or (:name data) (:name file))
:db-path db-path
:schema-version schema/schema-version
:projection {:stats stats
:nodes nodes
:edges edges}
:transforms transforms
:stats (when-not skip-stats?
(stats/summarize-connection conn))}))))
(defn ingest-file!
[system file-id & {:keys [db-path reset-db? skip-stats? skip-validation?]

View File

@ -0,0 +1,59 @@
;; 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.meta
"`GraphMeta`: the graph's own account of who built it and from what.
A projected graph is a cache of a file at a revision, built by a known
schema. The row records both, so a reader can decide whether to reuse the
database or rebuild it: a `schema_version` that no longer matches the
registry, or a `source_revn` behind the file's, means the cache is stale.
The row is written *last* in a build, so its presence also marks the build
complete.
Keyed by `source_file_id` rather than holding a single row: a closure graph
is a union of per-file builds, and each contributing file keeps its own
provenance."
(:require
[app.common.time :as ct]
[app.graph.ladybug :as ladybug]
[app.graph.schema.nodes :as nodes])
(:import
com.ladybugdb.Connection))
(set! *warn-on-reflection* true)
(def table
"GraphMeta")
(def producer
"penpot")
(def ddl
"DDL for the provenance table."
(str "CREATE NODE TABLE `" table "` ("
"`source_file_id` UUID, "
"`producer` STRING, "
"`producer_version` STRING, "
"`schema_version` STRING, "
"`source_revn` INT64, "
"`built_at` TIMESTAMP, "
"PRIMARY KEY (`source_file_id`));"))
(defn write!
"Record what this build produced for `file-id`."
[^Connection conn {:keys [file-id revn]}]
(ladybug/exec-on-connection! conn [ddl])
(ladybug/exec-on-connection!
conn
[(str "MERGE (m:`" table "` {source_file_id: " (ladybug/format-uuid file-id) "}) "
"SET m.producer = " (ladybug/format-string producer) ", "
"m.producer_version = " (ladybug/format-string (or (System/getenv "PENPOT_BUILD") "devenv")) ", "
"m.schema_version = " (ladybug/format-string nodes/schema-version) ", "
"m.source_revn = " (ladybug/format-int (or revn 0)) ", "
"m.built_at = " (ladybug/format-timestamp (ct/now)) ";")]))

View File

@ -8,7 +8,18 @@
"Project a Penpot file-data map into Ladybug nodes and structural edges.
Projects Document, Page, Component, the full shape tree (skipping the root
frame), and `IsChildOf` edges from shapes/pages/components to their parent."
frame), and `IsChildOf` edges from shapes/pages/components to their parent.
Two of beadpot's denormalizing transforms happen here rather than in a later
pass, because the walk already has the answer in hand:
- `page-id` on every shape (beadpot `DenormalizePageId`), from the page the
walk is currently in;
- `component-id` propagated from an instance head down to its descendants
(beadpot `DenormalizeComponentId`), from the head context the walk carries.
Both ids are declared in `app.graph.meta/projection-transforms`, so beadpot
reads the graph's own provenance and does not redo them."
(:require
[app.common.logging :as l]
[app.common.uuid :as uuid]
@ -40,9 +51,38 @@
[shape]
(nodes/table-for-type (:type shape)))
(defn denormalized-shape
"`shape` with `page-id` set and an inherited `component-id` filled in.
A shape that carries its own `component-id` keeps it; `component-ctx` only
fills the gap for descendants (see `descend-component-ctx`)."
[shape page-id component-ctx]
(cond-> (assoc shape :page-id page-id)
(and (uuid? component-ctx) (nil? (:component-id shape)))
(assoc :component-id component-ctx)))
(defn- shape-node-attrs
[table shape]
(nodes/project-attrs table shape))
[table shape page-id component-ctx]
(nodes/project-attrs table (denormalized-shape shape page-id component-ctx)))
(defn descend-component-ctx
"The component context to pass to `shape`'s children.
Mirrors beadpot `DenormalizeComponentId`, whose recursive match stops at the
nearest ancestor Frame carrying a `component-id` and treats any intermediate
node that carries one as a barrier:
- a Frame with its own `component-id` becomes the new context (it is an
instance head, and its descendants belong to *it*, not to an outer head);
- any other shape carrying a `component-id` blocks inheritance below it
without being able to supply one, since only Frames are heads;
- otherwise the context passes through unchanged."
[table shape ctx]
(let [own (:component-id shape)]
(cond
(and (some? own) (= table "Frame")) own
(some? own) ::blocked
:else ctx)))
(defn- container-table?
[table]
@ -63,10 +103,11 @@
(declare project-shape-ids)
(defn- project-shape
[objects acc table shape parent-table parent-id position]
[objects acc table shape parent-table parent-id position page-id component-ctx]
(let [shape-id (:id shape)
acc' (-> acc
(update-in [:nodes table] (fnil conj []) (shape-node-attrs table shape))
(update-in [:nodes table] (fnil conj [])
(shape-node-attrs table shape page-id component-ctx))
(update :edges conj {:from-table table
:from-id shape-id
:to-table parent-table
@ -75,16 +116,18 @@
(update-in [:stats :shapes] inc))]
(if-let [child-ids (when (container-table? table)
(child-shape-ids shape))]
(project-shape-ids objects acc' table shape-id child-ids)
(project-shape-ids objects acc' table shape-id child-ids page-id
(descend-component-ctx table shape component-ctx))
acc')))
(defn- project-shape-ids
[objects acc parent-table parent-id child-ids]
[objects acc parent-table parent-id child-ids page-id component-ctx]
(reduce
(fn [acc [position shape-id]]
(if-let [shape (get objects shape-id)]
(if-let [table (shape-table shape)]
(project-shape objects acc table shape parent-table parent-id position)
(project-shape objects acc table shape parent-table parent-id position
page-id component-ctx)
(do
(l/wrn :hint "unsupported shape type for graph slice"
:shape-id (str shape-id)
@ -112,7 +155,7 @@
:position position})
(update-in [:stats :pages] inc))]
(if-let [top-level-ids (child-shape-ids root)]
(project-shape-ids objects acc' "Page" page-id top-level-ids)
(project-shape-ids objects acc' "Page" page-id top-level-ids page-id nil)
acc')))
(defn- project-component

View File

@ -5,38 +5,141 @@
;; Copyright (c) KALEIDOS INC Sucursal en España SL
(ns app.graph.project.transforms
"Derived graph links (instances, tokens, nested containment, etc.).
"Derived graph links, ported from beadpot's post-projection transforms.
Ports beadpot's post-projection transforms. Currently:
- `LinkComponentInstances` → `IsInstanceOf` (Frame → Component)."
Each entry in `registry` carries the shared transform id
(`app.graph.meta`), so a build records exactly what it produced and beadpot
runs only the complement in Python. Adding a transform here is therefore the
whole port step: nothing else has to be told about it.
The Cypher mirrors beadpot's, which is written through its query builder but
reduces to the same statements — the parity harness diffs the resulting
graphs, so a semantic drift shows up as a differing edge set rather than as
a differing query."
(:require
[app.common.logging :as l]
[app.graph.ladybug :as ladybug])
[app.graph.ladybug :as ladybug]
[app.graph.schema.nodes :as nodes])
(:import
com.ladybugdb.Connection))
(defn- link-component-instances!
"Create `IsInstanceOf` edges from Frame instance heads to Component nodes.
(set! *warn-on-reflection* true)
Same semantics as beadpot `LinkComponentInstances`: every frame with
`:component-id` matching a non-deleted Component in this graph (main
instance and copy roots)."
(defn- run-scalar!
[^Connection conn statement]
(or (ladybug/query-scalar-on-connection! conn statement) 0))
(defn- link-component-instances!
"`IsInstanceOf` from Frame instance heads to their Component.
beadpot `graph/transform/assets.py::LinkComponentInstances`. An instance
head carries `:component-id` pointing at its component record (see
`app.common.types.component/instance-of?`); every such head is linked, the
main instance and any copy root alike."
[^Connection conn]
(let [n (or (ladybug/query-scalar-on-connection!
conn
(run-scalar! conn
(str "MATCH (f:Frame), (c:Component) "
"WHERE f.`component-id` = c.id "
"WHERE f.component_id = c.id "
"AND NOT COALESCE(c.deleted, false) "
"MERGE (f)-[:IsInstanceOf]->(c) "
"RETURN count(*);"))
0)]
(l/inf :hint "graph transform IsInstanceOf"
:edges n)
n))
"RETURN count(*);")))
(defn- shape-pair-statements
"One statement per (from, to) shape-table pair.
Ladybug cannot create a relationship bound by multiple node labels in a
single `MERGE` (kuzudb/kuzu#5841), which is why beadpot loops over label
pairs too; the loop is a dialect constraint, not a modelling choice."
[f]
(for [from nodes/shape-tables
to nodes/shape-tables]
(f from to)))
(defn- link-shape-refs!
"`RefersTo` from an instance shape to its homologue in the main instance.
beadpot `graph/transform/assets.py::LinkShapeRefs`, driven by `shape-ref`."
[^Connection conn]
(reduce
(fn [total statement] (+ total (run-scalar! conn statement)))
0
(shape-pair-statements
(fn [from to]
(str "MATCH (s:" (nodes/match-label from) "), (t:" (nodes/match-label to) ") "
"WHERE s.shape_ref = t.id "
"MERGE (s)-[:RefersTo]->(t) "
"RETURN count(*);")))))
(def ^:private swap-slot-prefix "swap-slot-")
(def ^:private slot-uuid-expr
;; Ladybug `substring` is 1-indexed; 36 = RFC 4122 UUID text length.
(str "substring(touched_key, " (inc (count swap-slot-prefix)) ", 36)"))
(defn- link-swap-slots!
"`FillsSwapSlot` from a swapped-in shape to the slot it replaces.
beadpot `graph/transform/swap_slots.py::LinkSwapSlots`. Penpot records a
component sub-shape swap as a `swap-slot-<uuid>` entry in the *replacing*
shape's `touched` set, where `<uuid>` is the replaced slot shape from the
master. The entries are then stripped from `touched`, mirroring
`app.common.types.component/normal-touched-groups`."
[^Connection conn]
(let [linked
(reduce
(fn [total statement] (+ total (run-scalar! conn statement)))
0
(shape-pair-statements
(fn [from to]
(str "MATCH (s:" (nodes/match-label from) ") "
"WHERE size(s.touched) > 0 "
"UNWIND s.touched AS touched_key "
"WITH s, touched_key "
"WHERE STARTS_WITH(touched_key, '" swap-slot-prefix "') "
"WITH s, CAST(" slot-uuid-expr ", 'UUID') AS slot_id "
"MATCH (t:" (nodes/match-label to) ") "
"WHERE t.id = slot_id AND s.id <> t.id "
"MERGE (s)-[r:FillsSwapSlot {slot_id: slot_id}]->(t) "
"RETURN count(r);"))))]
;; Strip unconditionally: an entry may name a slot that was garbage
;; collected, so "no edge created" does not mean "nothing to strip".
(doseq [table nodes/shape-tables]
(ladybug/exec-on-connection!
conn
[(str "MATCH (s:" (nodes/match-label table) ") "
"WHERE size(s.touched) > 0 "
"SET s.touched = list_filter(s.touched, x -> "
"NOT STARTS_WITH(x, '" swap-slot-prefix "'));")]))
linked))
(def registry
"Every transform this backend applies, in application order.
`:id` is the shared vocabulary with beadpot (`app.graph.meta`); `:rel` names
what the transform produces, for the ingest report."
[{:id "link-component-instances" :rel :IsInstanceOf :run link-component-instances!}
{:id "link-shape-refs" :rel :RefersTo :run link-shape-refs!}
{:id "link-swap-slots" :rel :FillsSwapSlot :run link-swap-slots!}])
(defn apply-transforms!
"Apply derived transformations on an already loaded graph."
"Apply every registered transform to an already loaded graph.
Returns `{:ids [...] :counts {...} :transforms n}`; `:ids` is what the build
records in `GraphMeta`, so beadpot subtracts exactly this set from its own
pipeline."
[_system ^Connection conn _data _file]
(let [n (link-component-instances! conn)]
{:transforms 1
:IsInstanceOf n}))
(reduce
(fn [acc {:keys [id rel run]}]
(let [n (run conn)]
(l/inf :hint "graph transform" :transform id :edges n)
(-> acc
(update :ids conj id)
(update :counts assoc rel n)
(assoc rel n))))
{:ids [] :counts {} :transforms (count registry)}
registry))
(defn transform-ids
"Ids of every transform in the registry."
[]
(mapv :id registry))

View File

@ -6,7 +6,8 @@
(ns app.graph.report
(:require
[clojure.core :as c]))
[clojure.core :as c]
[clojure.string :as str]))
(defn- println!
[& lines]
@ -44,6 +45,10 @@
(section-title "Transforms")
(println! (kv-line "Applied" (or (:transforms transforms) 0)))
(doseq [[rel count] (sort-by key (:counts transforms))]
(println! (kv-line (c/name rel) count)))
(when-let [ids (seq (:ids transforms))]
(println! (kv-line "Recorded" (str/join ", " ids))))
(when stats
(section-title "Graph counts")

View File

@ -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 app.graph.schema.contract
"The graph-schema contract shared with beadpot.
Penpot is authoritative on the *design model*: what a shape is, what a
component means, which attributes exist. beadpot is authoritative on the
*graph schema*: the table and column names, and the Ladybug types, that
downstream consumers (ML graph mappings, featurization) read. A graph this
backend writes must therefore be indistinguishable, to those consumers, from
one beadpot's Python pipeline writes.
Everything that could drift between the two lives here, as data:
- `column-name` maps a Penpot key to its beadpot column. The rule is
snake_case of the key; `renames` records every exception.
- `dropped-keys` names Penpot keys that deliberately have no column.
- `type-overrides` pins the Ladybug type where the Malli-derived one
(`app.graph.schema.types`) differs from beadpot's and the difference is
load-bearing for a consumer.
Each entry carries its reason. A new divergence must be added here, which is
the point: `backend_tests.graph_contract_test` walks the checked-in beadpot
manifest (`resources/app/graph/beadpot-schema.json`, produced by
`bp graph schema export`) and fails on anything this namespace does not
account for. Schema drift becomes a failing test with a precise message
instead of a silently renamed column in a training set."
(:require
[clojure.string :as str]))
(def ^:private renames
"Penpot key → beadpot column name, where the two differ.
Keyed by the Penpot key alone: no shape type gives one of these a second
meaning, so a per-table map would only add ceremony."
{;; beadpot names the discriminant after the table (`BooleanNode`), not
;; after Penpot's `:bool` shape type.
:bool-type "boolean_type"
;; beadpot keeps the wire name `component-root` out of the graph because
;; the column records what the *file* saved, which can lag what the shape
;; tree implies — `saved_` marks it as the stored value, not a derivation.
:component-root "saved_component_root"
;; Penpot stores a list under a singular key; beadpot pluralizes it.
:shadow "shadows"
;; beadpot spells out the revision number.
:revn "revision"})
(def dropped-keys
"Penpot keys projected by the Malli registry that get no beadpot column.
Dropping is the right call only when the column would be dead weight
downstream; anything a consumer might learn from belongs in beadpot instead
(see `pending-beadpot-columns`)."
{:deleted-at
"Only non-nil for a soft-deleted file, and a deleted file is never ingested."
:pixel-grid-color
"Viewer chrome: the color of the editor's pixel grid, not design content."
:pixel-grid-opacity
"Viewer chrome, as above."})
(def pending-beadpot-columns
"Penpot keys that *should* become beadpot columns but do not exist there yet.
Distinct from `dropped-keys` on purpose: these are a debt beadpot owes,
not a decision to discard data. The contract test reports them separately so
a new upstream attribute cannot be quietly buried in the drop list."
{:background-blur
"Landed upstream behind a default-on flag; beadpot has no field for it yet."})
(def ^:private per-table-dropped
"Keys dropped only on certain tables.
`:grids` is the standing case: Penpot's shape schema admits it on every
shape, but only a Frame ever carries one, and beadpot models it on Frame
alone. Emitting an always-null column on ten other tables would widen every
multi-table scan for nothing."
{:grids #{"Boolean" "Circle" "Group" "Image" "Path" "Rectangle" "SVGRaw" "Text"}})
(def type-overrides
"Ladybug column type per beadpot column name, where beadpot's differs.
`app.graph.schema.types` derives a type from the Malli schema, which is the
right default but coarser than beadpot in places: a Malli `:map` becomes
`JSON`, where beadpot may use a native Ladybug MAP or a fixed-size array
that a consumer can read as a tensor without parsing.
Only load-bearing divergences are pinned here, in the order they became
load-bearing; the rest are reported by the contract test and closed by
moving the whole DDL onto the beadpot manifest."
{;; `LinkAppliedTokens` (beadpot) reads this with `map_keys` /
;; `map_extract`; as JSON the transform cannot run at all.
"applied_tokens" "MAP(STRING, STRING)"})
(defn column-name
"The beadpot column name for Penpot key `k`.
Default: snake_case of the key. `renames` overrides."
[k]
(or (get renames k)
(str/replace (name k) "-" "_")))
(defn drop-key?
"Should key `k` be omitted from `table`'s columns?"
[table k]
(or (contains? dropped-keys k)
(contains? (get per-table-dropped k #{}) table)))
(defn ladybug-type
"beadpot's Ladybug type for `column`, or `fallback` when it agrees."
[column fallback]
(get type-overrides column fallback))

View File

@ -9,19 +9,25 @@
Each registry entry declares Penpot Malli sources plus projection
options (`:drop`, optional `:extra`). Derived artifacts — Ladybug
DDL, CSV columns, validation, type dispatch — all flow from that."
DDL, CSV columns, validation, type dispatch — all flow from that.
Column *names* and *types* are not ours to choose: they are the
contract downstream consumers read, and beadpot owns it. Every
divergence between a Penpot key and its column lives in
`app.graph.schema.contract`."
(:require
[app.common.exceptions :as ex]
[app.common.schema :as sm]
[app.common.types.component :as ctk]
[app.common.types.file :as ctf]
[app.common.types.page :as ctp]
[app.graph.schema.contract :as contract]
[app.graph.schema.projection :as projection]
[app.graph.schema.types :as types]
[clojure.string :as str]))
(def schema-version
"penpot-graph-slice-3")
"penpot-graph-slice-4")
;; beadpot/graph/schemas.py drop_fields
(def ^:private document-projection
@ -128,23 +134,35 @@
(nth entry 2)
(nth entry 1)))
(defn column-name
"beadpot column name for projected key `k` on `table`."
[_table k]
(contract/column-name k))
(defn column-ladybug-type
"Ladybug column type for projected key `k` on `table`."
[table k]
(some (fn [entry]
(when (= k (first entry))
(types/ladybug-type (entry-child-schema entry))))
(contract/ladybug-type (column-name table k)
(types/ladybug-type (entry-child-schema entry)))))
(projection/schema-map-entries (:schema (node-entry table)))))
(defn column-keys
"Projected column keys for `table`, in registry order."
"Projected column keys for `table`, in registry order.
Keys the beadpot contract drops on this table are omitted, so column
order, the CSV header and the DDL cannot disagree about what exists."
[table]
(mapv first (projection/schema-map-entries (:schema (node-entry table)))))
(into []
(comp (map first)
(remove #(contract/drop-key? table %)))
(projection/schema-map-entries (:schema (node-entry table)))))
(defn columns
"Projected column names for `table`, in registry order."
[table]
(mapv name (column-keys table)))
(mapv #(column-name table %) (column-keys table)))
(def ^:private validate-node-fn
(memoize
@ -211,18 +229,17 @@
table))
(defn cypher-property-key
"Backtick-wrapped property key for inline Cypher literals."
[k]
(str "`" (name k) "`"))
"Backtick-wrapped beadpot column name for inline Cypher literals."
[table k]
(str "`" (column-name table k) "`"))
(defn- create-node-table-ddl
[{:keys [table pk schema]}]
(let [cols (for [entry (projection/schema-map-entries schema)
:let [k (first entry)
child (entry-child-schema entry)]]
(str "`" (name k) "` " (types/ladybug-type child)))]
[{:keys [table pk]}]
(let [cols (for [k (column-keys table)]
(str "`" (column-name table k) "` " (column-ladybug-type table k)))]
(str "CREATE NODE TABLE `" table "` ("
(str/join ", " (concat cols [(str "PRIMARY KEY (`" (name pk) "`)")]))
(str/join ", " (concat cols
[(str "PRIMARY KEY (`" (column-name table pk) "`)")]))
");")))
(defn is-child-of-ddl
@ -245,8 +262,36 @@
[]
"CREATE REL TABLE `IsInstanceOf` (FROM `Frame` TO `Component`);")
(defn- shape-to-shape-rel-ddl
"A rel table over the full shape × shape product.
Created up-front rather than on demand: the bulk loader must never race on
lazy table creation, and a consumer can then tell \"this producer cannot
emit that pair\" from \"this document happens to have none\" (beadpot
`graph.manifest/REL_FAMILIES`)."
[rel props]
(str "CREATE REL TABLE `" rel "` ("
(str/join ", " (for [from shape-tables
to shape-tables]
(str "FROM `" from "` TO `" to "`")))
(when (seq props) (str ", " (str/join ", " props)))
");"))
(defn refers-to-ddl
"Instance shape → its homologue in the component main instance
(beadpot `RefersTo`, from `shape-ref`)."
[]
(shape-to-shape-rel-ddl "RefersTo" nil))
(defn fills-swap-slot-ddl
"Swapped-in shape → the slot shape it replaces (beadpot `FillsSwapSlot`)."
[]
(shape-to-shape-rel-ddl "FillsSwapSlot" ["`slot_id` UUID"]))
(defn ddl-statements
[]
(conj (mapv create-node-table-ddl node-types)
(is-child-of-ddl)
(is-instance-of-ddl)))
(-> (mapv create-node-table-ddl node-types)
(conj (is-child-of-ddl))
(conj (is-instance-of-ddl))
(conj (refers-to-ddl))
(conj (fills-swap-slot-ddl))))

View File

@ -13,6 +13,17 @@
[conn statement]
(or (ladybug/query-scalar-on-connection! conn statement) 0))
(defn- rel-table-names
"Relationship tables present in the open database.
Read from the catalog so a newly ported transform's edges are counted
without this namespace being told about it."
[conn]
(->> (ladybug/query-on-connection!
conn "CALL show_tables() WHERE type = 'REL' RETURN name;" :max-rows 1000)
:rows
(map first)))
(defn summarize-connection
"Return node/edge counts using an open Ladybug connection."
[conn]
@ -23,12 +34,13 @@
(str "MATCH (n:" (nodes/match-label table) ") "
"RETURN count(n) AS " table "_c;"))])
(map :table nodes/node-types)))
:edges {:IsChildOf (count-on-connection
conn
"MATCH ()-[e:IsChildOf]->() RETURN count(e) AS IsChildOf_c;")
:IsInstanceOf (count-on-connection
conn
"MATCH ()-[e:IsInstanceOf]->() RETURN count(e) AS IsInstanceOf_c;")}})
:edges (into {}
(map (fn [rel]
[(keyword rel)
(count-on-connection
conn
(str "MATCH ()-[e:`" rel "`]->() RETURN count(e) AS c;"))]))
(rel-table-names conn))})
(defn summarize
"Return node/edge counts from the graph database."

View File

@ -10,6 +10,7 @@
[app.common.logging :as l]
[app.common.uuid :as uuid]
[app.graph.ladybug :as ladybug]
[app.graph.project.document :as project.document]
[app.graph.schema.nodes :as nodes]
[clojure.string :as str])
(:import
@ -111,7 +112,18 @@
:parent-id parent-id
:parent-table parent-table
:position (long (:position edge 0))
:page-id (resolve-page-id shape-id parents pages)}]))
;; 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
;; `:add-obj` children inherit — it is the shape's effective
;; component-id, which loses the barrier case of a *non-Frame*
;; carrying its own `component-id` (indistinguishable once
;; denormalized). Cold projection, which beadpot diffs against,
;; keeps the distinction; only a graph synced across such a
;; shape can drift, and a Reload rebuilds it.
:component-ctx (:component-id attrs)
:page-id (or (:page-id attrs)
(resolve-page-id shape-id parents pages))}]))
(defn- index-shapes
[nodes edges parents pages]
@ -150,7 +162,7 @@
pairs (for [k (nodes/column-keys table)
:let [v (get attrs k)]
:when (some? v)]
(str (nodes/cypher-property-key k) ": "
(str (nodes/cypher-property-key table k) ": "
(format-node-value table k v)))]
(str "CREATE (:" label " {" (str/join ", " pairs) "});")))
@ -206,7 +218,7 @@
(defn- set-node-attr-statement
[table shape-id attr value]
(str "MATCH (s:" (nodes/match-label table) " {id: " (ladybug/format-uuid shape-id) "}) "
"SET s." (nodes/cypher-property-key attr) " = "
"SET s." (nodes/cypher-property-key table attr) " = "
(format-node-value table attr value) ";"))
(defn- set-page-name-statement
@ -218,7 +230,7 @@
"Clear a property. Ladybug has no Neo4j-style REMOVE; SET to NULL."
[table shape-id attr]
(str "MATCH (s:" (nodes/match-label table) " {id: " (ladybug/format-uuid shape-id) "}) "
"SET s." (nodes/cypher-property-key attr) " = NULL;"))
"SET s." (nodes/cypher-property-key table attr) " = NULL;"))
(defn- index-add-component!
[index {:keys [id name doc-id]}]
@ -401,7 +413,16 @@
(if-not parent
{:index index :statements [] :applied? false :reason :missing-parent}
(let [position (long (or pos (default-position index (:parent-id parent))))
attrs (nodes/project-attrs table (assoc obj :id id))
;; 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])
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)
@ -417,8 +438,9 @@
:parent-id (:parent-id parent)
:parent-table (:parent-table parent)
:position position
:page-id (or page-id (when (= (:parent-table parent) "Page")
(:parent-id parent)))})
:component-ctx (project.document/descend-component-ctx
table shape parent-ctx)
:page-id resolved-page-id})
:statements stmts
:applied? true}))))))

View File

@ -343,28 +343,72 @@
;; backend boot. The routes below are registered only under the `:graph` flag,
;; so with the flag off nothing resolves and no native code loads.
(defn- graph-export-file
"Path of a freshly projected graph for `file-id`."
[cfg file-id]
(let [ingest-file! (requiring-resolve 'app.graph.ingest/ingest-file!)
{:keys [db-path]} (ingest-file! cfg file-id :skip-stats? true)]
(when-not (fs/exists? db-path)
(ex/raise :type :internal
:code :graph-file-not-found
:hint "graph database file missing after ingest"
:file-id (str file-id)
:db-path db-path))
db-path))
(defn- graph-export-session
"Path of a snapshot of the caller's live in-memory graph for `file-id`."
[profile-id file-id]
(let [session-info (requiring-resolve 'app.graph.debug/session-info)
export-session-database! (requiring-resolve 'app.graph.debug/export-session-database!)
info (session-info profile-id)]
(when-not info
(ex/raise :type :not-found
:code :graph-session-not-loaded
:hint "no in-memory graph is loaded; load one first, or use source=file"))
(when-not (= file-id (:file-id info))
(ex/raise :type :validation
:code :graph-session-file-mismatch
:hint "the loaded session holds a different file"
:requested (str file-id)
:loaded (str (:file-id info))))
(export-session-database! profile-id)))
(defn graph-export-handler
"Build (or rebuild) the Ladybug graph for a file and stream the `.lbug`
database. MVP: synchronous ingest on each request."
[cfg {:keys [params]}]
(let [file-id (some-> params :file-id parse-uuid)]
"Stream a Ladybug `.lbug` database for a file.
`source=file` (default) projects the file afresh from the database — the
reproducible artifact. `source=session` snapshots the caller's live
in-memory console graph instead, which live-sync may have moved away from a
fresh projection; taking that away to query it elsewhere is the whole point
of asking for it. Synchronous on each request."
[cfg {:keys [params] :as request}]
(let [file-id (some-> params :file-id parse-uuid)
source (or (some-> params :source str/lower) "file")]
(when-not file-id
(ex/raise :type :validation
:code :missing-arguments
:hint "missing file-id"))
(when-not (contains? #{"file" "session"} source)
(ex/raise :type :validation
:code :invalid-arguments
:hint "source must be 'file' or 'session'"
:source source))
(let [ingest-file! (requiring-resolve 'app.graph.ingest/ingest-file!)
{:keys [db-path]} (ingest-file! cfg file-id :skip-stats? true)]
(when-not (fs/exists? db-path)
(ex/raise :type :internal
:code :graph-file-not-found
:hint "graph database file missing after ingest"
:file-id (str file-id)
:db-path db-path))
(let [session? (= "session" source)
db-path (if session?
(graph-export-session (::session/profile-id request) file-id)
(graph-export-file cfg file-id))]
{::yres/status 200
;; A session export is a temp file this request owns; deleting it on
;; close would race the streaming body, so it is left for the OS temp
;; sweep. A file export is the canonical per-file database and is meant
;; to persist.
::yres/body (io/input-stream db-path)
::yres/headers {"content-type" "application/octet-stream"
"content-disposition" (str "attachment; filename=" file-id ".lbug")}})))
"content-disposition"
(str "attachment; filename=" file-id
(when session? "-session") ".lbug")}})))
(defn- graph-console-response
[data]