mirror of
https://github.com/penpot/penpot.git
synced 2026-09-08 19:59:54 -04:00
Compare commits
77
Commits
No files matched your search
@@ -6,6 +6,7 @@ Backend: JVM Clojure; Integrant; PostgreSQL; Redis/Valkey; RPC; HTTP; storage; m
|
||||
|
||||
- RPC, DB helpers, workers, cron: `mem:backend/rpc-db-worker-subtleties`
|
||||
- HTTP sessions, config, storage, media, file data persistence: `mem:backend/http-storage-filedata-subtleties`
|
||||
- Embedded Ladybug graph experiment, projection, incremental sync, console, and risks: `mem:backend/graph-experiment`
|
||||
- Auth flows, permission model, teams, projects, invitations, comments, webhooks, audit: `mem:backend/auth-permissions-product-domains`
|
||||
- Services, task-queue/Pub-Sub topology constraints -> `mem:prod-infra/core`.
|
||||
|
||||
@@ -107,4 +108,3 @@ IMPORTANT: all CLI commands must be executed from the `backend/` subdirectory. J
|
||||
* **Isolated run:** `clojure -M:dev:test --focus backend-tests.my-ns-test` for a specific test namespace.
|
||||
* **Regression run:** `clojure -M:dev:test` to ensure no regressions in related functional areas.
|
||||
* **Principles:** Cross-cutting testing principles, anti-patterns, and verification checklist: `mem:testing`.
|
||||
|
||||
@@ -0,0 +1,632 @@
|
||||
# Graph Experiment
|
||||
|
||||
## Scope
|
||||
|
||||
- Purpose: project Penpot file data into an embedded Ladybug graph database.
|
||||
- Purpose: keep the graph current with Penpot file changes.
|
||||
- Purpose: expose a read-only graph console for backend debugging.
|
||||
- This is an experiment, not a replacement for PostgreSQL file storage.
|
||||
- The graph subsystem is off unless `:graph` is in the backend flags.
|
||||
- The main Penpot frontend has no graph feature code for this subsystem.
|
||||
- The graph console is a backend-served HTML template with JavaScript.
|
||||
|
||||
## Memory Links
|
||||
|
||||
- Read `mem:backend/core` for backend architecture, HTTP routes, DB rules, and test commands.
|
||||
- Read `mem:backend/rpc-db-worker-subtleties` for RPC and message bus behavior.
|
||||
- Read `mem:backend/http-storage-filedata-subtleties` for file data loading and realization.
|
||||
- Read `mem:common/changes-architecture` for the change record vocabulary.
|
||||
- Read `mem:frontend/routing-app-shell-subtleties` for the existing notification WebSocket.
|
||||
- Read `mem:prod-infra/core` for Redis or Valkey message bus topology.
|
||||
|
||||
## Branch Surface
|
||||
|
||||
- The graph experiment adds about 6,336 lines and changes about 27 files.
|
||||
- The graph implementation lives under `backend/src/app/graph/`.
|
||||
- The graph console lives at `backend/resources/app/templates/graph-console.tmpl`.
|
||||
- The existing debug page gains graph links in `backend/resources/app/templates/debug.tmpl`.
|
||||
- The existing debug HTTP routes gain graph handlers in `backend/src/app/http/debug.clj`.
|
||||
- The backend system passes the message bus to the debug route component in `backend/src/app/main.clj`.
|
||||
- The backend adds Ladybug and Arrow dependencies in `backend/deps.edn`.
|
||||
- The backend adds JVM options for Ladybug and Arrow native access.
|
||||
- The common flag registry adds `:graph` in `common/src/app/common/flags.cljc`.
|
||||
- The graph experiment adds `graph_sync_parity_test.clj` and `graph_binder_gate_test.clj`.
|
||||
|
||||
## System Model
|
||||
|
||||
### Storage layers
|
||||
|
||||
- PostgreSQL remains the source of truth for Penpot files.
|
||||
- The graph database stores a projection of one file.
|
||||
- A persistent graph uses a `.lbug` path under `PENPOT_GRAPH_DIR`.
|
||||
- The default graph directory is `/tmp/penpot-graph`.
|
||||
- A debug session uses a Ladybug `:memory:` database.
|
||||
- A debug session database lives inside the backend JVM process.
|
||||
- A debug session does not survive a backend restart.
|
||||
- A debug session does not store file data back to PostgreSQL.
|
||||
|
||||
### Two graph update paths
|
||||
|
||||
- Cold projection reads the complete file and rebuilds the graph.
|
||||
- Incremental sync reads file change records and updates the open graph.
|
||||
- Both paths must produce the same graph for the same file state.
|
||||
- The parity test treats cold projection as the reference path.
|
||||
- A reload discards the session graph and uses cold projection again.
|
||||
|
||||
## Main Namespaces
|
||||
|
||||
### `app.graph.ladybug`
|
||||
|
||||
- Opens and closes Ladybug `Database` and `Connection` objects.
|
||||
- Installs and loads the Ladybug JSON extension.
|
||||
- Executes Cypher statements.
|
||||
- Executes prepared statements.
|
||||
- Binds scalar parameters.
|
||||
- Formats UUID, string, integer, number, JSON, and timestamp values.
|
||||
- Formats compound values such as arrays, maps, and structs.
|
||||
- Converts Ladybug values back to Clojure values.
|
||||
- Limits normal query results to 200 rows by default.
|
||||
- Detects result truncation with `:truncated?`.
|
||||
- Uses query timeout `0` by default.
|
||||
- Query timeout `0` disables the timeout.
|
||||
- Provides `validate-on-connection!` for parse, bind, and read-only checks.
|
||||
- `exec-prepared-on-connection!` prepares every statement before the first execution.
|
||||
- A prepare failure stops the batch before a mutation runs.
|
||||
|
||||
### `app.graph.schema`
|
||||
|
||||
- Provides the public schema facade.
|
||||
- Exposes schema version `penpot-graph-slice-4`.
|
||||
- Delegates node and relationship definitions to `app.graph.schema.nodes`.
|
||||
|
||||
### `app.graph.schema.nodes`
|
||||
|
||||
- Holds the single registry for graph node tables.
|
||||
- Generates node DDL.
|
||||
- Generates relationship DDL.
|
||||
- Maps Penpot shape types to graph tables.
|
||||
- Projects source attributes into graph attributes.
|
||||
- Formats graph column values.
|
||||
- Quotes reserved graph labels such as `Group` and `Boolean`.
|
||||
- Defines container tables and shape tables.
|
||||
- Defines `IsChildOf`, `IsInstanceOf`, `RefersTo`, and `FillsSwapSlot`.
|
||||
|
||||
### `app.graph.schema.contract`
|
||||
|
||||
- Records deliberate graph contract decisions.
|
||||
- Renames graph columns such as `:revn` to `revision`.
|
||||
- Drops attributes that do not belong in this graph slice.
|
||||
- Records attributes that the graph does not project.
|
||||
- Applies per-table dropped attributes.
|
||||
- Defines type overrides for vectors, transforms, colors, maps, and JSON arrays.
|
||||
- Maps selected map keys to the frontend JSON naming convention.
|
||||
- `:background-blur` remains a declared unprojected attribute.
|
||||
|
||||
### `app.graph.schema.projection`
|
||||
|
||||
- Derives projected schemas from canonical Malli schemas.
|
||||
- Builds the projected document schema.
|
||||
- Builds projected shape schemas.
|
||||
- Selects the schema for each shape type.
|
||||
|
||||
### `app.graph.schema.types`
|
||||
|
||||
- Maps Malli types to Ladybug types.
|
||||
- Maps matrices to `DOUBLE[6]`.
|
||||
- Maps points to `DOUBLE[2]`.
|
||||
- Maps rectangles to `DOUBLE[4]`.
|
||||
- Maps colors to `UINT32`.
|
||||
- Maps collections to Ladybug arrays.
|
||||
- Maps `:map-of` schemas to `MAP`.
|
||||
- Maps closed scalar maps to `STRUCT`.
|
||||
- Maps other complex values to `JSON`.
|
||||
|
||||
### `app.graph.schema.values`
|
||||
|
||||
- Coerces source values to graph column values.
|
||||
- Writes fixed vectors with deterministic order.
|
||||
- Packs colors into the graph color representation.
|
||||
- Sorts set values when deterministic output is needed.
|
||||
|
||||
### `app.graph.arrow`
|
||||
|
||||
- Loads projection rows with Apache Arrow.
|
||||
- Creates temporary staged node and relationship tables.
|
||||
- Uses `COPY ... FROM (MATCH ...)` for bulk loading.
|
||||
- Groups relationship loads by source and target table pair.
|
||||
- Resolves relationship endpoints with joins.
|
||||
- Does not use `createArrowRelTable` for UUID relationship endpoints.
|
||||
- Keeps the Arrow `RootAllocator` alive until Ladybug releases staged buffers.
|
||||
- Closes the allocator after the connection and database close sequence.
|
||||
|
||||
### `app.graph.ingest`
|
||||
|
||||
- Fetches a complete file with `bfc/get-file` and `:realize? true`.
|
||||
- Rejects missing files.
|
||||
- Rejects files without file data.
|
||||
- Can run file data validation before projection.
|
||||
- Creates the DDL.
|
||||
- Loads nodes and edges through Arrow.
|
||||
- Executes post-load transforms.
|
||||
- Writes graph metadata last.
|
||||
- Treats the final metadata write as the complete-build marker.
|
||||
- Supports a persistent database path and an open connection.
|
||||
|
||||
### `app.graph.projection.document`
|
||||
|
||||
- Projects `Document`, `Page`, `Component`, and supported shape nodes.
|
||||
- Skips the page root frame.
|
||||
- Creates `IsChildOf` edges from shapes to parents.
|
||||
- Creates page edges to the document.
|
||||
- Creates component edges to the document.
|
||||
- Stores page order in `Page.index` and edge `position`.
|
||||
- Reverses the stored `:shapes` list for Penpot z-order.
|
||||
- Adds `page-id` to every projected shape.
|
||||
- Propagates an instance head `component-id` to descendants.
|
||||
- Stops component inheritance at a non-Frame shape with its own component ID.
|
||||
- Skips deleted components during cold projection.
|
||||
- Logs unsupported shape types and missing shape records.
|
||||
|
||||
### `app.graph.projection.transforms`
|
||||
|
||||
- Runs after the base nodes and edges load.
|
||||
- `link-component-instances` creates `IsInstanceOf` edges.
|
||||
- A Frame needs `component-file` to qualify as an instance head.
|
||||
- `link-shape-refs` creates `RefersTo` edges from `shape-ref`.
|
||||
- Ladybug limits multi-label relationship `MERGE` statements.
|
||||
- The transform emits one statement for each shape-table pair.
|
||||
- `link-swap-slots` creates `FillsSwapSlot` edges.
|
||||
- Swap slot IDs come from `swap-slot-<uuid>` entries in `touched`.
|
||||
- The transform removes swap slot entries from `touched` after edge creation.
|
||||
- The transform order matters because it reads and then changes `touched`.
|
||||
|
||||
### `app.graph.meta`
|
||||
|
||||
- Stores graph provenance in `GraphMeta`.
|
||||
- Stores schema version, source revision, producer, and build time.
|
||||
- The source revision identifies the file revision used for cold projection.
|
||||
|
||||
### `app.graph.stats` and `app.graph.report`
|
||||
|
||||
- `app.graph.stats` counts graph nodes and relationships from the live catalog.
|
||||
- `app.graph.report` prints ingest information for REPL use.
|
||||
|
||||
## Cold Projection Flow
|
||||
|
||||
1. Get the file row and realized file data from PostgreSQL.
|
||||
2. Read the file revision from the file row.
|
||||
3. Build the node and edge projection.
|
||||
4. Create all graph tables from the graph schema.
|
||||
5. Load node rows with Arrow.
|
||||
6. Load relationship rows with Arrow.
|
||||
7. Run `CHECKPOINT;`.
|
||||
8. Run the registered derived transforms.
|
||||
9. Write `GraphMeta` as the final build step.
|
||||
10. Return file ID, file revision, database path, projection stats, and transform stats.
|
||||
|
||||
### Projection node groups
|
||||
|
||||
- `Document` contains file-level attributes without the file data blob.
|
||||
- `Document.options` receives file-level options from the data blob.
|
||||
- `Page` contains page attributes without the page object map.
|
||||
- `Component` contains component attributes without component object maps.
|
||||
- Shape tables contain the supported shape attributes.
|
||||
- The graph stores selected derived attributes such as `page-id`.
|
||||
|
||||
### Projection relationship groups
|
||||
|
||||
- Structural edges use `IsChildOf`.
|
||||
- Page and component edges point to `Document`.
|
||||
- Derived edges come from the post-load transform registry.
|
||||
|
||||
## Incremental Sync
|
||||
|
||||
### Change source
|
||||
|
||||
- `app.rpc.commands.files-update` persists the file update first.
|
||||
- The same command publishes a `:file-change` message to the file topic.
|
||||
- The topic key is the file UUID.
|
||||
- The message contains the file ID, profile ID, session ID, revision, version, and changes.
|
||||
- Library changes also publish a team-topic message.
|
||||
- The graph session only consumes the file-topic `:file-change` messages.
|
||||
|
||||
### Session subscription
|
||||
|
||||
- `app.graph.debug/start-sync-loop!` creates a channel with a dropping buffer of 64.
|
||||
- The session subscribes the channel to the file UUID topic.
|
||||
- The loop reads one message at a time.
|
||||
- The loop ignores message types other than `:file-change`.
|
||||
- The loop stops when the channel closes.
|
||||
- `destroy-session!` closes the channel and purges its message bus subscription.
|
||||
|
||||
### Session state
|
||||
|
||||
- Sessions are stored in a global `defonce` atom.
|
||||
- The map key is the string form of `profile-id`.
|
||||
- One profile has one graph session.
|
||||
- Loading another file first destroys the old session.
|
||||
- A session stores the Ladybug database and connection.
|
||||
- A session stores a shared lock for graph access.
|
||||
- A session stores file metadata.
|
||||
- A session stores the incremental sync index.
|
||||
- A session stores the message bus channel.
|
||||
- A session stores load time and profile ID.
|
||||
- The session keeps projection statistics but drops full projection rows after index creation.
|
||||
|
||||
### Sync index
|
||||
|
||||
- `build-index` starts from the complete cold projection.
|
||||
- The index stores the graph file ID and document ID.
|
||||
- The index stores the current graph revision.
|
||||
- The index stores page IDs, names, and positions.
|
||||
- The index stores component IDs, names, and deleted state.
|
||||
- The index stores shape table, parent, position, frame, page, and component context.
|
||||
- The index stores child IDs by parent ID.
|
||||
- The index supports later change application without another PostgreSQL file read.
|
||||
|
||||
### Change application
|
||||
|
||||
- `apply-changes!` processes the change list in source order.
|
||||
- Each supported change returns a new index and a list of Cypher statements.
|
||||
- Unsupported changes enter the `:skipped` result.
|
||||
- Supported changes enter the `:applied` result.
|
||||
- The function collects all statements before it executes them.
|
||||
- The function appends a document revision statement when at least one change applies.
|
||||
- The index revision advances only when at least one change applies.
|
||||
- A larger incoming revision than the index revision creates a warning.
|
||||
- A revision gap does not trigger catch-up.
|
||||
|
||||
### Shape change rules
|
||||
|
||||
- `:add-obj` reuses `projection.document/denormalized-shape`.
|
||||
- `:add-obj` creates the shape node and its parent edge.
|
||||
- `:mod-obj` applies supported `:set` operations to graph columns.
|
||||
- `:mod-obj` keeps false and zero values as values.
|
||||
- `:del-obj` deletes shapes in deep post-order.
|
||||
- `:mov-objects` detaches shapes from the old parent.
|
||||
- `:mov-objects` closes the old sibling position gap.
|
||||
- `:mov-objects` inserts shapes at the new position.
|
||||
- `:mov-objects` updates `parent_id` and `frame_id`.
|
||||
- `:mov-objects` rewrites container `shapes` values.
|
||||
- The parent columns and child lists must match a cold projection.
|
||||
|
||||
### Page and component change rules
|
||||
|
||||
- Page add creates a projected page node and a document edge.
|
||||
- Page delete removes the page subtree.
|
||||
- Page modification updates supported page attributes.
|
||||
- Component add creates a component node and document edge.
|
||||
- Component modification updates supported component attributes.
|
||||
- Component delete uses a soft-delete state.
|
||||
- Component restore removes the soft-delete state.
|
||||
- Component purge removes the component node and document edge.
|
||||
- Component sync paths need more parity coverage than the current tests provide.
|
||||
|
||||
## Session Locking
|
||||
|
||||
- The sync loop and HTTP handlers share one lock per session.
|
||||
- The lock protects one Ladybug connection from concurrent access.
|
||||
- Queries acquire the lock before binder validation and execution.
|
||||
- Graph data export acquires the lock before catalog reads.
|
||||
- Session export acquires the lock before `EXPORT DATABASE`.
|
||||
- A long query blocks sync for the same session.
|
||||
- A sync batch blocks queries for the same session.
|
||||
- Ladybug connection thread safety is not assumed.
|
||||
|
||||
## Graph Query Rules
|
||||
|
||||
- The console accepts Cypher text.
|
||||
- Blank query text raises a validation error.
|
||||
- The query first passes Ladybug prepare and bind checks.
|
||||
- The query must pass the engine read-only analysis.
|
||||
- A mutating query is rejected.
|
||||
- The graph console does not provide a write path.
|
||||
- A session graph is rebuilt from the file by Reload.
|
||||
- Normal query results have a 200-row limit.
|
||||
- Query results use string values for the HTML console representation.
|
||||
- JSON requests receive a Transit JSON response with the query and result.
|
||||
- HTML requests receive the rendered console with the result.
|
||||
|
||||
## Graph Data Export
|
||||
|
||||
### G6 data
|
||||
|
||||
- `/dbg/actions/graph-data` reads the live Ladybug database.
|
||||
- It does not read the sync index for nodes and edges.
|
||||
- It therefore shows database drift if a batch fails after index update.
|
||||
- Node export covers all registered node tables.
|
||||
- Relationship export reads the Ladybug relationship catalog.
|
||||
- Relationship export includes source, target, relationship name, and position.
|
||||
- Node and relationship export uses a 100,000-row limit.
|
||||
- The response reports `truncated` when a limit cuts the result.
|
||||
- The response reports buffer-manager memory usage.
|
||||
|
||||
### `.lbug` export
|
||||
|
||||
- `source=file` rebuilds the persistent graph from PostgreSQL file data.
|
||||
- `source=file` runs a synchronous full ingest for each request.
|
||||
- `source=session` exports the caller profile's live in-memory graph.
|
||||
- Session export uses Ladybug `EXPORT DATABASE` to Parquet files.
|
||||
- Session export creates a new `.lbug` database with `IMPORT DATABASE`.
|
||||
- The temporary Parquet staging directory is deleted after import.
|
||||
- The final session `.lbug` file remains in the system temporary directory.
|
||||
- The HTTP response streams the database file to the caller.
|
||||
|
||||
## HTTP Routes and Access
|
||||
|
||||
- The graph routes live in `backend/src/app/http/debug.clj`.
|
||||
- The graph route list is added only when `:graph` is enabled.
|
||||
- `/dbg/graph` serves the graph console page.
|
||||
- `/dbg/actions/graph-files` returns the profile file tree.
|
||||
- `/dbg/actions/graph-load` loads a file into the profile session.
|
||||
- `/dbg/actions/graph-unload` closes the profile session.
|
||||
- `/dbg/actions/graph-reload` rebuilds the loaded file graph.
|
||||
- `/dbg/actions/graph-query` runs a read-only Cypher query.
|
||||
- `/dbg/actions/graph-sync-status` returns the sync state.
|
||||
- `/dbg/actions/graph-data` returns nodes and edges for G6.
|
||||
- `/dbg/actions/graph-export` streams a `.lbug` database.
|
||||
- The `/dbg` session middleware remains active.
|
||||
- The `/dbg` admin middleware remains active.
|
||||
- A devenv host with a profile ID passes the debug authorization rule.
|
||||
- Other hosts need a profile email in the configured admin set.
|
||||
- `/dbg/actions/graph-files` lists reachable teams, projects, and files.
|
||||
- The file tree query has a 500-file limit.
|
||||
- The graph handlers resolve graph namespaces at call time.
|
||||
- The backend requires `app.graph.debug` and `app.graph.ingest` when the flag is on.
|
||||
- Ladybug native loading then fails during route initialization instead of first use.
|
||||
|
||||
## Console Frontend
|
||||
|
||||
### Page type
|
||||
|
||||
- `graph-console.tmpl` is a backend resource template.
|
||||
- It is not a Rumext component.
|
||||
- It is not part of the main frontend route table.
|
||||
- The page uses browser `fetch` calls and a browser WebSocket.
|
||||
- The page loads G6 version `5.1.1` from jsDelivr.
|
||||
|
||||
### File tree
|
||||
|
||||
- The page fetches `/dbg/actions/graph-files`.
|
||||
- The response contains team, project, and file groups.
|
||||
- The page creates the tree with DOM APIs.
|
||||
- A file click submits the graph load form.
|
||||
- The page shows a message when no file exists.
|
||||
|
||||
### Graph rendering
|
||||
|
||||
- The page fetches `/dbg/actions/graph-data`.
|
||||
- The page converts graph nodes and edges to G6 data.
|
||||
- The page skips repaint when the node and edge signature does not change.
|
||||
- The page marks added, removed, and changed graph entities.
|
||||
- The page supports tree, dagre, circular, force, and combo layouts.
|
||||
- The page supports collapsed container combos.
|
||||
- The page has render guards at 4,000 nodes and 8,000 edges.
|
||||
- The `?safe` query option bypasses the render guard.
|
||||
- The page shows graph size by node count and relationship count.
|
||||
- The page shows buffer-manager memory in MiB.
|
||||
- The page reports a CDN failure when G6 is undefined.
|
||||
|
||||
### Query result filtering
|
||||
|
||||
- A query can return `filter_*` columns with node IDs.
|
||||
- The HTML result table hides columns with the `filter_` prefix.
|
||||
- The JSON result keeps the full result.
|
||||
- The graph view uses the hidden IDs to select matching nodes.
|
||||
- The graph view re-runs the query after graph refresh.
|
||||
- This keeps the query filter aligned with the current graph.
|
||||
- A user column named `filter_*` follows the same hiding rule.
|
||||
|
||||
### Node inspector
|
||||
|
||||
- A node click creates a query for that node.
|
||||
- The inspector calls `/dbg/actions/graph-query` with JSON negotiation.
|
||||
- The inspector displays the full projected row.
|
||||
- The inspector uses table and ID values from the graph data.
|
||||
|
||||
## WebSocket Data Flow
|
||||
|
||||
1. The page opens `/ws/notifications` with a random `session-id` query value.
|
||||
2. The page sends `:subscribe-file` with a Transit UUID value.
|
||||
3. The server makes sure that the file exists and that the profile has read permission.
|
||||
4. The server subscribes the connection to the file topic.
|
||||
5. `files_update` publishes `:file-change` to the same topic.
|
||||
6. The graph session consumes the message from its message bus subscription.
|
||||
7. The WebSocket server sends the message to the browser connection.
|
||||
8. The browser adds the change to the changelog.
|
||||
9. The browser fetches sync status after 150 milliseconds.
|
||||
10. The browser fetches graph data after a 400-millisecond debounce.
|
||||
11. The browser repaints the G6 graph when the graph data changes.
|
||||
|
||||
### WebSocket reconnect behavior
|
||||
|
||||
- The page reconnects after three seconds when the socket closes.
|
||||
- The page resubscribes to the file after the socket opens.
|
||||
- The page refreshes sync status after reconnect.
|
||||
- The page refreshes graph data after reconnect.
|
||||
- Reconnect does not recover dropped message-bus changes.
|
||||
- The page shows the sync error or skipped-change state when the status reports it.
|
||||
|
||||
## Feature Flag and Runtime Dependencies
|
||||
|
||||
- `:graph` is defined in `common/src/app/common/flags.cljc`.
|
||||
- The flag is off by default.
|
||||
- `com.ladybugdb/lbug` version `0.19.1` is a backend dependency.
|
||||
- `org.apache.arrow/arrow-memory-netty` version `18.2.0` supports Arrow `RootAllocator`.
|
||||
- The JVM uses `--enable-native-access=ALL-UNNAMED`.
|
||||
- The JVM uses `--add-opens=java.base/java.nio=ALL-UNNAMED`.
|
||||
- The JVM uses `--sun-misc-unsafe-memory-access=allow`.
|
||||
- The JVM options appear in the development alias and backend launch scripts.
|
||||
- A Ladybug version change needs new binder and parity tests.
|
||||
- A JDK version change needs a startup test with the graph flag enabled.
|
||||
|
||||
## Tests
|
||||
|
||||
### `backend-tests.graph-sync-parity-test`
|
||||
|
||||
- Uses two Ladybug `:memory:` databases.
|
||||
- Does not use PostgreSQL or a live graph session.
|
||||
- Projects initial file data into database A.
|
||||
- Applies changes to database A through incremental sync.
|
||||
- Applies the same changes to file data.
|
||||
- Projects the changed file data into database B.
|
||||
- Compares every node row and relationship row.
|
||||
- Reports differences by table, row key, and column.
|
||||
- Covers shape add, shape modification, shape deletion, movement, and page changes.
|
||||
- Contains a test that injects a sync defect and expects a graph difference.
|
||||
- Does not cover all component change variants.
|
||||
- Does not cover every movement insertion mode.
|
||||
|
||||
### `backend-tests.graph-binder-gate-test`
|
||||
|
||||
- Creates the live graph DDL in a Ladybug `:memory:` database.
|
||||
- Prepares each sync statement template without executing it.
|
||||
- Detects parse errors and missing tables.
|
||||
- Detects missing columns and bad label quoting.
|
||||
- Reports the expected read-only classification.
|
||||
- Covers reserved node labels across the node registry.
|
||||
- Reports an error result for an invalid statement.
|
||||
|
||||
### Test gaps
|
||||
|
||||
- No automated HTTP handler tests cover graph routes.
|
||||
- No automated session lifecycle tests cover load and unload.
|
||||
- No automated WebSocket tests cover graph subscription.
|
||||
- No automated export tests cover persistent and session sources.
|
||||
- Component add, modify, delete, restore, and purge need parity tests.
|
||||
- Page delete needs parity coverage.
|
||||
- Movement with `:after-shape` needs parity coverage.
|
||||
- Buffer overflow and revision gap behavior need tests.
|
||||
- Partial batch failure and recovery need tests.
|
||||
- Query timeout and long-query behavior need tests.
|
||||
|
||||
## Known Risks and Limits
|
||||
|
||||
### Dropped changes
|
||||
|
||||
- The sync channel uses a dropping buffer of 64.
|
||||
- A burst can discard file-change messages.
|
||||
- The sync loop logs a revision gap when it sees a larger revision.
|
||||
- The sync loop does not fetch missing rows from `file_change`.
|
||||
- Reload is the only built-in recovery path.
|
||||
|
||||
### Partial batch state
|
||||
|
||||
- `apply-changes!` does not provide Ladybug transaction atomicity.
|
||||
- A statement failure can leave a partly changed graph.
|
||||
- The in-memory index can advance before the database state is complete.
|
||||
- `/dbg/actions/graph-data` reads the database and exposes this drift.
|
||||
- Reload rebuilds the graph from PostgreSQL file data.
|
||||
|
||||
### Query resource use
|
||||
|
||||
- The default session query timeout is zero.
|
||||
- A costly query can hold the session lock for a long time.
|
||||
- The same lock blocks incremental sync.
|
||||
- The graph export also holds the same lock during catalog reads.
|
||||
- The graph schema has a high memory floor.
|
||||
- The console reports about 115 MiB for the wide slice before file data.
|
||||
|
||||
### Session lifecycle
|
||||
|
||||
- Sessions have no TTL.
|
||||
- Sessions remain until unload, replacement, or process shutdown.
|
||||
- Each session owns native Ladybug memory.
|
||||
- Many profiles can create many native databases.
|
||||
- A profile load replaces its previous session.
|
||||
- Two browser tabs for one profile share one graph session.
|
||||
|
||||
### Temporary files
|
||||
|
||||
- Session export leaves the final `.lbug` file in the system temporary directory.
|
||||
- Long-lived servers can accumulate exported session databases.
|
||||
- The staging directory is deleted after import.
|
||||
|
||||
### Browser dependency
|
||||
|
||||
- The graph view depends on a runtime CDN request.
|
||||
- A network restriction can remove the G6 view.
|
||||
- Queries and session status still use backend endpoints without G6.
|
||||
|
||||
### Data exposure
|
||||
|
||||
- The graph console can list many files available to the profile.
|
||||
- The console can load complete projected file data.
|
||||
- The console can export a graph database.
|
||||
- The console can inspect all projected node attributes.
|
||||
- The console is safe only when the `/dbg` access boundary is correct.
|
||||
- The graph flag must remain off for deployments that do not need this tool.
|
||||
|
||||
### Contract drift
|
||||
|
||||
- The graph schema is a deliberate slice of the Penpot file model.
|
||||
- New source attributes do not enter the graph automatically in all cases.
|
||||
- Dropped and unprojected attributes need an explicit contract decision.
|
||||
- `applied_tokens` key mapping depends on the JSON naming function.
|
||||
- `filter_*` is a frontend convention, not a graph schema guarantee.
|
||||
|
||||
### Ladybug dialect coupling
|
||||
|
||||
- Cypher strings contain Ladybug-specific syntax.
|
||||
- Label quoting handles reserved labels explicitly.
|
||||
- Relationship transforms depend on Ladybug relationship limits.
|
||||
- Arrow loading depends on Ladybug `COPY FROM (MATCH ...)` behavior.
|
||||
- A dependency upgrade needs schema, binder, Arrow, and parity checks.
|
||||
|
||||
## REPL Helpers
|
||||
|
||||
- `app.srepl.main` resolves graph functions only when a helper runs.
|
||||
- `graph-smoke-test!` runs a basic Ladybug operation.
|
||||
- `graph-query-test!` runs a graph query test.
|
||||
- `ingest-file-to-graph!` projects a file into a graph database.
|
||||
- These helpers use `requiring-resolve` to keep the graph dependency lazy.
|
||||
|
||||
## Operational Invariants
|
||||
|
||||
- PostgreSQL file data remains authoritative.
|
||||
- Cold projection and incremental sync must produce equal graph state.
|
||||
- The graph revision must identify the last applied file revision.
|
||||
- The document revision must update when a sync batch applies.
|
||||
- A missing or skipped change must remain visible in sync status.
|
||||
- A graph query from the console must be read-only.
|
||||
- A graph session must serialize connection access.
|
||||
- Graph routes must remain behind the `:graph` flag and `/dbg` access control.
|
||||
- The Arrow allocator must outlive all Ladybug operations that use its buffers.
|
||||
- `GraphMeta` must be written after the full ingest and transforms finish.
|
||||
|
||||
## Key Files
|
||||
|
||||
- `backend/src/app/graph/ladybug.clj`: Ladybug API and query gates.
|
||||
- `backend/src/app/graph/arrow.clj`: Arrow bulk load.
|
||||
- `backend/src/app/graph/ingest.clj`: Complete file ingest.
|
||||
- `backend/src/app/graph/debug.clj`: Session lifecycle, sync loop, query, and export.
|
||||
- `backend/src/app/graph/sync.clj`: Incremental change application.
|
||||
- `backend/src/app/graph/meta.clj`: Graph provenance.
|
||||
- `backend/src/app/graph/stats.clj`: Graph counts.
|
||||
- `backend/src/app/graph/report.clj`: REPL ingest report.
|
||||
- `backend/src/app/graph/projection/document.clj`: Base document projection.
|
||||
- `backend/src/app/graph/projection/transforms.clj`: Derived relationship transforms.
|
||||
- `backend/src/app/graph/schema/nodes.clj`: Node and relationship registry.
|
||||
- `backend/src/app/graph/schema/contract.clj`: Projection contract decisions.
|
||||
- `backend/src/app/graph/schema/projection.clj`: Malli projection schemas.
|
||||
- `backend/src/app/graph/schema/types.clj`: Malli-to-Ladybug type mapping.
|
||||
- `backend/src/app/graph/schema/values.clj`: Value coercion.
|
||||
- `backend/src/app/http/debug.clj`: Graph route registration and handlers.
|
||||
- `backend/src/app/http/websocket.clj`: File WebSocket subscription handlers.
|
||||
- `backend/src/app/rpc/commands/files_update.clj`: File-change publication.
|
||||
- `backend/src/app/main.clj`: Integrant message bus wiring.
|
||||
- `backend/resources/app/templates/graph-console.tmpl`: Graph console browser code.
|
||||
- `backend/resources/app/templates/debug.tmpl`: Debug page graph links.
|
||||
- `common/src/app/common/flags.cljc`: `:graph` feature flag.
|
||||
- `backend/test/backend_tests/graph_sync_parity_test.clj`: Cold versus sync parity.
|
||||
- `backend/test/backend_tests/graph_binder_gate_test.clj`: Cypher binder gate.
|
||||
|
||||
## Development Commands
|
||||
|
||||
- Run backend commands from the `backend/` directory.
|
||||
- Run focused parity tests with `clojure -M:dev:test --focus backend-tests.graph-sync-parity-test`.
|
||||
- Run focused binder tests with `clojure -M:dev:test --focus backend-tests.graph-binder-gate-test`.
|
||||
- Run the backend test suite with `clojure -M:dev:test`.
|
||||
- Examine Clojure formatting with `pnpm run check-fmt:clj`.
|
||||
- Run backend Clojure lint with `pnpm run lint:clj`.
|
||||
- Write test output to a file before reading or filtering it.
|
||||
+8
-2
@@ -65,13 +65,19 @@
|
||||
;; Pretty Print specs
|
||||
pretty-spec/pretty-spec {:mvn/version "0.1.4"}
|
||||
software.amazon.awssdk/s3 {:mvn/version "2.50.1"}
|
||||
software.amazon.awssdk/sts {:mvn/version "2.50.1"}}
|
||||
software.amazon.awssdk/sts {:mvn/version "2.50.1"}
|
||||
|
||||
com.ladybugdb/lbug {:mvn/version "0.19.1"}
|
||||
;; Required by Arrow RootAllocator (lbug only pulls arrow-memory-core).
|
||||
org.apache.arrow/arrow-memory-netty {:mvn/version "18.2.0"}}
|
||||
|
||||
:paths ["src" "resources" "target/classes"]
|
||||
:aliases
|
||||
{:dev
|
||||
{:jvm-opts ["--sun-misc-unsafe-memory-access=allow"
|
||||
"--enable-native-access=ALL-UNNAMED"]
|
||||
"--enable-native-access=ALL-UNNAMED"
|
||||
;; Arrow jars are on the classpath (unnamed module), not module-path.
|
||||
"--add-opens=java.base/java.nio=ALL-UNNAMED"]
|
||||
:extra-deps
|
||||
{com.bhauman/rebel-readline {:mvn/version "0.1.11"}
|
||||
clojure-humanize/clojure-humanize {:mvn/version "0.2.2"}
|
||||
|
||||
File diff suppressed because it is too large.
Load diff
@@ -222,6 +222,23 @@ Debug Main Page
|
||||
</div>
|
||||
</form>
|
||||
</fieldset>
|
||||
{% if graph-enabled %}
|
||||
<fieldset>
|
||||
<legend>Export graph (Ladybug):</legend>
|
||||
<desc>Given a FILE-ID, builds the graph projection and downloads
|
||||
the `.lbug` database file.</desc>
|
||||
|
||||
<form method="get" action="/dbg/actions/graph-export">
|
||||
<div class="row">
|
||||
<input type="text" style="width:300px" name="file-id" placeholder="file-id" />
|
||||
</div>
|
||||
<div class="row">
|
||||
<input type="submit" value="Download .lbug" />
|
||||
<a href="/dbg/graph">Open graph console</a>
|
||||
</div>
|
||||
</form>
|
||||
</fieldset>
|
||||
{% endif %}
|
||||
<fieldset>
|
||||
<legend>Import binfile:</legend>
|
||||
<desc>Import penpot file in binary format.</desc>
|
||||
|
||||
File diff suppressed because it is too large.
Load diff
@@ -93,7 +93,8 @@ export JAVA_OPTS="\
|
||||
-XX:-OmitStackTraceInFastThrow \
|
||||
--sun-misc-unsafe-memory-access=allow \
|
||||
--enable-preview \
|
||||
--enable-native-access=ALL-UNNAMED";
|
||||
--enable-native-access=ALL-UNNAMED \
|
||||
--add-opens=java.base/java.nio=ALL-UNNAMED";
|
||||
|
||||
function setup_minio() {
|
||||
if [ "${PENPOT_OBJECTS_STORAGE_BACKEND}" != "s3" ]; then
|
||||
|
||||
@@ -18,7 +18,7 @@ if [ -f ./environ ]; then
|
||||
source ./environ
|
||||
fi
|
||||
|
||||
export JAVA_OPTS="-Djava.util.logging.manager=org.apache.logging.log4j.jul.LogManager -Dlog4j2.configurationFile=log4j2.xml -XX:-OmitStackTraceInFastThrow --sun-misc-unsafe-memory-access=allow --enable-native-access=ALL-UNNAMED --enable-preview $JVM_OPTS $JAVA_OPTS"
|
||||
export JAVA_OPTS="-Djava.util.logging.manager=org.apache.logging.log4j.jul.LogManager -Dlog4j2.configurationFile=log4j2.xml -XX:-OmitStackTraceInFastThrow --sun-misc-unsafe-memory-access=allow --enable-native-access=ALL-UNNAMED --add-opens=java.base/java.nio=ALL-UNNAMED --enable-preview $JVM_OPTS $JAVA_OPTS"
|
||||
|
||||
ENTRYPOINT=${1:-app.main};
|
||||
|
||||
|
||||
@@ -0,0 +1,370 @@
|
||||
;; 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.arrow
|
||||
"Bulk Ladybug ingest through in-memory Arrow.
|
||||
|
||||
Rows are built as Arrow `VectorSchemaRoot`s in the JVM's off-heap memory,
|
||||
handed to Ladybug as a virtual table, and `COPY`d into the real one. No file
|
||||
is written and no value is rendered as text for the engine to re-parse, so
|
||||
nothing in this path needs escaping. Arrow carries MAP, STRUCT, fixed-size
|
||||
arrays and multi-line strings natively.
|
||||
|
||||
The type language is Ladybug's, read recursively by `app.graph.schema.values`;
|
||||
this namespace adds the matching Arrow `Field` and a writer for each shape.
|
||||
`values/coerce` shapes a value first — a matrix into six doubles, a colour
|
||||
into a packed integer — exactly as it does for the Cypher path, so the two
|
||||
writers cannot disagree.
|
||||
|
||||
Engine facts this file depends on, each verified against lbug 0.19.1:
|
||||
|
||||
- An Arrow table is **not** a `COPY` source identifier, but it *is* a
|
||||
MATCH-able node label: `COPY T FROM (MATCH (n:stg) RETURN n.a AS a, …)`.
|
||||
- A MAP vector's `entries` child struct must be non-nullable, and
|
||||
`MapVector/getWriter` silently promotes it to a sparse union — so map
|
||||
vectors are built from an explicit `Field` and filled child-first.
|
||||
- Ladybug quotes the column and table names it interpolates into the staged
|
||||
table's DDL, and does not quote a STRUCT member name. So a top-level field
|
||||
arrives plain and a struct member whose name is a reserved word (`column`)
|
||||
arrives backticked.
|
||||
- `createArrowRelTable` resolves a UUID-keyed endpoint only from a
|
||||
`FixedSizeBinary(16)` column carrying the `arrow.uuid` extension, so edges
|
||||
are staged as a node table and joined by the `COPY` subquery instead."
|
||||
(:require
|
||||
[app.common.json :as json]
|
||||
[app.graph.ladybug :as ladybug]
|
||||
[app.graph.schema.nodes :as nodes]
|
||||
[app.graph.schema.values :as values]
|
||||
[clojure.string :as str])
|
||||
(:import
|
||||
com.ladybugdb.Connection
|
||||
com.ladybugdb.QueryResult
|
||||
java.nio.charset.StandardCharsets
|
||||
java.util.ArrayList
|
||||
java.util.List
|
||||
org.apache.arrow.memory.BufferAllocator
|
||||
org.apache.arrow.memory.RootAllocator
|
||||
org.apache.arrow.vector.BigIntVector
|
||||
org.apache.arrow.vector.BitVector
|
||||
org.apache.arrow.vector.complex.ListVector
|
||||
org.apache.arrow.vector.complex.MapVector
|
||||
org.apache.arrow.vector.complex.StructVector
|
||||
org.apache.arrow.vector.FieldVector
|
||||
org.apache.arrow.vector.Float8Vector
|
||||
org.apache.arrow.vector.TimeStampMicroVector
|
||||
org.apache.arrow.vector.types.FloatingPointPrecision
|
||||
org.apache.arrow.vector.types.pojo.ArrowType$Bool
|
||||
org.apache.arrow.vector.types.pojo.ArrowType$FloatingPoint
|
||||
org.apache.arrow.vector.types.pojo.ArrowType$Int
|
||||
org.apache.arrow.vector.types.pojo.ArrowType$List
|
||||
org.apache.arrow.vector.types.pojo.ArrowType$Map
|
||||
org.apache.arrow.vector.types.pojo.ArrowType$Struct
|
||||
org.apache.arrow.vector.types.pojo.ArrowType$Timestamp
|
||||
org.apache.arrow.vector.types.pojo.ArrowType$Utf8
|
||||
org.apache.arrow.vector.types.pojo.Field
|
||||
org.apache.arrow.vector.types.pojo.FieldType
|
||||
org.apache.arrow.vector.types.pojo.Schema
|
||||
org.apache.arrow.vector.types.TimeUnit
|
||||
org.apache.arrow.vector.UInt4Vector
|
||||
org.apache.arrow.vector.VarCharVector
|
||||
org.apache.arrow.vector.VectorSchemaRoot))
|
||||
|
||||
(set! *warn-on-reflection* true)
|
||||
|
||||
;; --------------------------------------------------------------- allocator
|
||||
|
||||
(defn with-allocator!
|
||||
"Invoke `(f allocator)` with a fresh Arrow `RootAllocator`.
|
||||
|
||||
The allocator must outlive the Ladybug connection, because Ladybug releases
|
||||
its references to the staged buffers only when the Arrow tables are dropped —
|
||||
which happens on connection close at the latest. Closing it first surfaces as
|
||||
`IllegalStateException: Memory was leaked`, *thrown while unwinding*, which
|
||||
hides whatever actually failed. Any diagnostic here must catch inside this
|
||||
scope."
|
||||
[f]
|
||||
(with-open [allocator (RootAllocator.)]
|
||||
(f allocator)))
|
||||
|
||||
;; ------------------------------------------------------ Ladybug type → Field
|
||||
|
||||
(def ^:private scalar-arrow-type
|
||||
"Ladybug scalar → Arrow type. `UUID` and `JSON` ride as UTF-8: Ladybug
|
||||
accepts a string into either column and does the conversion itself, which is
|
||||
cheaper than teaching this side two more binary layouts."
|
||||
{"STRING" #(ArrowType$Utf8.)
|
||||
"UUID" #(ArrowType$Utf8.)
|
||||
"JSON" #(ArrowType$Utf8.)
|
||||
"INT64" #(ArrowType$Int. 64 true)
|
||||
"UINT32" #(ArrowType$Int. 32 false)
|
||||
"DOUBLE" #(ArrowType$FloatingPoint. FloatingPointPrecision/DOUBLE)
|
||||
"BOOLEAN" #(ArrowType$Bool.)
|
||||
"TIMESTAMP" #(ArrowType$Timestamp. TimeUnit/MICROSECOND nil)})
|
||||
|
||||
(defn column-field
|
||||
"Arrow `Field` for a column of `ladybug-type`, recursively.
|
||||
|
||||
`nullable?` is false only where Arrow's own invariants demand it — a MAP's
|
||||
`entries` struct and its key."
|
||||
(^Field [^String field-name ladybug-type]
|
||||
(column-field field-name ladybug-type true))
|
||||
(^Field [^String field-name ladybug-type nullable?]
|
||||
(cond
|
||||
;; A list first: `STRUCT(…)[]` starts with `STRUCT(` but is a list of them.
|
||||
(ladybug/list-type? ladybug-type)
|
||||
(Field. field-name (FieldType. nullable? (ArrowType$List.) nil)
|
||||
[(column-field "item" (values/list-element ladybug-type))])
|
||||
|
||||
(ladybug/map-type? ladybug-type)
|
||||
(let [[key-type value-type] (values/map-types ladybug-type)]
|
||||
(Field. field-name (FieldType. nullable? (ArrowType$Map. false) nil)
|
||||
[(Field. "entries" (FieldType. false (ArrowType$Struct.) nil)
|
||||
[(column-field "key" key-type false)
|
||||
(column-field "value" value-type)])]))
|
||||
|
||||
(ladybug/struct-type? ladybug-type)
|
||||
(Field. field-name (FieldType. nullable? (ArrowType$Struct.) nil)
|
||||
;; Backticks kept: Ladybug quotes none of these when it names the
|
||||
;; staged struct's fields, so `column` has to arrive quoted.
|
||||
(mapv (fn [[field field-type]] (column-field field field-type))
|
||||
(values/struct-fields-quoted ladybug-type)))
|
||||
|
||||
:else
|
||||
(if-let [mk (get scalar-arrow-type ladybug-type)]
|
||||
(Field. field-name (FieldType. nullable? (mk) nil) nil)
|
||||
(throw (ex-info (str "no Arrow mapping for Ladybug type: " ladybug-type)
|
||||
{:ladybug-type ladybug-type}))))))
|
||||
|
||||
;; ------------------------------------------------------------------- writer
|
||||
|
||||
(defn- utf8
|
||||
^bytes [v]
|
||||
(.getBytes (if (keyword? v) (name v) (str v)) StandardCharsets/UTF_8))
|
||||
|
||||
(defn- epoch-micros
|
||||
^long [v]
|
||||
(let [^java.time.Instant inst
|
||||
(cond
|
||||
(instance? java.time.Instant v) v
|
||||
(instance? java.util.Date v) (.toInstant ^java.util.Date v)
|
||||
:else (java.time.Instant/parse (str v)))]
|
||||
(+ (* (.getEpochSecond inst) 1000000) (long (quot (.getNano inst) 1000)))))
|
||||
|
||||
(defn- write-scalar!
|
||||
[^FieldVector fv ladybug-type ^long idx v]
|
||||
(case ladybug-type
|
||||
("STRING" "UUID") (.setSafe ^VarCharVector fv idx (utf8 v))
|
||||
;; A JSON column holds JSON, not a Clojure value's print form: `str` on a
|
||||
;; map yields `{:fill-color "#000000"}`, which is EDN and which every
|
||||
;; consumer of `fills`, `content` or `position_data` would fail to parse.
|
||||
;; Same encoder the Cypher path uses (`app.graph.ladybug/format-json`).
|
||||
"JSON" (.setSafe ^VarCharVector fv idx
|
||||
(.getBytes ^String (json/encode v)
|
||||
StandardCharsets/UTF_8))
|
||||
"INT64" (.setSafe ^BigIntVector fv idx (long v))
|
||||
"UINT32" (.setSafe ^UInt4Vector fv idx (unchecked-int (long v)))
|
||||
"DOUBLE" (.setSafe ^Float8Vector fv idx (double v))
|
||||
"BOOLEAN" (.setSafe ^BitVector fv idx (if v 1 0))
|
||||
"TIMESTAMP" (.setSafe ^TimeStampMicroVector fv idx (epoch-micros v))
|
||||
(throw (ex-info (str "no Arrow writer for Ladybug type: " ladybug-type)
|
||||
{:ladybug-type ladybug-type}))))
|
||||
|
||||
(defn write-value!
|
||||
"Write already-coerced `v` into `fv` at `idx`, per `ladybug-type`.
|
||||
|
||||
`map-key-fn` renders the keys of a `MAP(STRING, …)`, for the same reason
|
||||
`app.graph.ladybug/format-typed-value` takes one: the right spelling is a
|
||||
property of the column, not of the writer."
|
||||
;; `idx` is deliberately unhinted: Clojure only accepts primitive args on fns
|
||||
;; of four or fewer, and the map-key renderer has to travel with the value.
|
||||
[^FieldVector fv ladybug-type idx v map-key-fn]
|
||||
(if (nil? v)
|
||||
(.setNull fv (int idx))
|
||||
(cond
|
||||
(ladybug/list-type? ladybug-type)
|
||||
(let [^ListVector lv fv
|
||||
child (.getDataVector lv)
|
||||
element-type (values/list-element ladybug-type)
|
||||
elements (vec (if (or (sequential? v) (set? v)) v [v]))
|
||||
start (.startNewValue lv (int idx))]
|
||||
(dotimes [i (count elements)]
|
||||
(write-value! child element-type (+ start i) (nth elements i) map-key-fn))
|
||||
(.endValue lv (int idx) (count elements)))
|
||||
|
||||
(ladybug/map-type? ladybug-type)
|
||||
(let [^MapVector mv fv
|
||||
^StructVector entries (.getDataVector mv)
|
||||
[key-type value-type] (values/map-types ladybug-type)
|
||||
key-vec (.getChild entries "key")
|
||||
value-vec (.getChild entries "value")
|
||||
render-key (if (and map-key-fn (= "STRING" key-type)) map-key-fn identity)
|
||||
pairs (vec (seq v))
|
||||
start (.startNewValue mv (int idx))]
|
||||
(dotimes [i (count pairs)]
|
||||
(let [[k mv'] (nth pairs i)
|
||||
at (+ start i)]
|
||||
;; The entries struct is non-nullable: every slot must be defined.
|
||||
(.setIndexDefined entries (int at))
|
||||
(write-value! key-vec key-type at (render-key k) nil)
|
||||
(write-value! value-vec value-type at mv' map-key-fn)))
|
||||
(.endValue mv (int idx) (count pairs)))
|
||||
|
||||
(ladybug/struct-type? ladybug-type)
|
||||
(let [^StructVector sv fv]
|
||||
(.setIndexDefined sv (int idx))
|
||||
(doseq [[quoted-field field-type] (values/struct-fields-quoted ladybug-type)]
|
||||
;; The child is named with its backticks; the coerced value is keyed
|
||||
;; without them.
|
||||
(write-value! (.getChild sv quoted-field) field-type idx
|
||||
(get v (str/replace quoted-field "`" "")) map-key-fn)))
|
||||
|
||||
:else
|
||||
(write-scalar! fv ladybug-type (long idx) v))))
|
||||
|
||||
;; ------------------------------------------------------------------ batches
|
||||
|
||||
(defn- fill-vector!
|
||||
[^VectorSchemaRoot root ^String field-name ladybug-type rows value-fn map-key-fn]
|
||||
(let [^FieldVector fv (.getVector root field-name)]
|
||||
(.allocateNew fv)
|
||||
(dotimes [i (count rows)]
|
||||
(write-value! fv ladybug-type i
|
||||
(values/coerce ladybug-type (value-fn (nth rows i)))
|
||||
map-key-fn))
|
||||
(.setValueCount fv (count rows))))
|
||||
|
||||
(defn- node-batch
|
||||
"One `VectorSchemaRoot` holding every projected row of `table`.
|
||||
|
||||
Fields carry the plain column name. Ladybug quotes every identifier it
|
||||
interpolates into the staged table's DDL, so a name that is a reserved word
|
||||
(`Page.index`, `Document.options`) arrives unquoted and a name arriving
|
||||
pre-quoted comes out doubly backticked and fails to parse. The `COPY`
|
||||
projection below is Cypher, not DDL, so it quotes the same names itself."
|
||||
^VectorSchemaRoot [^BufferAllocator allocator table rows]
|
||||
(let [columns (nodes/column-keys table)
|
||||
fields (mapv (fn [k] (column-field (nodes/column-name table k)
|
||||
(nodes/column-ladybug-type table k)))
|
||||
columns)
|
||||
root (VectorSchemaRoot/create (Schema. ^List fields) allocator)]
|
||||
(doseq [k columns]
|
||||
(fill-vector! root (nodes/column-name table k)
|
||||
(nodes/column-ladybug-type table k)
|
||||
rows #(get % k) (nodes/column-map-key-fn table k)))
|
||||
(.setRowCount root (count rows))
|
||||
root))
|
||||
|
||||
(def ^:private edge-fields
|
||||
"Edge staging columns. `id` is the staging table's own key — Ladybug wants a
|
||||
first column to key the virtual table on — and `from`/`to` land as STRING,
|
||||
hence the cast in the join."
|
||||
[(Field. "id" (FieldType. true (ArrowType$Utf8.) nil) nil)
|
||||
(Field. "from" (FieldType. true (ArrowType$Utf8.) nil) nil)
|
||||
(Field. "to" (FieldType. true (ArrowType$Utf8.) nil) nil)
|
||||
(Field. "position" (FieldType. true (ArrowType$Int. 64 true) nil) nil)])
|
||||
|
||||
(defn- edge-batch
|
||||
^VectorSchemaRoot [^BufferAllocator allocator edges]
|
||||
(let [root (VectorSchemaRoot/create (Schema. ^List edge-fields) allocator)
|
||||
^VarCharVector iv (.getVector root "id")
|
||||
^VarCharVector fv (.getVector root "from")
|
||||
^VarCharVector tv (.getVector root "to")
|
||||
^BigIntVector pv (.getVector root "position")
|
||||
n (count edges)]
|
||||
(doseq [^FieldVector v [iv fv tv pv]] (.allocateNew v))
|
||||
(dotimes [i n]
|
||||
(let [{:keys [from-id to-id position]} (nth edges i)]
|
||||
(.setSafe iv i (utf8 i))
|
||||
(.setSafe fv i (utf8 from-id))
|
||||
(.setSafe tv i (utf8 to-id))
|
||||
(if (nil? position) (.setNull pv i) (.setSafe pv i (long position)))))
|
||||
(doseq [^FieldVector v [iv fv tv pv]] (.setValueCount v n))
|
||||
(.setRowCount root n)
|
||||
root))
|
||||
|
||||
;; ------------------------------------------------------------------ staging
|
||||
|
||||
(defn- batches
|
||||
^List [^VectorSchemaRoot root]
|
||||
(doto (ArrayList.) (.add root)))
|
||||
|
||||
(defn- check!
|
||||
[^QueryResult result hint data]
|
||||
(when-not (.isSuccess result)
|
||||
(throw (ex-info (str hint ": " (.getErrorMessage result))
|
||||
(assoc data :err (.getErrorMessage result))))))
|
||||
|
||||
(defn- with-staged-table!
|
||||
"Create Arrow table `staging-name` from `root`, run `(f)`, always drop it."
|
||||
[^Connection conn ^BufferAllocator allocator ^String staging-name
|
||||
^VectorSchemaRoot root data f]
|
||||
(try
|
||||
(with-open [^QueryResult r (.createArrowTable conn staging-name (batches root) allocator)]
|
||||
(check! r "createArrowTable failed" data))
|
||||
(f)
|
||||
(finally
|
||||
;; Dropped even on failure: the staged buffers stay referenced by Ladybug
|
||||
;; until it is, and the allocator's leak check fires on close otherwise.
|
||||
(try (.close ^QueryResult (.dropArrowTable conn staging-name))
|
||||
(catch Throwable _ nil)))))
|
||||
|
||||
(defn- copy-node-table!
|
||||
[^Connection conn table ^String staging-name]
|
||||
(let [projection (str/join ", " (for [k (nodes/column-keys table)
|
||||
:let [c (nodes/cypher-property-key table k)]]
|
||||
(str "n." c " AS " c)))
|
||||
statement (str "COPY `" table "` FROM (MATCH (n:" staging-name ") "
|
||||
"RETURN " projection ");")]
|
||||
(with-open [^QueryResult r (.query conn statement)]
|
||||
(check! r (str "COPY node table failed: " table)
|
||||
{:table table :statement statement}))))
|
||||
|
||||
(defn- copy-edge-group!
|
||||
"Load one FROM/TO pair of `IsChildOf`.
|
||||
|
||||
`createArrowRelTable` is unusable here — it cannot resolve endpoints against a
|
||||
UUID-keyed node table — so the edge list is staged as a node table and the
|
||||
endpoints are resolved by the subquery. The `WHERE` is clause-level because
|
||||
this dialect prohibits an inline pattern `WHERE`, and both sides are pinned by
|
||||
label so the join cannot reach outside the pair."
|
||||
[^Connection conn from-table to-table ^String staging-name]
|
||||
(let [statement (str "COPY `IsChildOf` FROM ("
|
||||
"MATCH (e:" staging-name "), "
|
||||
"(a:" (nodes/match-label from-table) "), "
|
||||
"(b:" (nodes/match-label to-table) ") "
|
||||
"WHERE a.id = cast(e.from AS UUID) "
|
||||
"AND b.id = cast(e.to AS UUID) "
|
||||
"RETURN a.id, b.id, e.position) "
|
||||
"(from='" from-table "', to='" to-table "');")]
|
||||
(with-open [^QueryResult r (.query conn statement)]
|
||||
(check! r (str "COPY edge group failed: " from-table " -> " to-table)
|
||||
{:from-table from-table :to-table to-table :statement statement}))))
|
||||
|
||||
(defn- staging-name
|
||||
[prefix & parts]
|
||||
(str/replace (str/join "_" (cons (str "stg_" prefix) parts)) #"[^A-Za-z0-9_]" "_"))
|
||||
|
||||
;; --------------------------------------------------------------------- load
|
||||
|
||||
(defn load-projection!
|
||||
"Load projected nodes and edges into an open Ladybug connection.
|
||||
|
||||
`allocator` must outlive `conn` — see `with-allocator!`."
|
||||
[^Connection conn {:keys [nodes edges]} ^BufferAllocator allocator]
|
||||
(doseq [[table rows] (sort-by key nodes)
|
||||
:when (seq rows)]
|
||||
(let [name (staging-name "node" table)]
|
||||
(with-open [root (node-batch allocator table rows)]
|
||||
(with-staged-table! conn allocator name root {:table table}
|
||||
#(copy-node-table! conn table name)))))
|
||||
(doseq [[[from-table to-table] group]
|
||||
(sort-by key (group-by (juxt :from-table :to-table) edges))
|
||||
:when (seq group)]
|
||||
(let [name (staging-name "edge" from-table to-table)]
|
||||
(with-open [root (edge-batch allocator group)]
|
||||
(with-staged-table! conn allocator name root
|
||||
{:from-table from-table :to-table to-table}
|
||||
#(copy-edge-group! conn from-table to-table name))))))
|
||||
@@ -0,0 +1,383 @@
|
||||
;; 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.debug
|
||||
"In-memory Ladybug sessions for the debug graph console."
|
||||
(:require
|
||||
[app.common.exceptions :as ex]
|
||||
[app.common.logging :as l]
|
||||
[app.common.time :as ct]
|
||||
[app.graph.ingest :as graph.ingest]
|
||||
[app.graph.ladybug :as ladybug]
|
||||
[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
|
||||
com.ladybugdb.Connection
|
||||
com.ladybugdb.Database))
|
||||
|
||||
(set! *warn-on-reflection* true)
|
||||
|
||||
(def default-query
|
||||
"Default console query, written to be self-explanatory in the textarea.
|
||||
The `filter_*` columns carry node ids for the graph-view result filter;
|
||||
the results table hides them (see `hide-filter-columns` and the
|
||||
template's `renderQueryOutput`)."
|
||||
(str "MATCH (s)-[r]->(t)\n"
|
||||
"// WHERE some condition\n"
|
||||
"RETURN label(s) AS src, s.name,\n"
|
||||
" label(r) AS rel,\n"
|
||||
" t.name, label(t) AS tgt,\n"
|
||||
"\n"
|
||||
"// filter_* columns omitted from table; these needed for graph view\n"
|
||||
"s.id AS filter_src_id, t.id AS filter_tgt_id;"))
|
||||
|
||||
(defonce ^:private sessions
|
||||
(atom {}))
|
||||
|
||||
(defn- session-key
|
||||
[profile-id]
|
||||
(str profile-id))
|
||||
|
||||
(defn- destroy-session!
|
||||
[{:keys [conn db sync-ch msgbus]}]
|
||||
(when sync-ch
|
||||
(sp/close! sync-ch)
|
||||
(when msgbus
|
||||
(mbus/purge! msgbus [sync-ch])))
|
||||
(when conn
|
||||
(ex/ignoring (.close ^Connection conn)))
|
||||
(when db
|
||||
(ex/ignoring (.close ^Database db))))
|
||||
|
||||
(defn- slim-ingest-meta
|
||||
"Drop full projection rows from session meta.
|
||||
|
||||
`build-index` needs `:nodes`/`:edges` once; keeping them in the session
|
||||
duplicates the entire graph on the JVM heap for every Load."
|
||||
[meta]
|
||||
(update meta :projection #(select-keys % [:stats])))
|
||||
|
||||
(defn- format-cell
|
||||
[value]
|
||||
(cond
|
||||
(nil? value) "NULL"
|
||||
(string? value) value
|
||||
:else (str value)))
|
||||
|
||||
(defn- format-query-result
|
||||
[{:keys [columns rows truncated?]}]
|
||||
{:columns (mapv str columns)
|
||||
:rows (mapv (fn [row]
|
||||
(mapv format-cell row))
|
||||
rows)
|
||||
:truncated? truncated?
|
||||
:row-count (count rows)})
|
||||
|
||||
(defn- apply-file-change!
|
||||
[conn profile-id {:keys [changes revn file-id]}]
|
||||
(try
|
||||
(some-> (get @sessions (session-key profile-id))
|
||||
(as-> current
|
||||
(when (= file-id (:file-id current))
|
||||
(let [lock (:lock current)
|
||||
result (locking lock
|
||||
(graph.sync/apply-changes!
|
||||
conn (:index current) changes revn))
|
||||
sync-at (ct/now)]
|
||||
(swap! sessions assoc-in [(session-key profile-id) :index]
|
||||
(:index result))
|
||||
(swap! sessions update-in [(session-key profile-id) :meta]
|
||||
(fn [meta]
|
||||
(cond-> (-> meta
|
||||
(update :sync dissoc :error)
|
||||
(assoc-in [:sync :last-at] sync-at)
|
||||
(assoc-in [:sync :last-applied] (:applied result))
|
||||
(assoc-in [:sync :last-skipped] (:skipped result)))
|
||||
(seq (:applied result))
|
||||
(assoc :revn (:revn result)))))
|
||||
(when (seq (:skipped result))
|
||||
(l/dbg :hint "graph sync skipped changes"
|
||||
:file-id (str file-id)
|
||||
:revn revn
|
||||
:skipped (:skipped result)))))))
|
||||
(catch Throwable cause
|
||||
(l/wrn :hint "graph sync failed"
|
||||
:file-id (str file-id)
|
||||
:cause cause)
|
||||
(swap! sessions assoc-in [(session-key profile-id) :meta :sync :error]
|
||||
(ex-message cause)))))
|
||||
|
||||
(defn- start-sync-loop!
|
||||
[{:keys [conn profile-id file-id] :as session}]
|
||||
(if-let [msgbus (:msgbus session)]
|
||||
(let [sync-ch (sp/chan :buf (sp/dropping-buffer 64))]
|
||||
(mbus/sub! msgbus :topic file-id :chan sync-ch)
|
||||
;; Recur ONLY while the channel is open. A bare `(recur)` after
|
||||
;; `take!` returns nil would spin forever and pin this Connection
|
||||
;; (and its Ladybug Database native memory) across every Load.
|
||||
(sp/go-loop []
|
||||
(when-let [message (sp/take! sync-ch)]
|
||||
(when (= :file-change (:type message))
|
||||
(apply-file-change! conn profile-id message))
|
||||
(recur)))
|
||||
(assoc session :sync-ch sync-ch))
|
||||
session))
|
||||
|
||||
(defn session-info
|
||||
"Return a public view of the current session for `profile-id`, if any."
|
||||
[profile-id]
|
||||
(when-let [{:keys [file-id meta loaded-at index]} (get @sessions (session-key profile-id))]
|
||||
{:file-id file-id
|
||||
:name (:name meta)
|
||||
:revn (:revn meta)
|
||||
:graph-revn (:revn index)
|
||||
:schema-version (:schema-version meta)
|
||||
:projection (:projection meta)
|
||||
:sync (:sync meta)
|
||||
:loaded-at (ct/format-inst loaded-at :iso)}))
|
||||
|
||||
(defn sync-status
|
||||
"Return incremental sync status for the active session."
|
||||
[profile-id]
|
||||
(when-let [session (get @sessions (session-key profile-id))]
|
||||
(let [{:keys [file-id meta index loaded-at]} session]
|
||||
{:file-id file-id
|
||||
:revn (:revn meta)
|
||||
:graph-revn (:revn index)
|
||||
:sync (:sync meta)
|
||||
:loaded-at (ct/format-inst loaded-at :iso)})))
|
||||
|
||||
(defn unload-session!
|
||||
"Close and discard the in-memory graph for `profile-id`."
|
||||
[profile-id]
|
||||
(when-let [session (get @sessions (session-key profile-id))]
|
||||
(destroy-session! session))
|
||||
(swap! sessions dissoc (session-key profile-id)))
|
||||
|
||||
(defn load-session!
|
||||
"Ingest `file-id` into a new in-memory Ladybug database for `profile-id`."
|
||||
[cfg profile-id file-id]
|
||||
(unload-session! profile-id)
|
||||
(let [^Database db (Database.)
|
||||
^Connection conn (Connection. db)
|
||||
msgbus (::mbus/msgbus cfg)]
|
||||
(.setQueryTimeout conn 0)
|
||||
(ladybug/ensure-extensions! conn)
|
||||
(try
|
||||
(let [meta (graph.ingest/ingest-on-connection! cfg conn file-id
|
||||
:db-path ":memory:"
|
||||
:skip-stats? true
|
||||
:skip-validation? true)
|
||||
index (graph.sync/build-index file-id (:revn meta) (:projection meta))
|
||||
;; Discard projection rows after indexing — they are only needed
|
||||
;; to seed the sync index and would otherwise leak heap on each Load.
|
||||
meta (slim-ingest-meta meta)
|
||||
session
|
||||
;; :lock serializes access to the shared Connection between the
|
||||
;; msgbus sync loop (writes) and HTTP handlers (reads); the Java
|
||||
;; binding gives no thread-safety guarantee for one Connection.
|
||||
(-> {:db db
|
||||
:conn conn
|
||||
:lock (Object.)
|
||||
:file-id file-id
|
||||
:meta meta
|
||||
:index index
|
||||
:msgbus msgbus
|
||||
:profile-id profile-id
|
||||
:loaded-at (ct/now)}
|
||||
start-sync-loop!)]
|
||||
(swap! sessions assoc (session-key profile-id) session)
|
||||
meta)
|
||||
(catch Throwable cause
|
||||
(destroy-session! {:conn conn :db db :msgbus msgbus})
|
||||
(throw cause)))))
|
||||
|
||||
(defn query-session!
|
||||
"Run a read-only `statement` against the in-memory graph for `profile-id`.
|
||||
|
||||
The statement is bound against the live schema before it runs, so a query
|
||||
naming a table or a property that does not exist reports the binder's own
|
||||
message and executes nothing. The engine's read/write analysis then decides
|
||||
whether it may run at all: the console is an inspection surface, and a
|
||||
session graph is rebuilt from the file by Reload, so a mutation from here
|
||||
would produce a graph no rebuild reproduces."
|
||||
[profile-id statement]
|
||||
(when (str/blank? statement)
|
||||
(ex/raise :type :validation
|
||||
:code :missing-query
|
||||
:hint "cypher query is required"))
|
||||
(if-let [{:keys [conn lock]} (get @sessions (session-key profile-id))]
|
||||
(locking lock
|
||||
(let [{:keys [ok? error read-only?]} (ladybug/validate-on-connection! conn statement)]
|
||||
(when-not ok?
|
||||
(ex/raise :type :validation
|
||||
:code :graph-query-invalid
|
||||
:hint error))
|
||||
(when-not read-only?
|
||||
(ex/raise :type :validation
|
||||
:code :graph-query-not-read-only
|
||||
:hint "the graph console runs read-only queries"))
|
||||
(-> (ladybug/query-on-connection! conn statement)
|
||||
format-query-result)))
|
||||
(ex/raise :type :not-found
|
||||
:code :graph-session-not-loaded
|
||||
:hint "load a file graph before running queries")))
|
||||
|
||||
(def ^:private export-max-rows
|
||||
"Row cap for graph-view export queries; far above expected per-file node
|
||||
and edge counts. `:truncated` in the export signals when it was hit."
|
||||
100000)
|
||||
|
||||
(defn- export-nodes
|
||||
[conn]
|
||||
(reduce
|
||||
(fn [acc {:keys [table]}]
|
||||
(let [stmt (str "MATCH (n:" (nodes/match-label table)
|
||||
") RETURN n.id AS id, n.name AS name;")
|
||||
{:keys [rows truncated?]}
|
||||
(ladybug/query-on-connection! conn stmt :max-rows export-max-rows)]
|
||||
(-> acc
|
||||
(update :nodes into
|
||||
(map (fn [[id label]]
|
||||
{:id (str id) :label (str label) :table table}))
|
||||
rows)
|
||||
(update :truncated? #(or % truncated?)))))
|
||||
{: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]
|
||||
(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
|
||||
(`CALL bm_info()` → [mem_limit mem_usage]); nil if the call fails."
|
||||
[conn]
|
||||
(ex/ignoring
|
||||
(-> (ladybug/query-on-connection! conn "CALL bm_info() RETURN *;" :max-rows 1)
|
||||
:rows first second)))
|
||||
|
||||
(defn export-graph-data!
|
||||
"Export the node/edge inventory of the in-memory graph for `profile-id`
|
||||
as plain data for the debug graph view. Returns nil when no session is
|
||||
loaded. Queries the Ladybug database (not the sync index) so the view
|
||||
reflects actual DB state, including drift."
|
||||
[profile-id]
|
||||
(when-let [{:keys [conn lock file-id index]} (get @sessions (session-key profile-id))]
|
||||
(locking lock
|
||||
(let [{:keys [nodes] nodes-truncated? :truncated?} (export-nodes conn)
|
||||
{:keys [edges] edges-truncated? :truncated?} (export-edges conn)]
|
||||
{:file-id (str file-id)
|
||||
:revn (:revn index)
|
||||
:truncated (boolean (or nodes-truncated? edges-truncated?))
|
||||
:bm-bytes (bm-usage-bytes conn)
|
||||
: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. Nothing in the graph is addressed
|
||||
by a table comment: every table is resolved by name, so the loss costs
|
||||
nothing.
|
||||
|
||||
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.
|
||||
The JSON response path keeps the full result."
|
||||
[{:keys [columns rows] :as result}]
|
||||
(let [idxs (vec (keep-indexed
|
||||
(fn [i c] (when-not (str/starts-with? (str c) "filter_") i))
|
||||
columns))]
|
||||
(if (or (empty? idxs) (= (count idxs) (count columns)))
|
||||
result
|
||||
(assoc result
|
||||
:columns (mapv (vec columns) idxs)
|
||||
:rows (mapv (fn [row] (mapv (vec row) idxs)) rows)))))
|
||||
|
||||
(defn console-context
|
||||
"Build template data for the graph debug console page."
|
||||
[profile-id & {:keys [query query-result error message]}]
|
||||
{:session (session-info profile-id)
|
||||
:query (or query default-query)
|
||||
:query-result (some-> query-result hide-filter-columns)
|
||||
:error error
|
||||
:message message
|
||||
:default-query default-query})
|
||||
@@ -0,0 +1,108 @@
|
||||
;; 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.ingest
|
||||
"Penpot file -> Ladybug graph projection."
|
||||
(:require
|
||||
[app.binfile.common :as bfc]
|
||||
[app.common.exceptions :as ex]
|
||||
[app.common.logging :as l]
|
||||
[app.common.types.file :as ctf]
|
||||
[app.db :as db]
|
||||
[app.graph.arrow :as graph.arrow]
|
||||
[app.graph.ladybug :as ladybug]
|
||||
[app.graph.meta :as graph.meta]
|
||||
[app.graph.projection.document :as projection.document]
|
||||
[app.graph.projection.transforms :as projection.transforms]
|
||||
[app.graph.schema :as schema]
|
||||
[app.graph.stats :as stats]
|
||||
[app.srepl.helpers :as h])
|
||||
(:import
|
||||
com.ladybugdb.Connection
|
||||
org.apache.arrow.memory.BufferAllocator))
|
||||
|
||||
(defn- fetch-file!
|
||||
[system file-id]
|
||||
(let [file-id (h/parse-uuid file-id)
|
||||
file (db/run! system #(bfc/get-file % file-id :realize? true))]
|
||||
(when-not file
|
||||
(ex/raise :type :not-found
|
||||
:code :file-not-found
|
||||
:file-id (str file-id)))
|
||||
(when-not (:data file)
|
||||
(ex/raise :type :validation
|
||||
:code :file-without-data
|
||||
:hint "file has no data to project"
|
||||
:file-id (str file-id)))
|
||||
[file-id file]))
|
||||
|
||||
(defn- ingest-on-connection*!
|
||||
[system ^Connection conn file-id ^BufferAllocator allocator
|
||||
{:keys [db-path skip-stats? skip-validation?] :or {skip-stats? true}}]
|
||||
(let [[file-id file] (fetch-file! system file-id)
|
||||
db-path (or db-path (ladybug/db-path-for-file file-id))
|
||||
data (:data file)]
|
||||
(when-not skip-validation?
|
||||
(ctf/check-file-data data))
|
||||
(l/inf :hint "graph ingest"
|
||||
:file-id (str file-id)
|
||||
:revn (:revn file)
|
||||
:db-path db-path
|
||||
:schema schema/schema-version)
|
||||
(let [ddl (schema/ddl-statements)
|
||||
{:keys [nodes edges stats]}
|
||||
(projection.document/projection-data data file)]
|
||||
(ladybug/exec-on-connection! conn ddl)
|
||||
(graph.arrow/load-projection! conn {:nodes nodes :edges edges} allocator)
|
||||
(ladybug/exec-on-connection! conn ["CHECKPOINT;"])
|
||||
(let [transforms (projection.transforms/apply-transforms! system conn data file)]
|
||||
;; Written last: its presence doubles as the build-complete marker,
|
||||
;; and it is what the parity consumer reads to know what is left.
|
||||
(graph.meta/write! conn {:file-id file-id
|
||||
:revn (:revn file)
|
||||
:transform-ids (:ids transforms)})
|
||||
{: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-on-connection!
|
||||
"Project `file-id` into an already open Ladybug `conn`.
|
||||
|
||||
Takes an `:arrow-alloc` when the caller already owns one; otherwise it makes
|
||||
a short-lived allocator around this call. A caller that opened the connection
|
||||
itself should pass its own, because the allocator has to be closed *after*
|
||||
the connection — see `app.graph.arrow/with-allocator!`."
|
||||
[system ^Connection conn file-id & {:keys [arrow-alloc] :as opts}]
|
||||
(if arrow-alloc
|
||||
(ingest-on-connection*! system conn file-id arrow-alloc opts)
|
||||
(graph.arrow/with-allocator!
|
||||
(fn [allocator] (ingest-on-connection*! system conn file-id allocator opts)))))
|
||||
|
||||
(defn ingest-file!
|
||||
[system file-id & {:keys [db-path reset-db? skip-stats? skip-validation?]
|
||||
:or {reset-db? true}}]
|
||||
(let [db-path (or db-path (ladybug/db-path-for-file (h/parse-uuid file-id)))]
|
||||
(when reset-db?
|
||||
(ladybug/reset-db-path! db-path))
|
||||
;; Allocator outermost: Ladybug holds the staged Arrow buffers until its
|
||||
;; tables are dropped, which is no later than connection close, so the
|
||||
;; allocator must be closed after the connection and the database.
|
||||
(graph.arrow/with-allocator!
|
||||
(fn [allocator]
|
||||
(ladybug/with-connection! db-path
|
||||
(fn [conn]
|
||||
(ingest-on-connection*! system conn file-id allocator
|
||||
{:db-path db-path
|
||||
:skip-stats? skip-stats?
|
||||
:skip-validation? skip-validation?})))))))
|
||||
@@ -0,0 +1,504 @@
|
||||
;; 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.ladybug
|
||||
"Ladybug access layer for graph-backed Penpot.
|
||||
|
||||
Uses the embedded Java API (`com.ladybugdb/lbug`)."
|
||||
(:require
|
||||
[app.common.exceptions :as ex]
|
||||
[app.common.json :as json]
|
||||
[app.graph.schema.values :as values]
|
||||
[clojure.string :as str]
|
||||
[datoteka.fs :as fs])
|
||||
(:import
|
||||
com.ladybugdb.Connection
|
||||
com.ladybugdb.Database
|
||||
com.ladybugdb.FlatTuple
|
||||
com.ladybugdb.PreparedStatement
|
||||
com.ladybugdb.QueryResult
|
||||
com.ladybugdb.Value))
|
||||
|
||||
(set! *warn-on-reflection* true)
|
||||
|
||||
(defn default-graph-dir
|
||||
[]
|
||||
(or (System/getenv "PENPOT_GRAPH_DIR") "/tmp/penpot-graph"))
|
||||
|
||||
(defn db-path-for-file
|
||||
[file-id]
|
||||
(str (fs/path (default-graph-dir) (str file-id ".lbug"))))
|
||||
|
||||
(defn- memory-db-path?
|
||||
[db-path]
|
||||
(= db-path ":memory:"))
|
||||
|
||||
(defn reset-db-path!
|
||||
[db-path]
|
||||
(when-not (memory-db-path? db-path)
|
||||
(when (fs/exists? db-path)
|
||||
(fs/delete db-path))))
|
||||
|
||||
(defn escape-cypher-string
|
||||
[s]
|
||||
(-> (str s)
|
||||
(str/replace "\\" "\\\\")
|
||||
(str/replace "'" "\\'")))
|
||||
|
||||
(defn format-uuid
|
||||
[id]
|
||||
(str "uuid('" (str id) "')"))
|
||||
|
||||
(defn format-string
|
||||
[s]
|
||||
(str "'" (escape-cypher-string s) "'"))
|
||||
|
||||
(defn format-int
|
||||
[n]
|
||||
(str (long n)))
|
||||
|
||||
(defn format-number
|
||||
[n]
|
||||
(if (== n (long n))
|
||||
(format-int n)
|
||||
(str (double n))))
|
||||
|
||||
(defn format-json
|
||||
[v]
|
||||
(str "json('" (escape-cypher-string (json/encode v)) "')"))
|
||||
|
||||
(defn format-timestamp
|
||||
"Ladybug TIMESTAMP literal of the form `timestamp('<ISO-8601 instant>')`."
|
||||
[v]
|
||||
(let [s (cond
|
||||
(instance? java.time.Instant v)
|
||||
(.toString ^java.time.Instant v)
|
||||
|
||||
(instance? java.util.Date v)
|
||||
(.toString (.toInstant ^java.util.Date v))
|
||||
|
||||
(string? v)
|
||||
v
|
||||
|
||||
:else
|
||||
(str v))]
|
||||
(str "timestamp('" (escape-cypher-string s) "')")))
|
||||
|
||||
(defn format-value
|
||||
[v]
|
||||
(cond
|
||||
(nil? v) "NULL"
|
||||
(uuid? v) (format-uuid v)
|
||||
(instance? java.time.Instant v) (format-timestamp v)
|
||||
(instance? java.util.Date v) (format-timestamp v)
|
||||
(string? v) (format-string v)
|
||||
(number? v) (format-number v)
|
||||
(boolean? v) (if v "true" "false")
|
||||
(keyword? v) (format-string (name v))
|
||||
(map? v) (format-json v)
|
||||
(coll? v) (format-json v)
|
||||
:else (format-string (str v))))
|
||||
|
||||
(defn map-type?
|
||||
"Is `ladybug-type` a MAP column?"
|
||||
[ladybug-type]
|
||||
(and (string? ladybug-type)
|
||||
(str/starts-with? ladybug-type "MAP(")
|
||||
(not (str/ends-with? ladybug-type "]"))))
|
||||
|
||||
(defn list-type?
|
||||
"Is this a list or fixed-size array type? Checked before MAP and STRUCT,
|
||||
since `STRUCT(…)[]` starts with `STRUCT(` but is a list of them."
|
||||
[ladybug-type]
|
||||
(and (string? ladybug-type)
|
||||
(some? (re-matches #".+\[\d*\]$" ladybug-type))))
|
||||
|
||||
(defn struct-type?
|
||||
[ladybug-type]
|
||||
(and (string? ladybug-type)
|
||||
(str/starts-with? ladybug-type "STRUCT(")
|
||||
(not (list-type? ladybug-type))))
|
||||
|
||||
(declare format-typed-value)
|
||||
|
||||
(defn- format-typed-list
|
||||
"Cypher LIST literal, elements formatted by the element type.
|
||||
|
||||
Handles `T[]` and the fixed-size `T[n]` alike: the size constrains the column,
|
||||
not the literal."
|
||||
[ladybug-type v]
|
||||
(let [element (second (re-matches #"(.+?)\[\d*\]$" ladybug-type))
|
||||
elems (if (or (sequential? v) (set? v)) (seq v) [v])]
|
||||
(str "[" (str/join ", " (map #(format-typed-value element %) elems)) "]")))
|
||||
|
||||
(defn- format-struct
|
||||
"Cypher STRUCT literal, `{field: value, …}`.
|
||||
|
||||
*Every* declared field is emitted, NULL where the value has none: a struct
|
||||
literal's type is its field list, so omitting a field yields a different type
|
||||
and Ladybug refuses the implicit cast (`STRUCT(m2 DOUBLE, m4 DOUBLE)` cannot
|
||||
be assigned to `STRUCT(m1 …, m2 …, m3 …, m4 …)`). Penpot's layout margins are
|
||||
exactly that case — a shape sets only the sides it overrides."
|
||||
[ladybug-type v]
|
||||
(let [fields (values/struct-fields ladybug-type)]
|
||||
(str "{"
|
||||
(str/join ", "
|
||||
(for [[field field-type] fields
|
||||
:let [fv (get v field)]]
|
||||
;; Backticked for the same reason as in the DDL: a field
|
||||
;; named `column` is a keyword and will not parse bare.
|
||||
;; A bare NULL is typed STRING, which changes the struct's
|
||||
;; type as surely as omitting the field would, so absent
|
||||
;; fields get a NULL cast to their declared type.
|
||||
(str "`" field "`: "
|
||||
(if (nil? fv)
|
||||
(str "cast(NULL, '" field-type "')")
|
||||
(format-typed-value field-type fv)))))
|
||||
"}")))
|
||||
|
||||
(defn format-typed-value
|
||||
"Cypher literal for `v` in a column of `ladybug-type`.
|
||||
|
||||
Recursive over the type language, because the types are: a
|
||||
`MAP(UUID, STRUCT(…))` needs its keys, its fields and each field's own type
|
||||
honoured. `app.graph.schema.values/coerce` shapes the value first — turning a
|
||||
matrix record into six doubles, a hex colour into a packed integer — so this
|
||||
function only has to escape plain data.
|
||||
|
||||
`map-key-fn` renders the keys of a `MAP(STRING, …)`; the caller supplies it
|
||||
because the right form is a property of the column, not of this function
|
||||
(`app.graph.schema.contract/map-key-fn`)."
|
||||
([ladybug-type v] (format-typed-value ladybug-type v nil))
|
||||
([ladybug-type v map-key-fn]
|
||||
(let [v (values/coerce ladybug-type v)]
|
||||
(cond
|
||||
(nil? v)
|
||||
"NULL"
|
||||
|
||||
(list-type? ladybug-type)
|
||||
(format-typed-list ladybug-type v)
|
||||
|
||||
(map-type? ladybug-type)
|
||||
(let [[key-type value-type] (values/map-types ladybug-type)
|
||||
entries (seq v)
|
||||
format-key (if (and map-key-fn (= "STRING" key-type))
|
||||
#(format-string (map-key-fn (key %)))
|
||||
#(format-typed-value key-type (key %)))]
|
||||
(str "map([" (str/join ", " (map format-key entries))
|
||||
"], ["
|
||||
(str/join ", " (map #(format-typed-value value-type (val %)) entries))
|
||||
"])"))
|
||||
|
||||
(struct-type? ladybug-type)
|
||||
(format-struct ladybug-type v)
|
||||
|
||||
(= ladybug-type "JSON")
|
||||
(format-json v)
|
||||
|
||||
;; Coerce string ids from transit edge-cases into UUID literals.
|
||||
(= ladybug-type "UUID")
|
||||
(format-uuid v)
|
||||
|
||||
(= ladybug-type "TIMESTAMP")
|
||||
(format-timestamp v)
|
||||
|
||||
:else
|
||||
(format-value v)))))
|
||||
|
||||
(defn- ensure-semicolon
|
||||
[statement]
|
||||
(let [s (str/trim (str statement))]
|
||||
(if (str/ends-with? s ";") s (str s ";"))))
|
||||
|
||||
(defn- value->clj
|
||||
[^Value value]
|
||||
(when-not (.isNull value)
|
||||
(let [v (try
|
||||
(.getValue value)
|
||||
(catch Exception _
|
||||
;; LIST/STRUCT values are not supported by the binding's
|
||||
;; getValue (\"value_get_value\"); fall back to the textual
|
||||
;; representation so console queries do not crash.
|
||||
(.toString value)))]
|
||||
(cond
|
||||
(instance? Long v) v
|
||||
(instance? Integer v) (long v)
|
||||
(instance? Double v) v
|
||||
:else v))))
|
||||
|
||||
(defn- check-success!
|
||||
[^QueryResult result statement]
|
||||
(when-not (.isSuccess result)
|
||||
(let [err (.getErrorMessage result)]
|
||||
(ex/raise :type :internal
|
||||
:code :ladybug-query-failed
|
||||
:hint (str "Ladybug query failed: " err)
|
||||
:statement statement
|
||||
:err err))))
|
||||
|
||||
(defn- query-columns
|
||||
[^QueryResult result]
|
||||
(let [ncols (.getNumColumns result)]
|
||||
(vec (for [i (range ncols)]
|
||||
(.getColumnName result (long i))))))
|
||||
|
||||
(defn- query-row
|
||||
[^FlatTuple tuple ncols]
|
||||
(vec (for [i (range ncols)]
|
||||
(with-open [^Value value (.getValue tuple (long i))]
|
||||
(value->clj value)))))
|
||||
|
||||
(def ^:private default-query-max-rows 200)
|
||||
|
||||
(defn- read-query-rows
|
||||
[^QueryResult result ncols max-rows]
|
||||
(loop [rows [] n 0]
|
||||
(if (and (< n max-rows) (.hasNext result))
|
||||
(let [row (with-open [^FlatTuple tuple (.getNext result)]
|
||||
(query-row tuple ncols))]
|
||||
(recur (conj rows row) (inc n)))
|
||||
rows)))
|
||||
|
||||
(defn query-on-connection!
|
||||
"Execute a Cypher query on `conn` and return tabular results.
|
||||
|
||||
Returns `{:columns [...] :rows [[...] ...] :truncated? bool}`."
|
||||
[^Connection conn statement & {:keys [max-rows]
|
||||
:or {max-rows default-query-max-rows}}]
|
||||
(let [cypher (ensure-semicolon statement)]
|
||||
(with-open [^QueryResult result (.query conn cypher)]
|
||||
(check-success! result cypher)
|
||||
(let [ncols (long (.getNumColumns result))
|
||||
columns (query-columns result)
|
||||
rows (read-query-rows result ncols max-rows)
|
||||
total (long (.getNumTuples result))]
|
||||
{:columns columns
|
||||
:rows rows
|
||||
:truncated? (and (pos? total) (> total (count rows)))}))))
|
||||
|
||||
(def ^:private default-query-timeout-ms
|
||||
"0 disables query timeout (recommended for bulk COPY ingest)."
|
||||
0)
|
||||
|
||||
(defn- scalar-value
|
||||
[^Connection conn statement]
|
||||
(let [cypher (ensure-semicolon statement)]
|
||||
(with-open [^QueryResult result (.query conn cypher)]
|
||||
(check-success! result cypher)
|
||||
(when (.hasNext result)
|
||||
(with-open [^FlatTuple tuple (.getNext result)]
|
||||
(with-open [^Value value (.getValue tuple 0)]
|
||||
(value->clj value)))))))
|
||||
|
||||
(defn- extension-statement-ok?
|
||||
[err-msg]
|
||||
(let [err (str/lower-case (or err-msg ""))]
|
||||
(or (str/includes? err "already loaded")
|
||||
(str/includes? err "already installed"))))
|
||||
|
||||
(defn- run-extension-statement!
|
||||
[^Connection conn statement]
|
||||
(let [cypher (ensure-semicolon statement)]
|
||||
(with-open [^QueryResult result (.query conn cypher)]
|
||||
(when-not (.isSuccess result)
|
||||
(let [err (.getErrorMessage result)]
|
||||
(when-not (extension-statement-ok? err)
|
||||
(check-success! result cypher)))))))
|
||||
|
||||
(defn ensure-extensions!
|
||||
"Install and load Ladybug extensions required by graph ingest and sync."
|
||||
[^Connection conn]
|
||||
(run-extension-statement! conn "INSTALL json;")
|
||||
(run-extension-statement! conn "LOAD json;"))
|
||||
|
||||
(defn- run-statements!
|
||||
[^Connection conn statements]
|
||||
(doseq [statement statements]
|
||||
(let [cypher (ensure-semicolon statement)]
|
||||
(with-open [^QueryResult result (.query conn cypher)]
|
||||
(check-success! result cypher)))))
|
||||
|
||||
(defn- ensure-db-path!
|
||||
[db-path]
|
||||
(when-not (memory-db-path? db-path)
|
||||
(fs/create-dir (fs/parent db-path))))
|
||||
|
||||
(defn with-connection!
|
||||
"Open a Ladybug connection for `db-path` and invoke `(f conn)`.
|
||||
|
||||
Options:
|
||||
- `:query-timeout-ms` query timeout in milliseconds (default 0, disabled)
|
||||
|
||||
For `:memory:`, the database only lives for the duration of this call;
|
||||
all reads and writes must happen inside `f`."
|
||||
[db-path f & {:keys [query-timeout-ms]
|
||||
:or {query-timeout-ms default-query-timeout-ms}}]
|
||||
(ensure-db-path! db-path)
|
||||
(let [^Database db (if (memory-db-path? db-path)
|
||||
(Database.)
|
||||
(Database. (str db-path)))]
|
||||
(try
|
||||
(let [^Connection conn (Connection. db)]
|
||||
(try
|
||||
(.setQueryTimeout conn (long query-timeout-ms))
|
||||
(ensure-extensions! conn)
|
||||
(f conn)
|
||||
(finally
|
||||
(.close conn))))
|
||||
(finally
|
||||
(.close db)))))
|
||||
|
||||
(defn exec-on-connection!
|
||||
"Execute Cypher statements on an open Ladybug connection."
|
||||
[^Connection conn statements]
|
||||
(assert (sequential? statements) "statements should be a sequential collection")
|
||||
(run-statements! conn statements))
|
||||
|
||||
;; --- prepared statements
|
||||
|
||||
(defn- ->param-value
|
||||
"Clojure scalar → `Value` for prepared-statement binding.
|
||||
|
||||
This is the only `Value` constructor on the write path, so every parameter
|
||||
is wrapped here. Parameters are scalars: the `Value` constructor takes no
|
||||
list or map, so `MAP`, `STRUCT` and `T[]` columns stay literal-rendered
|
||||
(`format-typed-value`) and the `:else` raise below means a caller tried to
|
||||
bind one."
|
||||
^Value [v]
|
||||
(cond
|
||||
(nil? v) (Value/createNull) ; no explicit type needed
|
||||
(uuid? v) (Value. ^Object v) ; native UUID
|
||||
(string? v) (Value. ^Object v)
|
||||
(boolean? v) (Value. ^Object v)
|
||||
(integer? v) (Value. ^Object (long v))
|
||||
(number? v) (Value. ^Object (double v))
|
||||
(keyword? v) (Value. ^Object (name v))
|
||||
|
||||
(instance? java.time.Instant v) ; native TIMESTAMP
|
||||
(Value. ^Object v)
|
||||
|
||||
(instance? java.util.Date v)
|
||||
(Value. ^Object (.toInstant ^java.util.Date v))
|
||||
|
||||
:else
|
||||
(ex/raise :type :internal
|
||||
:code :ladybug-unsupported-param
|
||||
:hint (str "cannot bind a " (type v) " as a Ladybug parameter; "
|
||||
"compound columns must be literal-rendered")
|
||||
:value v)))
|
||||
|
||||
(defn- as-statement
|
||||
"Normalize a statement to `{:cypher … :params …}`.
|
||||
|
||||
A bare string binds nothing, so the sync builders can convert to bound
|
||||
parameters one family at a time."
|
||||
[stmt]
|
||||
(if (map? stmt)
|
||||
(update stmt :params #(or % {}))
|
||||
{:cypher stmt :params {}}))
|
||||
|
||||
(defn prepare-on-connection!
|
||||
"Parse and bind `statement` on `conn` without executing it.
|
||||
|
||||
The returned `PreparedStatement` is a JNI resource: the caller closes it."
|
||||
^PreparedStatement [^Connection conn statement]
|
||||
(let [cypher (ensure-semicolon statement)
|
||||
ps (.prepare conn cypher)]
|
||||
(when-not (.isSuccess ps)
|
||||
(let [err (.getErrorMessage ps)]
|
||||
(.close ps)
|
||||
(ex/raise :type :internal
|
||||
:code :ladybug-prepare-failed
|
||||
:hint (str "Ladybug prepare failed: " err)
|
||||
:statement cypher
|
||||
:err err)))
|
||||
ps))
|
||||
|
||||
(defn execute-prepared!
|
||||
"Bind `params` into `ps` and execute it on `conn`.
|
||||
|
||||
`params` keys are parameter names without the `$` (keyword or string);
|
||||
values are scalars. Every bound `Value` is closed, including the ones built
|
||||
before a later parameter is rejected."
|
||||
[^Connection conn ^PreparedStatement ps params]
|
||||
(let [vmap (java.util.HashMap.)]
|
||||
(try
|
||||
(doseq [[k v] params]
|
||||
(.put vmap (name k) (->param-value v)))
|
||||
(with-open [^QueryResult result (.execute conn ps vmap)]
|
||||
(check-success! result "<prepared>"))
|
||||
(finally
|
||||
(run! #(.close ^Value %) (.values vmap))))))
|
||||
|
||||
(defn exec-prepared-on-connection!
|
||||
"Prepare all statements, then execute all of them.
|
||||
|
||||
A parse or bind failure in *any* statement aborts the batch before the first
|
||||
mutation runs — the bind-level batch gate. Statements are
|
||||
`{:cypher … :params {…}}` maps or bare strings."
|
||||
[^Connection conn stmts]
|
||||
(assert (sequential? stmts) "statements should be a sequential collection")
|
||||
(let [prepared (volatile! [])]
|
||||
(try
|
||||
(doseq [stmt stmts]
|
||||
(let [{:keys [cypher params]} (as-statement stmt)]
|
||||
(vswap! prepared conj {:ps (prepare-on-connection! conn cypher)
|
||||
:params params})))
|
||||
(doseq [{:keys [ps params]} @prepared]
|
||||
(execute-prepared! conn ps params))
|
||||
(finally
|
||||
(run! #(.close ^PreparedStatement (:ps %)) @prepared)))))
|
||||
|
||||
(defn validate-on-connection!
|
||||
"Binder gate: parse and semantic-check `statement` against the live schema,
|
||||
without executing it.
|
||||
|
||||
Returns `{:ok? … :error … :read-only? …}`. Unlike `prepare-on-connection!`
|
||||
a failure is a return value rather than a raise: the callers are gates (the
|
||||
CI binder gate, the console read-only gate) that report it. `:read-only?` is
|
||||
the engine's own read/write analysis."
|
||||
[^Connection conn statement]
|
||||
(with-open [^PreparedStatement ps (.prepare conn (ensure-semicolon statement))]
|
||||
(let [ok? (.isSuccess ps)]
|
||||
{:ok? ok?
|
||||
:error (when-not ok? (.getErrorMessage ps))
|
||||
:read-only? (when ok? (.isReadOnly ps))})))
|
||||
|
||||
(defn query-scalar-on-connection!
|
||||
"Execute a query expected to return a single scalar value on `conn`."
|
||||
[^Connection conn statement]
|
||||
(scalar-value conn statement))
|
||||
|
||||
(defn exec!
|
||||
"Execute Cypher statements against a Ladybug database.
|
||||
|
||||
`db-path` is either `:memory:` or a filesystem path to a `.lbug` database."
|
||||
[db-path statements]
|
||||
(with-connection! db-path
|
||||
(fn [conn]
|
||||
(exec-on-connection! conn statements))))
|
||||
|
||||
(defn query-scalar!
|
||||
"Execute a query expected to return a single scalar value."
|
||||
[db-path statement]
|
||||
(with-connection! db-path
|
||||
(fn [conn]
|
||||
(query-scalar-on-connection! conn statement))))
|
||||
|
||||
(defn smoke-test!
|
||||
"Run a minimal CREATE + count against Ladybug."
|
||||
[& {:keys [db-path] :or {db-path ":memory:"}}]
|
||||
(when-not (memory-db-path? db-path)
|
||||
(reset-db-path! db-path))
|
||||
(with-connection! db-path
|
||||
(fn [^Connection conn]
|
||||
(run-statements! conn
|
||||
["CREATE NODE TABLE Person(name STRING, age INT64, PRIMARY KEY(name));"
|
||||
"CREATE (:Person {name: 'Alice', age: 25});"
|
||||
"CREATE (:Person {name: 'Bob', age: 30});"])
|
||||
{:db-path db-path
|
||||
:person-count (scalar-value conn
|
||||
"MATCH (a:Person) RETURN count(a) AS c;")})))
|
||||
@@ -0,0 +1,93 @@
|
||||
;; 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, from what, and what
|
||||
it did.
|
||||
|
||||
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.
|
||||
|
||||
Ingestion is a partial port, so a graph can arrive with any subset of the
|
||||
pipeline applied. `transforms` names what this build did, and the parity
|
||||
consumer computes the complement and runs only that in Python. The ids cross
|
||||
a language boundary as data, so they are kebab-case strings rather than
|
||||
keywords and must stay byte-identical to the consumer's own list.
|
||||
|
||||
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]
|
||||
[clojure.string :as str])
|
||||
(: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, "
|
||||
"`transforms` STRING[], "
|
||||
"`built_at` TIMESTAMP, "
|
||||
"PRIMARY KEY (`source_file_id`));"))
|
||||
|
||||
(def projection-transforms
|
||||
"Transform ids this backend satisfies while *projecting*, before any
|
||||
transform pass runs.
|
||||
|
||||
A reader cares whether the result is in the graph, not how it got there. The
|
||||
consumer derives `IsChildOf` from persisted `shapes` arrays in a later pass;
|
||||
`app.graph.project.document/project-shape-ids` emits the edges during the
|
||||
tree walk. Same id, same observable graph. The two denormalizations are the
|
||||
same case."
|
||||
["add-document"
|
||||
"link-contained-shapes"
|
||||
"denormalize-page-id"
|
||||
"denormalize-component-id"])
|
||||
|
||||
(defn- format-transforms
|
||||
[ids]
|
||||
(str "[" (->> (sort (distinct ids))
|
||||
(map ladybug/format-string)
|
||||
(str/join ", "))
|
||||
"]"))
|
||||
|
||||
(defn write!
|
||||
"Record what this build produced for `file-id`.
|
||||
|
||||
`transform-ids` are the ids applied *on top of* `projection-transforms`, so
|
||||
a caller only names what its transform pass did."
|
||||
[^Connection conn {:keys [file-id revn transform-ids]}]
|
||||
(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.transforms = " (format-transforms (concat projection-transforms transform-ids)) ", "
|
||||
"m.built_at = " (ladybug/format-timestamp (ct/now)) ";")]))
|
||||
|
||||
@@ -0,0 +1,214 @@
|
||||
;; 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.projection.document
|
||||
"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.
|
||||
|
||||
Two denormalizations happen here rather than in a later pass, because the
|
||||
walk already has both answers in hand and a post-ingest statement would have
|
||||
to rediscover them:
|
||||
|
||||
- `page-id` on every shape, from the page the walk is currently in;
|
||||
- `component-id` propagated from an instance head down to its descendants,
|
||||
from the head context the walk carries."
|
||||
(:require
|
||||
[app.common.logging :as l]
|
||||
[app.common.uuid :as uuid]
|
||||
[app.graph.schema.nodes :as nodes]))
|
||||
|
||||
(def root-frame-id
|
||||
uuid/zero)
|
||||
|
||||
(defn- document-attrs
|
||||
"The Document node's attrs: the file row, minus its data blob.
|
||||
|
||||
`:options` is lifted out of the blob before it goes: it is file-level
|
||||
configuration a consumer wants without opening `:data`."
|
||||
[file data]
|
||||
(-> file
|
||||
(assoc :id (or (:id data) (:id file)))
|
||||
(cond-> (:options data) (assoc :options (:options data)))
|
||||
(dissoc :data)))
|
||||
|
||||
(defn- page-attrs
|
||||
[page index]
|
||||
(-> page
|
||||
(dissoc :objects)
|
||||
(cond-> (some? index) (assoc :index (long index)))))
|
||||
|
||||
(defn- component-attrs
|
||||
[component]
|
||||
(-> component
|
||||
(dissoc :objects)
|
||||
;; schema:component requires :path; some legacy rows omit it
|
||||
(update :path #(or % ""))))
|
||||
|
||||
(defn- shape-table
|
||||
[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 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.
|
||||
|
||||
Inheritance stops at the nearest ancestor Frame carrying a `component-id`,
|
||||
and any intermediate shape that carries one is 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]
|
||||
(contains? nodes/container-tables table))
|
||||
|
||||
(defn- child-shape-ids
|
||||
"Child ids in Penpot z-order (reversed from the stored :shapes list)."
|
||||
[parent]
|
||||
(when-let [shapes (:shapes parent)]
|
||||
(vec (reverse shapes))))
|
||||
|
||||
(defn- initial-acc
|
||||
[]
|
||||
{:nodes {}
|
||||
:edges []
|
||||
:stats {:documents 0 :pages 0 :components 0 :shapes 0}})
|
||||
|
||||
(declare project-shape-ids)
|
||||
|
||||
(defn- project-shape
|
||||
[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 page-id component-ctx))
|
||||
(update :edges conj {:from-table table
|
||||
:from-id shape-id
|
||||
:to-table parent-table
|
||||
:to-id parent-id
|
||||
:position position})
|
||||
(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 page-id
|
||||
(descend-component-ctx table shape component-ctx))
|
||||
acc')))
|
||||
|
||||
(defn- project-shape-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
|
||||
page-id component-ctx)
|
||||
(do
|
||||
(l/wrn :hint "unsupported shape type for graph slice"
|
||||
:shape-id (str shape-id)
|
||||
:type (:type shape))
|
||||
acc))
|
||||
(do
|
||||
(l/wrn :hint "missing shape in page objects"
|
||||
:shape-id (str shape-id))
|
||||
acc)))
|
||||
acc
|
||||
(map-indexed vector child-ids)))
|
||||
|
||||
(defn- project-page
|
||||
[acc doc-id page position]
|
||||
(let [page-id (:id page)
|
||||
objects (:objects page)
|
||||
root (get objects root-frame-id)
|
||||
page-node (nodes/project-attrs "Page" (page-attrs page position))
|
||||
acc' (-> acc
|
||||
(update-in [:nodes "Page"] (fnil conj []) page-node)
|
||||
(update :edges conj {:from-table "Page"
|
||||
:from-id page-id
|
||||
:to-table "Document"
|
||||
:to-id doc-id
|
||||
: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 page-id nil)
|
||||
acc')))
|
||||
|
||||
(defn- project-component
|
||||
[acc doc-id component position]
|
||||
(if (:deleted component)
|
||||
acc
|
||||
(let [comp-id (:id component)
|
||||
node (nodes/project-attrs "Component" (component-attrs component))]
|
||||
(-> acc
|
||||
(update-in [:nodes "Component"] (fnil conj []) node)
|
||||
(update :edges conj {:from-table "Component"
|
||||
:from-id comp-id
|
||||
:to-table "Document"
|
||||
:to-id doc-id
|
||||
:position position})
|
||||
(update-in [:stats :components] inc)))))
|
||||
|
||||
(defn- project-components
|
||||
[acc doc-id components]
|
||||
(reduce (fn [acc [position [_id component]]]
|
||||
(project-component acc doc-id component position))
|
||||
acc
|
||||
(map-indexed vector components)))
|
||||
|
||||
(defn projection-data
|
||||
"Build node/edge rows for projecting `data` into Ladybug.
|
||||
|
||||
Returns `{:nodes {table [attrs ...]} :edges [...] :stats {...}}`."
|
||||
[data file]
|
||||
(let [doc-id (or (:id data) (:id file))
|
||||
doc-node (nodes/project-attrs "Document" (document-attrs file 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)
|
||||
(assoc-in [:stats :documents] 1))
|
||||
acc (cond-> acc0
|
||||
(seq comps)
|
||||
(project-components doc-id comps))
|
||||
acc (if (empty? pages)
|
||||
acc
|
||||
(reduce (fn [acc [position page-id]]
|
||||
(if-let [page (get-in data [:pages-index page-id])]
|
||||
(project-page acc doc-id page position)
|
||||
(do
|
||||
(l/wrn :hint "missing page in pages-index"
|
||||
:page-id (str page-id))
|
||||
acc)))
|
||||
acc
|
||||
(map-indexed vector pages)))]
|
||||
(select-keys acc [:nodes :edges :stats])))
|
||||
@@ -0,0 +1,149 @@
|
||||
;; 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.projection.transforms
|
||||
"Derived graph links: edges a reader could compute from the projected
|
||||
columns, materialized once at build time so a query does not have to.
|
||||
|
||||
Each entry in `registry` names the transform, the relationship it produces,
|
||||
and the function that produces it, so adding one is a single entry and
|
||||
nothing else has to be told about it."
|
||||
(:require
|
||||
[app.common.logging :as l]
|
||||
[app.graph.ladybug :as ladybug]
|
||||
[app.graph.schema.nodes :as nodes])
|
||||
(:import
|
||||
com.ladybugdb.Connection))
|
||||
|
||||
(set! *warn-on-reflection* true)
|
||||
|
||||
(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.
|
||||
|
||||
Every head is linked, the main instance and any copy root alike.
|
||||
|
||||
`component-file` is what makes a head a head here, not `component-id` alone.
|
||||
`app.common.types.component/instance-of?` requires both, and the projection
|
||||
denormalizes `component-id` down the shape tree
|
||||
(`app.graph.projection.document`), so on its own it no longer distinguishes a
|
||||
head from a shape that merely lives inside one. `component-file` is not
|
||||
denormalized and remains the head marker Penpot itself uses."
|
||||
[^Connection conn]
|
||||
(run-scalar! conn
|
||||
(str "MATCH (f:Frame), (c:Component) "
|
||||
"WHERE f.component_id = c.id "
|
||||
"AND f.component_file IS NOT NULL "
|
||||
"AND NOT COALESCE(c.deleted, false) "
|
||||
"MERGE (f)-[:IsInstanceOf]->(c) "
|
||||
"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`, a constraint inherited from Kùzu, which it forks (upstream
|
||||
issue kuzudb/kuzu#5841). The loop over label pairs is that 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,
|
||||
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.
|
||||
|
||||
Penpot records a component sub-shape swap as a `swap-slot-<uuid>` entry in
|
||||
the *replacing* shape's `touched` set, where `<uuid>` names the replaced
|
||||
slot shape in the main instance. The entries are then stripped from
|
||||
`touched`, as `app.common.types.component/normal-touched-groups` does, so a
|
||||
reader of `touched` sees design edits rather than swap bookkeeping.
|
||||
|
||||
Stripping makes this the one transform that writes a column another
|
||||
transform could read. Anything reading `touched` has to run before it."
|
||||
[^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.
|
||||
|
||||
`:id` names the transform in the ingest report and the log. `:rel` names
|
||||
the relationship it produces. The three registered here read disjoint
|
||||
columns, so the vector order is not load-bearing. The one ordering
|
||||
constraint that exists is stated on `link-swap-slots!`."
|
||||
[{: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 every registered transform to an already loaded graph.
|
||||
|
||||
Returns `{:ids [...] :counts {...} :transforms n}`, where `:ids` names what
|
||||
ran and `:counts` gives the edges each one produced."
|
||||
[_system ^Connection conn _data _file]
|
||||
(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))
|
||||
@@ -0,0 +1,65 @@
|
||||
;; 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.report
|
||||
(:require
|
||||
[clojure.core :as c]
|
||||
[clojure.string :as str]))
|
||||
|
||||
(defn- println!
|
||||
[& lines]
|
||||
(doseq [line lines]
|
||||
(println line)))
|
||||
|
||||
(defn- section-title
|
||||
[title]
|
||||
(println! (str "\n" title)
|
||||
(str (apply str (repeat (count title) "─")))))
|
||||
|
||||
(defn- kv-line
|
||||
[k v]
|
||||
(format " %-14s %s" (str k ":") v))
|
||||
|
||||
(defn- print-node-counts
|
||||
[nodes]
|
||||
(doseq [[table count] (sort-by first nodes)
|
||||
:when (pos? (long count))]
|
||||
(println! (kv-line table count))))
|
||||
|
||||
(defn print-ingest!
|
||||
"Pretty-print the result map returned by `app.graph.ingest/ingest-file!`."
|
||||
[{:keys [file-id revn name db-path schema-version projection transforms stats]}]
|
||||
(section-title "Graph ingest")
|
||||
(println! (kv-line "File" (str name " (" file-id ")"))
|
||||
(kv-line "Revision" revn)
|
||||
(kv-line "Schema" schema-version)
|
||||
(kv-line "Database" db-path))
|
||||
|
||||
(when-let [pstats (:stats projection)]
|
||||
(section-title "Projection")
|
||||
(doseq [[k v] (sort-by key pstats)]
|
||||
(println! (kv-line (c/name k) v))))
|
||||
|
||||
(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")
|
||||
(when-let [nodes (:nodes stats)]
|
||||
(println! " Nodes")
|
||||
(print-node-counts nodes))
|
||||
(when-let [edges (:edges stats)]
|
||||
(println! " Edges")
|
||||
(doseq [[rel count] (sort-by key edges)
|
||||
:when (pos? (long count))]
|
||||
(println! (kv-line (c/name rel) count)))))
|
||||
|
||||
(println!)
|
||||
nil)
|
||||
@@ -0,0 +1,30 @@
|
||||
;; 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
|
||||
"Ladybug DDL facade for the graph-backed Penpot vertical slice.
|
||||
|
||||
Node metadata and DDL generation live in `app.graph.schema.nodes`."
|
||||
(:require
|
||||
[app.graph.schema.nodes :as nodes]))
|
||||
|
||||
(def schema-version
|
||||
nodes/schema-version)
|
||||
|
||||
(def container-node-tables
|
||||
nodes/container-tables)
|
||||
|
||||
(def shape-node-tables
|
||||
nodes/shape-tables)
|
||||
|
||||
(def node-tables
|
||||
(mapv (fn [{:keys [table schema]}]
|
||||
{:name table :schema schema})
|
||||
nodes/node-types))
|
||||
|
||||
(defn ddl-statements
|
||||
[]
|
||||
(nodes/ddl-statements))
|
||||
@@ -0,0 +1,136 @@
|
||||
;; 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.beadpot
|
||||
"beadpot's graph schema, as a checked-in value.
|
||||
|
||||
`resources/app/graph/beadpot-schema.json` is produced by
|
||||
`bp graph schema export` and read back off an empty database beadpot itself
|
||||
creates, so it states what beadpot *does*: table names, column names in
|
||||
order, Ladybug types, the legal (from, to) pairs of each relationship family,
|
||||
and each column's default.
|
||||
|
||||
This namespace does not generate the DDL — that stays derived from Penpot's
|
||||
own Malli schemas (`app.graph.schema.nodes`), so the backend remains
|
||||
self-contained and a change to the design model shows up here as a diff to
|
||||
review rather than as a silent schema change. What the manifest *is* used for
|
||||
is the things Penpot cannot know on its own:
|
||||
|
||||
- **defaults.** beadpot writes a Pydantic field default where the file has no
|
||||
such attribute, so a shape with no `blocked` key holds `false`, not NULL.
|
||||
A consumer told NULL sees a missing feature where beadpot showed it a false
|
||||
one. The defaults live in beadpot's models; reading them from here keeps
|
||||
them from being restated in Clojure and drifting.
|
||||
- **review.** `backend_tests.graph-contract-test` diffs the DDL this backend
|
||||
emits against the manifest, so a divergence is a failing test naming the
|
||||
column, not something a training set discovers later.
|
||||
|
||||
Regenerate with `bp graph schema export -o
|
||||
backend/resources/app/graph/beadpot-schema.json` after any change to
|
||||
beadpot's node or edge models."
|
||||
(:require
|
||||
[app.common.json :as json]
|
||||
[clojure.java.io :as io]
|
||||
[clojure.string :as str]))
|
||||
|
||||
(def ^:private resource-path
|
||||
"app/graph/beadpot-schema.json")
|
||||
|
||||
(defn- read-manifest
|
||||
[]
|
||||
(if-let [resource (io/resource resource-path)]
|
||||
(with-open [reader (io/reader resource)]
|
||||
(json/read reader :key-fn keyword))
|
||||
(throw (ex-info "beadpot schema manifest missing from resources"
|
||||
{:path resource-path}))))
|
||||
|
||||
(def manifest
|
||||
"The parsed manifest. Delayed so a missing resource fails where it is used."
|
||||
(delay (read-manifest)))
|
||||
|
||||
(defn- index-tables
|
||||
[tables]
|
||||
(into {} (map (juxt :table identity)) tables))
|
||||
|
||||
(def node-tables
|
||||
(delay (index-tables (:node_tables @manifest))))
|
||||
|
||||
(def rel-tables
|
||||
(delay (index-tables (:rel_tables @manifest))))
|
||||
|
||||
(defn table
|
||||
"The manifest entry for `table-name`, node or rel."
|
||||
[table-name]
|
||||
(or (get @node-tables table-name)
|
||||
(get @rel-tables table-name)))
|
||||
|
||||
(defn columns
|
||||
"Column entries for `table-name`, in beadpot's order."
|
||||
[table-name]
|
||||
(:columns (table table-name) []))
|
||||
|
||||
(defn column
|
||||
"The manifest entry for one column, or nil."
|
||||
[table-name column-name]
|
||||
(some #(when (= column-name (:name %)) %) (columns table-name)))
|
||||
|
||||
(def defaults
|
||||
"`table -> {column-name -> default}`, omitting columns with no default.
|
||||
|
||||
A JSON `null` means \"no default\": beadpot leaves the column NULL when the
|
||||
attribute is unset, and so should we."
|
||||
(delay
|
||||
(into {}
|
||||
(map (fn [[table-name entry]]
|
||||
[table-name
|
||||
(into {}
|
||||
(keep (fn [{:keys [name default]}]
|
||||
(when (some? default) [name default])))
|
||||
(:columns entry))]))
|
||||
(merge @node-tables @rel-tables))))
|
||||
|
||||
(defn column-default
|
||||
"beadpot's default for `column-name` on `table-name`, or nil."
|
||||
[table-name column-name]
|
||||
(get-in @defaults [table-name column-name]))
|
||||
|
||||
(def ^:private type-aliases
|
||||
"Declared type spelling → the spelling Ladybug's catalog reports.
|
||||
|
||||
The manifest is read back off a real database, so it holds catalog spellings;
|
||||
DDL is written in whatever Ladybug accepts. `BOOLEAN` is accepted and comes
|
||||
back as `BOOL`, so a literal comparison would decide the two sides disagree
|
||||
about every boolean column."
|
||||
{"BOOLEAN" "BOOL"})
|
||||
|
||||
(defn normalize-type
|
||||
"A Ladybug type string in the spelling the catalog uses.
|
||||
|
||||
Replaces aliases anywhere in the string, so a `BOOLEAN` nested inside a
|
||||
`STRUCT(...)` normalizes too."
|
||||
[ladybug-type]
|
||||
(when ladybug-type
|
||||
(-> (reduce-kv (fn [s declared reported] (str/replace s declared reported))
|
||||
ladybug-type
|
||||
type-aliases)
|
||||
;; STRUCT field names are written backticked (a grid cell has a field
|
||||
;; called `column`); the catalog reports them bare.
|
||||
(str/replace "`" ""))))
|
||||
|
||||
(defn typed-column-default
|
||||
"beadpot's default for a column, but only when the types agree.
|
||||
|
||||
A default is expressed in the column's type — `[]` for a `DOUBLE[2][]`,
|
||||
`{}` for a `JSON`, `[1,0,0,1,0,0]` for a `DOUBLE[6]` transform. Where this
|
||||
backend still emits a different type for that column (`app.graph.schema.types`
|
||||
is coarser than beadpot's encodings in a handful of places, tracked by
|
||||
`bp graph schema diff`), the default would be written in a shape the column
|
||||
cannot hold. So it is withheld until the types match, and the set of columns
|
||||
that get defaults grows as the types converge."
|
||||
[table-name column-name ladybug-type]
|
||||
(when (= (normalize-type ladybug-type)
|
||||
(normalize-type (:type (column table-name column-name))))
|
||||
(column-default table-name column-name)))
|
||||
@@ -0,0 +1,150 @@
|
||||
;; 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
|
||||
"Deliberate choices in Penpot's graph schema, recorded as data.
|
||||
|
||||
Penpot must pick a spelling and a type for every graph column. A Ladybug
|
||||
column gets both once, at table creation, and neither widens afterwards. The
|
||||
choices are therefore worth making deliberately and worth recording.
|
||||
|
||||
Three of them live here:
|
||||
|
||||
- `column-name` maps a Penpot key to its column. The rule is snake_case of
|
||||
the key, and `renames` records every exception.
|
||||
- `dropped-keys` and `per-table-dropped` name Penpot keys that deliberately
|
||||
get no column.
|
||||
- `type-overrides` pins the Ladybug type where the Malli-derived one
|
||||
(`app.graph.schema.types`) is coarser than the column deserves.
|
||||
|
||||
Each entry carries its reason. A divergence from the default rule is then a
|
||||
diff to review rather than a silent rename."
|
||||
(:require
|
||||
[app.common.json :as json]
|
||||
[clojure.string :as str]))
|
||||
|
||||
(def ^:private renames
|
||||
"Penpot key to column name, where the column is not snake_case of the key.
|
||||
|
||||
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."
|
||||
{;; `bool` collides with the Ladybug type name, so the column is named after
|
||||
;; the table (`Boolean`) rather than after Penpot's `:bool` shape type.
|
||||
:bool-type "boolean_type"
|
||||
|
||||
;; The column records what the file saved, which can lag what the shape
|
||||
;; tree implies. The `saved_` prefix marks it as the stored value rather
|
||||
;; than a derivation.
|
||||
:component-root "saved_component_root"
|
||||
|
||||
;; The value is a list, so the plural is accurate.
|
||||
:shadow "shadows"
|
||||
|
||||
;; The column spells the revision number out.
|
||||
:revn "revision"})
|
||||
|
||||
(def dropped-keys
|
||||
"Penpot keys projected by the Malli registry that get no column.
|
||||
|
||||
Dropping is right only when the column would be dead weight for every reader
|
||||
of the graph. A key a reader might learn from belongs in `unprojected-keys`
|
||||
instead."
|
||||
{: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 unprojected-keys
|
||||
"Penpot keys that should become graph columns and do not have one yet.
|
||||
|
||||
Distinct from `dropped-keys` on purpose: these are a debt the projection
|
||||
owes, not a decision to discard data. Keeping the two apart means a new
|
||||
upstream attribute cannot be quietly buried in the drop list."
|
||||
{:background-blur
|
||||
"Landed upstream behind a default-on flag. No column 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. 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 column name, where the derived type is too coarse.
|
||||
|
||||
`app.graph.schema.types` derives a type from the Malli schema, which is the
|
||||
right default but coarser than the column deserves in places: a Malli `:map`
|
||||
becomes `JSON`, where a native Ladybug MAP or a fixed-size array lets a
|
||||
consumer read a tensor row without parsing.
|
||||
|
||||
Only load-bearing divergences are pinned here, in the order they became
|
||||
load-bearing."
|
||||
{;; Must be a native MAP: a JSON blob cannot be indexed by key in Cypher, so
|
||||
;; `map_keys` and `map_extract` cannot reach a single token at all.
|
||||
"applied_tokens" "MAP(STRING, STRING)"
|
||||
|
||||
;; `grc/schema:rect` is an inline `:and` over a map, not the registered
|
||||
;; `::grc/rect`, so `app.graph.schema.types` cannot recognize it by type.
|
||||
;; Four doubles rather than the eight-field struct: `x1`/`y1`/`x2`/`y2` are
|
||||
;; derivable from `x`/`y`/`width`/`height`, and a fixed-size array is a
|
||||
;; tensor row a consumer reads without parsing.
|
||||
"selrect" "DOUBLE[4]"
|
||||
|
||||
;; The SVG provenance attributes are typed `:map` in the shape schema on
|
||||
;; purpose. Legacy files hold them as plain maps rather than as
|
||||
;; `::grc/rect` and `::gmt/matrix` records, and a tighter *schema* would
|
||||
;; reject those files
|
||||
;; (`app.common.types.shape/schema:shape-generic-attrs`). A tighter
|
||||
;; *column* is free: `app.graph.schema.values/coerce` reads either form.
|
||||
"svg_viewbox" "DOUBLE[4]"
|
||||
"svg_transform" "DOUBLE[6]"
|
||||
|
||||
;; `:fills` is an `:or` over the packed `app.common.types.fills` value and
|
||||
;; a plain vector of fill maps, so the schema alone cannot say it is a
|
||||
;; collection. It always is one, and a fill has enough optional shape
|
||||
;; (solid, gradient, image) that JSON per element is the honest element
|
||||
;; type.
|
||||
"fills" "JSON[]"})
|
||||
|
||||
(def ^:private map-key-fns
|
||||
"How to render the *keys* of a MAP column, per column.
|
||||
|
||||
A column name is schema, so it is snake_case. The keys inside a MAP are
|
||||
values, so they keep the spelling their producer used. `applied_tokens` is
|
||||
keyed by shape attribute in the camelCase form
|
||||
`app.common.json/write-camel-key` produces: `strokeWidth`, not
|
||||
`stroke-width`."
|
||||
{"applied_tokens" json/write-camel-key})
|
||||
|
||||
(defn map-key-fn
|
||||
"Key renderer for a MAP column. `name` unless the column says otherwise."
|
||||
[column]
|
||||
(get map-key-fns column name))
|
||||
|
||||
(defn column-name
|
||||
"The graph 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
|
||||
"The pinned Ladybug type for `column`, or `fallback` when nothing is pinned."
|
||||
[column fallback]
|
||||
(get type-overrides column fallback))
|
||||
@@ -0,0 +1,368 @@
|
||||
;; 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.nodes
|
||||
"Single source of truth for graph node tables.
|
||||
|
||||
Each registry entry declares Penpot Malli sources plus projection
|
||||
options (`:drop`, optional `:extra`). Derived artifacts — Ladybug
|
||||
DDL, Arrow fields, validation, type dispatch — all flow from that.
|
||||
|
||||
This registry is the single source of the graph schema. A Ladybug column
|
||||
gets its name and its type once, at table creation, and there is no
|
||||
widening afterwards. Every divergence between a Penpot key and its column
|
||||
is recorded in `app.graph.schema.contract`."
|
||||
(:require
|
||||
[app.common.exceptions :as ex]
|
||||
[app.common.schema :as sm]
|
||||
[app.common.time :as ct]
|
||||
[app.common.types.component :as ctk]
|
||||
[app.common.types.file :as ctf]
|
||||
[app.common.types.page :as ctp]
|
||||
[app.graph.ladybug :as ladybug]
|
||||
[app.graph.schema.beadpot :as beadpot]
|
||||
[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-4")
|
||||
|
||||
(def ^:private document-projection
|
||||
{:source ctf/schema:file
|
||||
:drop [:data]
|
||||
;; Attributes a file map carries that `ctf/schema:file` does not declare.
|
||||
;;
|
||||
;; They belong here rather than in that schema, even though the graph wants
|
||||
;; them, because `schema:file` is on the *write* path too:
|
||||
;; `app.binfile.common/update-file!` derives its UPDATE columns from a file
|
||||
;; map's keys, so declaring `:backend` there made it try to write a `backend`
|
||||
;; column, which the `file` table does not have — it is synthesized on read.
|
||||
;; A projection `:extra` is local to the graph and cannot reach a write.
|
||||
;;
|
||||
;; `:options` is lifted out of `:data` before the blob is dropped
|
||||
;; (`app.graph.projection.document/document-attrs`); the rest come off the file
|
||||
;; map as `get-file` returns it.
|
||||
:extra [:map
|
||||
[:options {:optional true} [:maybe :map]]
|
||||
[:backend {:optional true} [:maybe :string]]
|
||||
[:comment-thread-seqn {:optional true} [:maybe :int]]
|
||||
[:ignore-sync-until {:optional true} [:maybe ::ct/inst]]]})
|
||||
|
||||
(def ^:private page-projection
|
||||
{:source ctp/schema:page
|
||||
:drop [:objects]})
|
||||
|
||||
(def ^:private component-projection
|
||||
{:source ctk/schema:component
|
||||
:drop [:objects]
|
||||
;; Soft-delete flag used at runtime; not in schema:component.
|
||||
:extra [:map
|
||||
[:deleted {:optional true} :boolean]
|
||||
[:annotation {:optional true} :string]]})
|
||||
|
||||
(def ^:private shape-projection
|
||||
{:drop [:type]})
|
||||
|
||||
(def ^:private shape-node-types
|
||||
[{:table "Frame" :penpot-type :frame :container? true}
|
||||
{:table "Group" :penpot-type :group :container? true}
|
||||
{:table "Boolean" :penpot-type :bool :container? true}
|
||||
{:table "SVGRaw" :penpot-type :svg-raw :container? true}
|
||||
{:table "Rectangle" :penpot-type :rect}
|
||||
{:table "Circle" :penpot-type :circle}
|
||||
{:table "Path" :penpot-type :path}
|
||||
{:table "Text" :penpot-type :text}
|
||||
{:table "Image" :penpot-type :image}])
|
||||
|
||||
(defn- resolve-schema
|
||||
[{:keys [schema source drop extra penpot-type]}]
|
||||
(or schema
|
||||
(when penpot-type
|
||||
(projection/project-shape-schema penpot-type
|
||||
{:drop drop
|
||||
:extra extra}))
|
||||
(projection/project-schema source
|
||||
{:drop drop
|
||||
:extra extra})))
|
||||
|
||||
(defn- shape-node-entry
|
||||
[{:keys [table penpot-type container?] :as entry}]
|
||||
(let [projection (-> shape-projection
|
||||
(merge (:projection entry))
|
||||
(assoc :penpot-type penpot-type))]
|
||||
{:table table
|
||||
:pk :id
|
||||
:penpot-type penpot-type
|
||||
:container? container?
|
||||
:projection projection
|
||||
:schema (resolve-schema projection)}))
|
||||
|
||||
(def node-types
|
||||
"Ordered node registry."
|
||||
(into [{:table "Document"
|
||||
:pk :id
|
||||
:projection document-projection
|
||||
:schema (resolve-schema document-projection)}
|
||||
{:table "Page"
|
||||
:pk :id
|
||||
:projection page-projection
|
||||
:schema (resolve-schema page-projection)}
|
||||
{:table "Component"
|
||||
:pk :id
|
||||
:projection component-projection
|
||||
:schema (resolve-schema component-projection)}]
|
||||
(map shape-node-entry shape-node-types)))
|
||||
|
||||
(def ^:private by-table
|
||||
(into {} (map (juxt :table identity) node-types)))
|
||||
|
||||
(def ^:private by-penpot-type
|
||||
(into {} (keep (fn [{:keys [penpot-type table]}]
|
||||
(when penpot-type [penpot-type table]))
|
||||
node-types)))
|
||||
|
||||
(def container-tables
|
||||
(into #{} (comp (filter :container?) (map :table)) node-types))
|
||||
|
||||
(def shape-tables
|
||||
(into [] (comp (filter :penpot-type) (map :table)) node-types))
|
||||
|
||||
(defn table-for-type
|
||||
"Map a Penpot shape `:type` keyword to a Ladybug node table name."
|
||||
[penpot-type]
|
||||
(get by-penpot-type (keyword penpot-type)))
|
||||
|
||||
(defn node-entry
|
||||
[table]
|
||||
(get by-table table))
|
||||
|
||||
(defn projection-for
|
||||
"Return the projection options map for `table`."
|
||||
[table]
|
||||
(:projection (node-entry table)))
|
||||
|
||||
(defn- entry-child-schema
|
||||
"Return the value schema from a Malli map entry (`[k s]` or `[k props s]`)."
|
||||
[entry]
|
||||
(if (> (count entry) 2)
|
||||
(nth entry 2)
|
||||
(nth entry 1)))
|
||||
|
||||
(defn column-name
|
||||
"Graph 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))
|
||||
(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.
|
||||
|
||||
Keys the contract drops on this table are omitted, so the column order, the
|
||||
Arrow batch, and the DDL cannot disagree about what exists."
|
||||
[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 #(column-name table %) (column-keys table)))
|
||||
|
||||
(def ^:private validate-node-fn
|
||||
(memoize
|
||||
(fn [table]
|
||||
(let [{:keys [schema]} (node-entry table)]
|
||||
(sm/check-fn schema
|
||||
:type :validation
|
||||
:code (keyword "graph-node-projection" (str/lower-case table))
|
||||
:hint (str "invalid graph node projection for " table))))))
|
||||
|
||||
(defn- projection-error-hint
|
||||
[table explain]
|
||||
(str "invalid graph node projection for " table
|
||||
(when explain
|
||||
(str "\n" (sm/humanize-explain explain)))))
|
||||
|
||||
(defn validate-node
|
||||
"Validate and return projected node attrs for `table`."
|
||||
[table value]
|
||||
(let [{:keys [schema]} (node-entry table)]
|
||||
(try
|
||||
((validate-node-fn table) value)
|
||||
(catch clojure.lang.ExceptionInfo e
|
||||
(let [data (ex-data e)
|
||||
explain (or (::sm/explain data)
|
||||
(sm/explain schema value))]
|
||||
(ex/raise :type :validation
|
||||
:code (keyword "graph-node-projection" (str/lower-case table))
|
||||
:hint (projection-error-hint table explain)
|
||||
:table table
|
||||
::sm/explain explain
|
||||
:cause e))))))
|
||||
|
||||
(defn- get-projected-attr
|
||||
"The attribute under `k`, keyword or string key.
|
||||
|
||||
`if-some`, not `or`: `false` and `0` are values, and falling through on them
|
||||
is how `opacity 0` became `nil` and then the column default."
|
||||
[attrs k]
|
||||
(if-some [v (get attrs k)]
|
||||
v
|
||||
(when (keyword? k) (get attrs (name k)))))
|
||||
|
||||
(defn- raise-empty-projection!
|
||||
[table attrs]
|
||||
(ex/raise :type :validation
|
||||
:code (keyword "graph-node-projection" (str/lower-case table))
|
||||
:hint (str "empty graph node projection for " table
|
||||
"; columns=" (count (column-keys table))
|
||||
" shape-keys=" (vec (keys attrs)))))
|
||||
|
||||
(defn- apply-defaults
|
||||
"Fill columns the document does not set with the consumer's field defaults.
|
||||
|
||||
A file omits an attribute equal to its default and the consumer's models
|
||||
restore it, so a shape with no `blocked` key holds `false` in the graph the
|
||||
consumer builds. Writing NULL instead hands a reader a *missing* feature
|
||||
where the consumer hands it a false one, so the defaults are read from the
|
||||
exported manifest (`app.graph.schema.beadpot`) rather than restated here,
|
||||
where they would drift.
|
||||
|
||||
Applied after validation: a default belongs to the graph column, not to the
|
||||
Penpot schema the attrs were checked against."
|
||||
[table attrs]
|
||||
(reduce (fn [attrs k]
|
||||
(if (contains? attrs k)
|
||||
attrs
|
||||
(let [column (column-name table k)]
|
||||
(if-some [default (beadpot/typed-column-default
|
||||
table column (column-ladybug-type table k))]
|
||||
(assoc attrs k default)
|
||||
attrs))))
|
||||
attrs
|
||||
(column-keys table)))
|
||||
|
||||
(defn project-attrs
|
||||
"Select and validate the projected columns for `table` from `attrs`."
|
||||
[table attrs]
|
||||
;; `some?`, not truthiness: `false` and `0` are values. Dropping them sent
|
||||
;; `opacity 0` to the column default of 1.0 — a fully transparent shape
|
||||
;; projected as opaque.
|
||||
(let [projected (into {}
|
||||
(keep (fn [k]
|
||||
(let [v (get-projected-attr attrs k)]
|
||||
(when (some? v) [k v])))
|
||||
(column-keys table)))]
|
||||
(when (empty? projected)
|
||||
(raise-empty-projection! table attrs))
|
||||
(apply-defaults table (validate-node table projected))))
|
||||
|
||||
(defn match-label
|
||||
"Cypher node label for MATCH; backtick-wrapped when required by Ladybug."
|
||||
[table]
|
||||
(if (#{"Group" "Boolean"} table)
|
||||
(str "`" table "`")
|
||||
table))
|
||||
|
||||
(defn cypher-property-key
|
||||
"Backtick-wrapped column name for inline Cypher literals."
|
||||
[table k]
|
||||
(str "`" (column-name table k) "`"))
|
||||
|
||||
(defn column-map-key-fn
|
||||
"How a MAP column of `table` renders its keys.
|
||||
|
||||
A MAP's keys are values, not schema, so they keep the spelling their consumer
|
||||
parsed — `applied_tokens` is keyed in camelCase. Both writers need this, so it
|
||||
lives next to the column's type rather than in either of them."
|
||||
[table k]
|
||||
(contract/map-key-fn (column-name table k)))
|
||||
|
||||
(defn format-column-value
|
||||
"Cypher literal for `v` in column `k` of `table`.
|
||||
|
||||
The single place that knows both the column's Ladybug type and the contract
|
||||
detail that a MAP column may render its keys differently from `name` — used
|
||||
by the bulk loader's post-COPY fixups and by the incremental sync alike, so
|
||||
the two cannot disagree about a value's shape."
|
||||
[table k v]
|
||||
(ladybug/format-typed-value (column-ladybug-type table k)
|
||||
v
|
||||
(column-map-key-fn table k)))
|
||||
|
||||
(defn- create-node-table-ddl
|
||||
[{: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 (`" (column-name table pk) "`)")]))
|
||||
");")))
|
||||
|
||||
(defn is-child-of-ddl
|
||||
[]
|
||||
(str "CREATE REL TABLE `IsChildOf` ("
|
||||
"FROM `Page` TO `Document`, "
|
||||
"FROM `Component` TO `Document`, "
|
||||
(str/join ", "
|
||||
(concat
|
||||
(map (fn [shape]
|
||||
(str "FROM `" shape "` TO `Page`"))
|
||||
shape-tables)
|
||||
(for [shape shape-tables
|
||||
container container-tables]
|
||||
(str "FROM `" shape "` TO `" container "`"))))
|
||||
", `position` INT64);"))
|
||||
|
||||
(defn is-instance-of-ddl
|
||||
"Frame instance heads → Component."
|
||||
[]
|
||||
"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\"."
|
||||
[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, resolved
|
||||
from `shape-ref`."
|
||||
[]
|
||||
(shape-to-shape-rel-ddl "RefersTo" nil))
|
||||
|
||||
(defn fills-swap-slot-ddl
|
||||
"Swapped-in shape → the slot shape it replaces."
|
||||
[]
|
||||
(shape-to-shape-rel-ddl "FillsSwapSlot" ["`slot_id` UUID"]))
|
||||
|
||||
(defn ddl-statements
|
||||
[]
|
||||
(-> (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))))
|
||||
@@ -0,0 +1,85 @@
|
||||
;; 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.projection
|
||||
"Derive Ladybug node column schemas from Penpot Malli sources.
|
||||
|
||||
Start from the canonical schema and remove the keys that must not become
|
||||
graph columns."
|
||||
(:require
|
||||
[app.common.exceptions :as ex]
|
||||
[app.common.schema :as sm]
|
||||
[app.common.types.shape :as cts]
|
||||
[malli.core :as m]))
|
||||
|
||||
(def ^:private malli-opts sm/default-options)
|
||||
|
||||
(defn- coerce-schema
|
||||
"Normalize Malli sources to a compiled schema, unwrapping `:val` nodes."
|
||||
[schema]
|
||||
(loop [s (cond
|
||||
(sm/schema? schema) schema
|
||||
:else (sm/schema schema))]
|
||||
(if (= :malli.core/val (sm/type s))
|
||||
(recur (first (sm/children s)))
|
||||
s)))
|
||||
|
||||
(defn- unsupported-projection-schema!
|
||||
[schema]
|
||||
(ex/raise :type :internal
|
||||
:code :unsupported-projection-schema
|
||||
:hint (str "unsupported projection schema type: "
|
||||
(sm/type (coerce-schema schema)))))
|
||||
|
||||
(defn schema-map-entries
|
||||
"Map entries for `schema`, flattening `:merge` composites."
|
||||
[schema]
|
||||
(let [s (coerce-schema schema)]
|
||||
(or (seq (sm/entries s))
|
||||
(unsupported-projection-schema! schema))))
|
||||
|
||||
(defn- select-projected-keys
|
||||
"Project `schema` to a flat map schema, optionally dropping keys."
|
||||
[schema drop-keys]
|
||||
(let [s (coerce-schema schema)
|
||||
keys (if (seq drop-keys)
|
||||
(remove (set drop-keys) (sm/keys s))
|
||||
(sm/keys s))]
|
||||
(sm/select-keys s (vec keys))))
|
||||
|
||||
(defn shape-type-schema
|
||||
"Return the compiled Penpot Malli branch for shape type `penpot-type`.
|
||||
|
||||
`m/entries` on the shape `:multi` yields MapEntries whose values are
|
||||
compiled branch schemas (wrapped in `:val`). `m/children` returns raw
|
||||
entry forms and must not be used here."
|
||||
[penpot-type]
|
||||
(let [kw (keyword penpot-type)
|
||||
multi (sm/schema cts/schema:shape-attrs)]
|
||||
(or (some (fn [entry]
|
||||
(when (= kw (key entry))
|
||||
(val entry)))
|
||||
(m/entries multi malli-opts))
|
||||
(ex/raise :type :validation
|
||||
:code :unknown-shape-type
|
||||
:hint (str "unknown penpot shape type: " kw)))))
|
||||
|
||||
(defn project-schema
|
||||
"Build a graph node schema from canonical Malli `source`.
|
||||
|
||||
Options:
|
||||
- `:drop` - keys removed from the source
|
||||
- `:extra` - optional extra `[:map ...]` merged on top"
|
||||
[source {:keys [drop extra]}]
|
||||
(let [projected (select-projected-keys source drop)]
|
||||
(if extra
|
||||
(sm/merge projected (coerce-schema extra))
|
||||
projected)))
|
||||
|
||||
(defn project-shape-schema
|
||||
"Project `:drop` from the Penpot schema for `penpot-type`."
|
||||
[penpot-type opts]
|
||||
(project-schema (shape-type-schema penpot-type) opts))
|
||||
@@ -0,0 +1,174 @@
|
||||
;; 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.types
|
||||
"Map Malli schemas to Ladybug column types.
|
||||
|
||||
Ladybug is schema-first and strongly typed: every property key gets its type
|
||||
at table-creation time, and there is no widening later. That makes this
|
||||
mapping the whole of the graph's typing, and it is worth being tight — a
|
||||
column typed `DOUBLE[4]` is four numbers a consumer reads as a tensor row,
|
||||
where the same value as `JSON` is text somebody has to parse and trust. So
|
||||
JSON is the fallback of last resort, taken only where the Malli schema
|
||||
genuinely admits shapes no single column can hold.
|
||||
|
||||
Three groups, in the order the mapping tries them:
|
||||
|
||||
1. **Scalars** (`base-type->ladybug`) — the leaf Malli types.
|
||||
2. **Registered composites** (`custom-type->ladybug`) — Penpot's own value
|
||||
types whose *layout* is fixed even though Malli only sees a map or a
|
||||
string: a matrix is six doubles, a point two, a rect four, a hex colour
|
||||
one packed integer. These are named explicitly because the tight encoding
|
||||
is a modelling decision, not something derivable from the schema.
|
||||
3. **Structure** — collections become `T[]`, `:map-of` becomes `MAP(k, v)`,
|
||||
and a closed map of scalars becomes a `STRUCT`. Anything that could be
|
||||
more than one shape (a `:multi`, an `:or`, an optional-keyed map) becomes
|
||||
`JSON`, because a Ladybug column cannot be two types.
|
||||
|
||||
Every encoding here has a matching value formatter in `app.graph.ladybug`.
|
||||
The two must move together: a column type with no case there falls back to
|
||||
guessing the literal from the runtime value."
|
||||
(:require
|
||||
[app.common.logging :as l]
|
||||
[app.common.schema :as sm]
|
||||
[app.common.time :as ct]
|
||||
[clojure.string :as str]
|
||||
[malli.core :as m]))
|
||||
|
||||
(def ^:private malli-opts sm/default-options)
|
||||
|
||||
(def ^:private base-type->ladybug
|
||||
{::sm/uuid "UUID"
|
||||
::sm/safe-number "DOUBLE"
|
||||
::sm/safe-double "DOUBLE"
|
||||
::sm/safe-int "INT64"
|
||||
::sm/number "DOUBLE"
|
||||
::sm/boolean "BOOLEAN"
|
||||
::sm/int "INT64"
|
||||
::ct/inst "TIMESTAMP"
|
||||
:uuid "UUID"
|
||||
:string "STRING"
|
||||
:int "INT64"
|
||||
:double "DOUBLE"
|
||||
:float "DOUBLE"
|
||||
:boolean "BOOLEAN"
|
||||
:keyword "STRING"
|
||||
:inst "TIMESTAMP"})
|
||||
|
||||
(def ^:private custom-type->ladybug
|
||||
"Penpot value types with a fixed layout Malli does not express.
|
||||
|
||||
Fixed-size arrays are the point of each: they are dense, they need no
|
||||
parsing, and a consumer can read a whole column as a tensor.
|
||||
|
||||
- `::gmt/matrix` — the affine transform, `[a b c d e f]`.
|
||||
- `::gpt/point` — `[x y]`.
|
||||
- `::grc/rect` — `[x y width height]`. `x1`/`y1`/`x2`/`y2` are dropped: they
|
||||
are derivable from those four, and carrying them would double the column.
|
||||
- `::clr/hex-color` — `#RRGGBB` packed as `0xRRGGBBAA`, so colours compare
|
||||
and group without string handling."
|
||||
{:app.common.geom.matrix/matrix "DOUBLE[6]"
|
||||
:app.common.geom.point/point "DOUBLE[2]"
|
||||
:app.common.geom.rect/rect "DOUBLE[4]"
|
||||
:app.common.types.color/hex-color "UINT32"})
|
||||
|
||||
(def ^:private collection-types
|
||||
#{:vector :sequential :set ::sm/vec ::sm/set ::sm/coll})
|
||||
|
||||
(def ^:private string-collection-types
|
||||
"Registered collection schemas whose element type is not in `children`."
|
||||
{::sm/set-of-strings "STRING[]"
|
||||
::sm/set-of-keywords "STRING[]"
|
||||
::sm/set-of-uuid "UUID[]"
|
||||
::sm/vec-of-uuid "UUID[]"})
|
||||
|
||||
(defn- normalize-schema
|
||||
"Resolve refs, but stop at a schema this namespace maps explicitly.
|
||||
|
||||
Order matters: `::grc/rect` derefs to an `:and` over a map, and following
|
||||
that would lose the fixed-size-array encoding."
|
||||
[schema]
|
||||
(let [s (sm/schema schema)]
|
||||
(if (and (m/-ref-schema? s)
|
||||
(not (contains? custom-type->ladybug (m/type s)))
|
||||
(not (contains? string-collection-types (m/type s))))
|
||||
(recur (m/deref s malli-opts))
|
||||
s)))
|
||||
|
||||
(declare ladybug-type)
|
||||
|
||||
(defn- entry-child
|
||||
"The value schema of a Malli map entry (`[k s]` or `[k props s]`)."
|
||||
[entry]
|
||||
(if (> (count entry) 2) (nth entry 2) (nth entry 1)))
|
||||
|
||||
(defn- entry-optional?
|
||||
[entry]
|
||||
(and (> (count entry) 2)
|
||||
(:optional (nth entry 1))))
|
||||
|
||||
(defn- struct-type
|
||||
"`STRUCT(...)` for a closed map of scalars, or nil when JSON is the honest answer.
|
||||
|
||||
A struct is a fixed layout: every field present, every field a single type.
|
||||
An optional key would make the column's shape depend on the row, and a nested
|
||||
collection or map makes it recursive — Ladybug allows nesting, but a consumer
|
||||
reading such a column gains nothing over JSON, so the line is drawn at
|
||||
scalars."
|
||||
[s]
|
||||
(let [entries (m/entries s malli-opts)]
|
||||
(when (and (seq entries)
|
||||
(not-any? entry-optional? entries))
|
||||
(let [fields (for [entry entries
|
||||
:let [t (ladybug-type (entry-child entry))]]
|
||||
(when (and t
|
||||
(not= "JSON" t)
|
||||
(not (str/includes? t "(")))
|
||||
;; snake_case like a column name, and always
|
||||
;; backtick-quoted: a grid cell has a field called
|
||||
;; `column`, which is a Ladybug keyword, and an unquoted
|
||||
;; one fails to parse in the DDL *and* in every literal.
|
||||
;; The catalog reports them unquoted.
|
||||
(str "`" (str/replace (name (key entry)) "-" "_") "` " t)))]
|
||||
(when (every? some? fields)
|
||||
(str "STRUCT(" (str/join ", " fields) ")"))))))
|
||||
|
||||
(defn ladybug-type
|
||||
"Return the Ladybug column type for a Malli child schema."
|
||||
[schema]
|
||||
(let [s (normalize-schema schema)
|
||||
t (m/type s)]
|
||||
(or (base-type->ladybug t)
|
||||
(custom-type->ladybug t)
|
||||
(string-collection-types t)
|
||||
(when (contains? collection-types t)
|
||||
(when-let [child (first (m/children s malli-opts))]
|
||||
(str (ladybug-type child) "[]")))
|
||||
(case t
|
||||
(:maybe :and) (ladybug-type (first (m/children s malli-opts)))
|
||||
|
||||
;; `::sm/one-of` is how Penpot spells a closed set of keywords —
|
||||
;; `:blend-mode`, `:grow-type`, every `:layout-*`. One keyword, one
|
||||
;; string.
|
||||
(:enum ::sm/one-of) "STRING"
|
||||
|
||||
:map-of
|
||||
(let [[key-schema value-schema] (m/children s malli-opts)]
|
||||
(str "MAP(" (ladybug-type key-schema) ", "
|
||||
(ladybug-type value-schema) ")"))
|
||||
|
||||
:map (or (struct-type s) "JSON")
|
||||
|
||||
;; A schema we do not recognize. If it has no children it is a leaf —
|
||||
;; one of Penpot's registered keyword or enum schemas, say — and a
|
||||
;; string holds it exactly. If it has children it is a composite whose
|
||||
;; shape we cannot pin down, and JSON is the honest answer.
|
||||
(if (empty? (m/children s malli-opts))
|
||||
"STRING"
|
||||
(do
|
||||
(l/wrn :hint "unmapped composite malli type, defaulting to JSON"
|
||||
:malli-type t)
|
||||
"JSON"))))))
|
||||
@@ -0,0 +1,202 @@
|
||||
;; 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.values
|
||||
"Shape a Penpot value into the plain data its Ladybug column type wants.
|
||||
|
||||
Ladybug is strongly typed, and `app.graph.schema.types` maps Penpot's Malli
|
||||
schemas onto types as tight as it can — a matrix is `DOUBLE[6]`, a rect
|
||||
`DOUBLE[4]`, a colour `UINT32`, a closed map a `STRUCT`. A tight column is
|
||||
only worth having if the writer actually fills it in that shape, which is
|
||||
what this namespace does: it turns records and maps into the numbers, vectors
|
||||
and plain maps the type names.
|
||||
|
||||
It deliberately stops there. Serialization belongs to the writer — Cypher
|
||||
literals in `app.graph.ladybug`, Arrow vectors in `app.graph.arrow` — so that
|
||||
shaping a value and writing it are separate concerns and each has one home.
|
||||
|
||||
The type language is the Ladybug one, read recursively: `T[]`, `T[n]`,
|
||||
`MAP(k, v)`, `STRUCT(name t, …)`. Anything else is passed through."
|
||||
(:require
|
||||
[app.common.geom.matrix :as gmt]
|
||||
[app.common.geom.point :as gpt]
|
||||
[app.common.types.color :as clr]
|
||||
[clojure.string :as str]))
|
||||
|
||||
(defn- split-args
|
||||
"Split a comma-separated type argument list, respecting nesting.
|
||||
|
||||
`\"UUID, STRUCT(a INT64, b INT64)\"` → `[\"UUID\" \"STRUCT(a INT64, b INT64)\"]`."
|
||||
[s]
|
||||
(loop [chars (seq s) depth 0 current (StringBuilder.) out []]
|
||||
(if-let [c (first chars)]
|
||||
(cond
|
||||
(and (= c \,) (zero? depth))
|
||||
(recur (rest chars) depth (StringBuilder.) (conj out (str/trim (str current))))
|
||||
|
||||
(or (= c \() (= c \[))
|
||||
(recur (rest chars) (inc depth) (.append current c) out)
|
||||
|
||||
(or (= c \)) (= c \]))
|
||||
(recur (rest chars) (dec depth) (.append current c) out)
|
||||
|
||||
:else
|
||||
(recur (rest chars) depth (.append current c) out))
|
||||
(let [last-arg (str/trim (str current))]
|
||||
(cond-> out (seq last-arg) (conj last-arg))))))
|
||||
|
||||
(defn- parse-list
|
||||
"`[element-type]` when `t` is a list or fixed-size array type, else nil.
|
||||
|
||||
`DOUBLE[]` and `DOUBLE[4]` are both lists of doubles as far as shaping goes;
|
||||
the size only matters to the DDL."
|
||||
[t]
|
||||
(when-let [[_ element] (re-matches #"(.+?)\[\d*\]$" t)]
|
||||
[element]))
|
||||
|
||||
(defn- parse-map
|
||||
"`[key-type value-type]` when `t` is a MAP type, else nil."
|
||||
[t]
|
||||
(when-let [[_ args] (re-matches #"MAP\((.*)\)$" t)]
|
||||
(let [[k v] (split-args args)]
|
||||
(when (and k v) [k v]))))
|
||||
|
||||
(defn- parse-struct
|
||||
"`[[field-name field-type] …]` when `t` is a STRUCT type, else nil.
|
||||
|
||||
Field names arrive backtick-quoted (see `app.graph.schema.types`). The
|
||||
quoting is syntax, so it is stripped by default and re-applied by the writer —
|
||||
except for the Arrow writer, which needs it kept (`keep-quotes?`)."
|
||||
[t keep-quotes?]
|
||||
(when-let [[_ args] (re-matches #"STRUCT\((.*)\)$" t)]
|
||||
(for [arg (split-args args)
|
||||
:let [idx (str/index-of arg " ")]
|
||||
:when idx]
|
||||
[(cond-> (subs arg 0 idx) (not keep-quotes?) (str/replace "`" ""))
|
||||
(str/trim (subs arg (inc idx)))])))
|
||||
|
||||
(def ^:private struct-field-keys
|
||||
"Field name → the Penpot keys that may hold it.
|
||||
|
||||
A STRUCT field name is the snake_case of the Penpot key, but a value arrives
|
||||
with its original key, and some arrive from JSON with the string form. Both
|
||||
are tried before giving up."
|
||||
(memoize
|
||||
(fn [field]
|
||||
[(keyword (str/replace field "_" "-"))
|
||||
(keyword field)
|
||||
field
|
||||
(str/replace field "_" "-")])))
|
||||
|
||||
(defn- struct-field
|
||||
[value field]
|
||||
(some (fn [k] (when (contains? value k) (get value k)))
|
||||
(struct-field-keys field)))
|
||||
|
||||
(defn- fixed-vector
|
||||
"`v` as a plain vector of numbers, for a `DOUBLE[n]` column.
|
||||
|
||||
Records come first because they are what a realized snapshot holds; the map
|
||||
forms are what a JSON round-trip leaves behind."
|
||||
[v]
|
||||
(cond
|
||||
(gmt/matrix? v) [(:a v) (:b v) (:c v) (:d v) (:e v) (:f v)]
|
||||
(gpt/point? v) [(:x v) (:y v)]
|
||||
|
||||
;; A rect: four of the eight fields, the rest being derivable.
|
||||
(and (map? v) (contains? v :width) (contains? v :height))
|
||||
[(:x v) (:y v) (:width v) (:height v)]
|
||||
|
||||
(and (map? v) (contains? v :x) (contains? v :y))
|
||||
[(:x v) (:y v)]
|
||||
|
||||
(and (map? v) (contains? v :a) (contains? v :f))
|
||||
[(:a v) (:b v) (:c v) (:d v) (:e v) (:f v)]
|
||||
|
||||
(sequential? v) (vec v)
|
||||
:else nil))
|
||||
|
||||
(defn- packed-color
|
||||
"`#RRGGBB` as the packed integer `0xRRGGBBAA`.
|
||||
|
||||
Alpha defaults to opaque: the column holds a colour, and any opacity Penpot
|
||||
keeps alongside it is a separate attribute."
|
||||
[v]
|
||||
(cond
|
||||
(integer? v) v
|
||||
(and (string? v) (clr/valid-hex-color? v))
|
||||
(let [rgb (Long/parseLong (subs v 1) 16)]
|
||||
(bit-or (bit-shift-left rgb 8) 0xFF))
|
||||
:else nil))
|
||||
|
||||
(def struct-fields
|
||||
"`[[field-name field-type] …]` for a STRUCT type, memoized.
|
||||
|
||||
Public because the writers need the same field list to emit a literal."
|
||||
(memoize (fn [ladybug-type] (vec (parse-struct ladybug-type false)))))
|
||||
|
||||
(def struct-fields-quoted
|
||||
"`struct-fields` with the DDL's backticks intact.
|
||||
|
||||
Only the Arrow writer wants this: Ladybug names a staged struct's fields from
|
||||
the Arrow child names and quotes none of them, so a field whose name is a
|
||||
reserved word — a layout grid cell's `column` — has to arrive already quoted
|
||||
or `createArrowTable` fails outright."
|
||||
(memoize (fn [ladybug-type] (vec (parse-struct ladybug-type true)))))
|
||||
|
||||
(def map-types
|
||||
"`[key-type value-type]` for a MAP type, memoized."
|
||||
(memoize (fn [ladybug-type] (parse-map ladybug-type))))
|
||||
|
||||
(def list-element
|
||||
"Element type of a `T[]` / `T[n]` column, memoized; nil when not a list."
|
||||
(memoize (fn [ladybug-type] (first (parse-list ladybug-type)))))
|
||||
|
||||
(declare coerce)
|
||||
|
||||
(defn- coerce-struct
|
||||
[fields v]
|
||||
(when (map? v)
|
||||
(into {}
|
||||
(keep (fn [[field field-type]]
|
||||
(when-some [fv (struct-field v field)]
|
||||
[field (coerce field-type fv)])))
|
||||
fields)))
|
||||
|
||||
(defn coerce
|
||||
"`v` as the plain data a column of `ladybug-type` holds.
|
||||
|
||||
Returns `nil` when the value cannot be shaped that way, which callers treat
|
||||
as \"write NULL\" — a wrong shape in a strongly typed column fails the whole
|
||||
load, so declining is better than guessing."
|
||||
[ladybug-type v]
|
||||
(cond
|
||||
(nil? v) nil
|
||||
(not (string? ladybug-type)) v
|
||||
|
||||
(= "UINT32" ladybug-type) (packed-color v)
|
||||
|
||||
;; Fixed-size numeric arrays are records: matrix, point, rect.
|
||||
(re-matches #"DOUBLE\[\d+\]" ladybug-type) (fixed-vector v)
|
||||
|
||||
:else
|
||||
(if-let [[element] (parse-list ladybug-type)]
|
||||
(when (or (sequential? v) (set? v))
|
||||
;; A set has no order, so its column would otherwise vary between
|
||||
;; builds of the same file. Sorting makes it deterministic — which is
|
||||
;; what lets two builds be diffed at all, and what a stable golden
|
||||
;; needs. Sequential values keep their order: for `shapes` and
|
||||
;; `points`, the order *is* the content.
|
||||
(let [elements (mapv #(coerce element %) v)]
|
||||
(if (set? v) (vec (sort-by str elements)) elements)))
|
||||
(if-let [[key-type value-type] (parse-map ladybug-type)]
|
||||
(when (map? v)
|
||||
(into {}
|
||||
(map (fn [[k mv]] [(coerce key-type k) (coerce value-type mv)]))
|
||||
v))
|
||||
(if-let [fields (seq (parse-struct ladybug-type false))]
|
||||
(coerce-struct fields v)
|
||||
v)))))
|
||||
@@ -0,0 +1,48 @@
|
||||
;; 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.stats
|
||||
(:require
|
||||
[app.graph.ladybug :as ladybug]
|
||||
[app.graph.schema.nodes :as nodes]))
|
||||
|
||||
(defn- count-on-connection
|
||||
[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]
|
||||
{:nodes (into {}
|
||||
(map (fn [table]
|
||||
[table (count-on-connection
|
||||
conn
|
||||
(str "MATCH (n:" (nodes/match-label table) ") "
|
||||
"RETURN count(n) AS " table "_c;"))])
|
||||
(map :table nodes/node-types)))
|
||||
: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."
|
||||
[db-path]
|
||||
(ladybug/with-connection! db-path summarize-connection))
|
||||
@@ -0,0 +1,900 @@
|
||||
;; 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.sync
|
||||
"Incremental Ladybug graph updates from Penpot file-change events."
|
||||
(:require
|
||||
[app.common.logging :as l]
|
||||
[app.common.uuid :as uuid]
|
||||
[app.graph.ladybug :as ladybug]
|
||||
[app.graph.projection.document :as projection.document]
|
||||
[app.graph.schema.nodes :as nodes]
|
||||
[clojure.string :as str])
|
||||
(:import
|
||||
com.ladybugdb.Connection))
|
||||
|
||||
(set! *warn-on-reflection* true)
|
||||
|
||||
(def ^:private supported-change-types
|
||||
#{:add-obj :mod-obj :del-obj
|
||||
:add-page :del-page :mod-page :mov-objects
|
||||
:add-component :mod-component :del-component
|
||||
:restore-component :purge-component})
|
||||
|
||||
(defn- shape-table
|
||||
[shape]
|
||||
(nodes/table-for-type (:type shape)))
|
||||
|
||||
(defn- build-parent-map
|
||||
[edges]
|
||||
(into {}
|
||||
(map (fn [{:keys [from-id to-id to-table]}]
|
||||
[from-id {:parent-id to-id :parent-table to-table}]))
|
||||
edges))
|
||||
|
||||
(defn- build-children-map
|
||||
[edges]
|
||||
(reduce (fn [acc {:keys [from-id to-id]}]
|
||||
(update acc to-id (fnil conj #{}) from-id))
|
||||
{}
|
||||
edges))
|
||||
|
||||
(defn- resolve-page-id
|
||||
[shape-id parents pages]
|
||||
(loop [id shape-id]
|
||||
(cond
|
||||
(contains? pages id) id
|
||||
(get parents id) (recur (:parent-id (parents id)))
|
||||
:else nil)))
|
||||
|
||||
(defn- node-attrs-id
|
||||
[attrs]
|
||||
(cond
|
||||
(map? attrs) (or (:id attrs) (get attrs "id"))
|
||||
(and (vector? attrs) (= 2 (count attrs)))
|
||||
(let [[k v] attrs]
|
||||
(when (or (= k :id) (= k "id")) v))))
|
||||
|
||||
(defn- table-rows
|
||||
"Normalize a projection table value to a vector of attribute maps."
|
||||
[nodes table]
|
||||
(let [rows (or (get nodes table) (get nodes (keyword table)))]
|
||||
(cond
|
||||
(nil? rows) []
|
||||
(map? rows) [rows]
|
||||
(sequential? rows) (vec rows)
|
||||
:else [])))
|
||||
|
||||
(defn- document-id-from-nodes
|
||||
[nodes file-id]
|
||||
(or (some node-attrs-id (table-rows nodes "Document"))
|
||||
file-id))
|
||||
|
||||
(defn- page-index-entry
|
||||
[attrs]
|
||||
(let [id (node-attrs-id attrs)]
|
||||
[id {:id id
|
||||
:name (:name attrs)
|
||||
:index (long (:index attrs 0))}]))
|
||||
|
||||
(defn- index-pages
|
||||
[nodes]
|
||||
(into {} (map page-index-entry (table-rows nodes "Page"))))
|
||||
|
||||
(defn- component-index-entry
|
||||
[attrs]
|
||||
(let [id (node-attrs-id attrs)]
|
||||
[id {:id id
|
||||
:name (:name attrs)
|
||||
:deleted (boolean (:deleted attrs))}]))
|
||||
|
||||
(defn- index-components
|
||||
[nodes]
|
||||
(into {} (map component-index-entry (table-rows nodes "Component"))))
|
||||
|
||||
(defn- shape-index-table?
|
||||
[table]
|
||||
(not (contains? #{"Document" "Page" "Component"
|
||||
:Document :Page :Component}
|
||||
table)))
|
||||
|
||||
(defn- shape-index-entry
|
||||
[table attrs parents pages edges]
|
||||
(let [shape-id (node-attrs-id attrs)
|
||||
{:keys [parent-id parent-table]} (parents shape-id)
|
||||
edge (first (filter #(= shape-id (:from-id %)) edges))]
|
||||
[shape-id {:id shape-id
|
||||
:name (:name attrs)
|
||||
:table table
|
||||
: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
|
||||
;; `: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 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]
|
||||
(reduce
|
||||
(fn [acc [table _]]
|
||||
(into acc (map #(shape-index-entry table % parents pages edges)
|
||||
(table-rows nodes table))))
|
||||
{}
|
||||
(filter (fn [[table _]] (shape-index-table? table)) nodes)))
|
||||
|
||||
(defn build-index
|
||||
"Build a sync index from a full graph projection."
|
||||
[file-id revn {:keys [nodes edges]}]
|
||||
(let [doc-id (document-id-from-nodes nodes file-id)
|
||||
pages (index-pages nodes)
|
||||
components (index-components nodes)
|
||||
parents (build-parent-map edges)
|
||||
children-index (build-children-map edges)
|
||||
shapes (index-shapes nodes edges parents pages)]
|
||||
{:file-id file-id
|
||||
:doc-id doc-id
|
||||
:revn (long revn)
|
||||
:pages pages
|
||||
:components components
|
||||
:shapes shapes
|
||||
:children children-index}))
|
||||
|
||||
|
||||
(defn- format-node-value
|
||||
[table k v]
|
||||
(nodes/format-column-value table k v))
|
||||
|
||||
(defn- create-node-statement
|
||||
[table attrs]
|
||||
(let [label (nodes/match-label table)
|
||||
pairs (for [k (nodes/column-keys table)
|
||||
:let [v (get attrs k)]
|
||||
:when (some? v)]
|
||||
(str (nodes/cypher-property-key table k) ": "
|
||||
(format-node-value table k v)))]
|
||||
(str "CREATE (:" label " {" (str/join ", " pairs) "});")))
|
||||
|
||||
(defn- delete-node-statement
|
||||
[table shape-id]
|
||||
(str "MATCH (n:" (nodes/match-label table) " {id: " (ladybug/format-uuid shape-id) "}) "
|
||||
"DETACH DELETE n;"))
|
||||
|
||||
(defn- create-edge-statement
|
||||
[{:keys [from-table from-id to-table to-id position]}]
|
||||
(str "MATCH (s:" (nodes/match-label from-table) " {id: " (ladybug/format-uuid from-id) "}), "
|
||||
"(p:" (nodes/match-label to-table) " {id: " (ladybug/format-uuid to-id) "}) "
|
||||
"CREATE (s)-[:IsChildOf {position: " (ladybug/format-int position) "}]->(p);"))
|
||||
|
||||
(defn- create-instance-of-statement
|
||||
"Link a Frame instance head to its Component.
|
||||
|
||||
No-op when the Component is absent (e.g. library component not ingested)."
|
||||
[frame-id component-id]
|
||||
(str "MATCH (f:Frame {id: " (ladybug/format-uuid frame-id) "}), "
|
||||
"(c:Component {id: " (ladybug/format-uuid component-id) "}) "
|
||||
"WHERE NOT COALESCE(c.deleted, false) "
|
||||
"MERGE (f)-[:IsInstanceOf]->(c);"))
|
||||
|
||||
(defn- delete-instance-of-statement
|
||||
[frame-id]
|
||||
(str "MATCH (f:Frame {id: " (ladybug/format-uuid frame-id) "})"
|
||||
"-[r:IsInstanceOf]->(:Component) "
|
||||
"DELETE r;"))
|
||||
|
||||
(defn- instance-of-statements
|
||||
"Cypher to (re)link `IsInstanceOf` after add/mod of a Frame's component-id."
|
||||
[table shape-id component-id]
|
||||
(when (= table "Frame")
|
||||
(cond-> [(delete-instance-of-statement shape-id)]
|
||||
(some? component-id)
|
||||
(conj (create-instance-of-statement shape-id component-id)))))
|
||||
|
||||
(defn- delete-edge-statement
|
||||
[{:keys [from-table from-id to-table to-id]}]
|
||||
(str "MATCH (s:" (nodes/match-label from-table) " {id: " (ladybug/format-uuid from-id) "})"
|
||||
"-[r:IsChildOf]->"
|
||||
"(p:" (nodes/match-label to-table) " {id: " (ladybug/format-uuid to-id) "}) "
|
||||
"DELETE r;"))
|
||||
|
||||
(defn- set-edge-position-statement
|
||||
[{:keys [from-table from-id to-table to-id position]}]
|
||||
(str "MATCH (s:" (nodes/match-label from-table) " {id: " (ladybug/format-uuid from-id) "})"
|
||||
"-[r:IsChildOf]->"
|
||||
"(p:" (nodes/match-label to-table) " {id: " (ladybug/format-uuid to-id) "}) "
|
||||
"SET r.position = " (ladybug/format-int position) ";"))
|
||||
|
||||
(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 table attr) " = "
|
||||
(format-node-value table attr value) ";"))
|
||||
|
||||
(defn- set-page-name-statement
|
||||
[page-id name]
|
||||
(str "MATCH (p:Page {id: " (ladybug/format-uuid page-id) "}) "
|
||||
"SET p.name = " (ladybug/format-string name) ";"))
|
||||
|
||||
(defn- remove-node-attr-statement
|
||||
"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 table attr) " = NULL;"))
|
||||
|
||||
(defn- index-add-component!
|
||||
[index {:keys [id name doc-id]}]
|
||||
(-> index
|
||||
(assoc-in [:components id] {:id id :name name :deleted false})
|
||||
(update :children update doc-id (fnil conj #{}) id)))
|
||||
|
||||
(defn- index-remove-component!
|
||||
[index component-id]
|
||||
(let [doc-id (:doc-id index)]
|
||||
(-> index
|
||||
(update :components dissoc component-id)
|
||||
(update :children update doc-id #(disj (or % #{}) component-id)))))
|
||||
|
||||
|
||||
(defn- set-document-revision-statement
|
||||
"Set the Document's revision number.
|
||||
|
||||
`app.graph.schema.contract` names the column `revision`, not `revn`. The name
|
||||
is produced by `nodes/cypher-property-key`, so this statement and the DDL
|
||||
cannot disagree."
|
||||
[doc-id revn]
|
||||
(str "MATCH (d:Document {id: " (ladybug/format-uuid doc-id) "}) "
|
||||
"SET d." (nodes/cypher-property-key "Document" :revn) " = "
|
||||
(ladybug/format-int revn) ";"))
|
||||
|
||||
(defn- resolve-parent-for-add
|
||||
[index {:keys [parent-id frame-id page-id]}]
|
||||
(let [pid (or parent-id frame-id)]
|
||||
(if (or (nil? pid) (uuid/zero? pid))
|
||||
(when page-id
|
||||
{:parent-id page-id :parent-table "Page"})
|
||||
(if-let [shape (get-in index [:shapes pid])]
|
||||
{:parent-id pid :parent-table (:table shape)}
|
||||
(when (get-in index [:pages pid])
|
||||
{:parent-id pid :parent-table "Page"})))))
|
||||
|
||||
(defn- index-add-shape!
|
||||
[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
|
||||
:frame-id frame-id
|
||||
:component-ctx component-ctx
|
||||
:page-id page-id})
|
||||
(update :children update parent-id (fnil conj #{}) id)))
|
||||
|
||||
(defn- index-remove-shape!
|
||||
[index shape-id]
|
||||
(if-let [shape (get-in index [:shapes shape-id])]
|
||||
(-> index
|
||||
(update :shapes dissoc shape-id)
|
||||
(update :children update (:parent-id shape)
|
||||
#(disj (or % #{}) shape-id))
|
||||
(update :children dissoc shape-id))
|
||||
index))
|
||||
|
||||
(defn- index-add-page!
|
||||
[index {:keys [id name doc-id] page-index :index}]
|
||||
(-> index
|
||||
(assoc-in [:pages id] {:id id :name name :index page-index})
|
||||
(update :children update doc-id (fnil conj #{}) id)))
|
||||
|
||||
(defn- index-move-shape!
|
||||
[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.projection.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
|
||||
(nil? shapes) []
|
||||
(sequential? shapes) shapes
|
||||
(uuid? shapes) [shapes]
|
||||
(map? shapes) (if-let [id (or (:id shapes) (get shapes "id"))]
|
||||
[id]
|
||||
[])
|
||||
:else [])]
|
||||
(into []
|
||||
(keep (fn [shape]
|
||||
(when shape
|
||||
(if (uuid? shape) shape (:id shape)))))
|
||||
coll)))
|
||||
|
||||
(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}]
|
||||
(let [shape-ids (mov-object-ids shapes)
|
||||
parent (resolve-parent-for-add index
|
||||
(assoc change
|
||||
:frame-id (:parent-id change)
|
||||
:page-id page-id))]
|
||||
(cond
|
||||
(empty? shape-ids)
|
||||
{:index index :statements [] :applied? true}
|
||||
|
||||
(not parent)
|
||||
{:index index :statements [] :applied? false :reason :missing-parent}
|
||||
|
||||
:else
|
||||
(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}
|
||||
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 (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 (into statements
|
||||
(set-children-statements index (conj old-parents parent-id)))
|
||||
:applied? true}))))))
|
||||
|
||||
(defn- index-remove-page!
|
||||
[index page-id]
|
||||
(let [doc-id (:doc-id index)]
|
||||
(-> index
|
||||
(update :pages dissoc page-id)
|
||||
(update :children update doc-id #(disj (or % #{}) page-id))
|
||||
(update :children dissoc page-id))))
|
||||
|
||||
(defn- mod-attrs-for-table
|
||||
[table]
|
||||
(disj (set (nodes/column-keys table)) :id))
|
||||
|
||||
(defn- apply-add-obj
|
||||
[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 [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 "Page") parent-id)
|
||||
(get-in index [:shapes parent-id :page-id]))
|
||||
parent-ctx (get-in index [:shapes parent-id :component-ctx])
|
||||
shape (projection.document/denormalized-shape
|
||||
(assoc obj :id id) resolved-page-id parent-ctx)
|
||||
attrs (nodes/project-attrs table shape)
|
||||
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 (projection.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]}]
|
||||
(if-let [shape (get-in index [:shapes id])]
|
||||
(let [table (:table shape)
|
||||
syncable (mod-attrs-for-table table)
|
||||
set-ops (filter #(and (= :set (:type %))
|
||||
(contains? syncable (:attr %)))
|
||||
operations)]
|
||||
(if (empty? set-ops)
|
||||
{:index index :statements [] :applied? false :reason :unsupported-operations}
|
||||
(let [updates (into {} (map (juxt :attr :val) set-ops))
|
||||
statements
|
||||
(into (vec (for [[attr value] updates]
|
||||
(set-node-attr-statement table id attr value)))
|
||||
;; Relink when component-id is among the synced attrs.
|
||||
(when (contains? updates :component-id)
|
||||
(instance-of-statements table id (:component-id updates))))
|
||||
index' (reduce (fn [idx [attr value]]
|
||||
(assoc-in idx [:shapes id attr] value))
|
||||
index
|
||||
updates)]
|
||||
{:index index'
|
||||
:statements statements
|
||||
:applied? true})))
|
||||
{:index index :statements [] :applied? false :reason :missing-shape}))
|
||||
|
||||
(defn- delete-order-deepest-first
|
||||
[children root-id]
|
||||
(letfn [(post-order [id]
|
||||
(into (mapcat post-order (get children id #{}))
|
||||
[id]))]
|
||||
(post-order root-id)))
|
||||
|
||||
(defn- apply-del-obj
|
||||
[index {:keys [id]}]
|
||||
(if-let [root (get-in index [:shapes id])]
|
||||
(let [to-delete (delete-order-deepest-first (:children index) id)
|
||||
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).
|
||||
{:index index :statements [] :applied? true}))
|
||||
|
||||
(defn- apply-add-page
|
||||
[index {:keys [id name page]}]
|
||||
(let [page-id (or id (:id page))
|
||||
page (or page {:id page-id :name name})
|
||||
page (nodes/project-attrs "Page" {:id page-id
|
||||
:name (or (:name page) "Page")
|
||||
:index (count (:pages index))})
|
||||
doc-id (:doc-id index)
|
||||
position (count (:pages index))
|
||||
edge {:from-table "Page"
|
||||
:from-id page-id
|
||||
:to-table "Document"
|
||||
:to-id doc-id
|
||||
:position position}]
|
||||
{:index (index-add-page! index
|
||||
{:id page-id
|
||||
:name (:name page)
|
||||
:index (:index page)
|
||||
:doc-id doc-id})
|
||||
:statements [(create-node-statement "Page" page)
|
||||
(create-edge-statement edge)]
|
||||
:applied? true}))
|
||||
|
||||
(defn- apply-del-page
|
||||
[index {:keys [id]}]
|
||||
(if (get-in index [:pages id])
|
||||
(let [shape-ids (into #{}
|
||||
(comp (filter #(= id (get-in index [:shapes % :page-id])))
|
||||
(filter #(= "Page" (get-in index [:shapes % :parent-table]))))
|
||||
(keys (:shapes index)))
|
||||
del-shapes
|
||||
(reduce (fn [acc shape-id]
|
||||
(let [result (apply-del-obj acc {:type :del-obj :id shape-id})]
|
||||
(if (:applied? result)
|
||||
(-> acc
|
||||
(assoc :index (:index result))
|
||||
(update :statements into (:statements result)))
|
||||
acc)))
|
||||
{:index index :statements []}
|
||||
shape-ids)
|
||||
statements
|
||||
(conj (:statements del-shapes)
|
||||
(delete-edge-statement {:from-table "Page"
|
||||
:from-id id
|
||||
:to-table "Document"
|
||||
:to-id (:doc-id index)})
|
||||
(delete-node-statement "Page" id))]
|
||||
{:index (-> (:index del-shapes) (index-remove-page! id))
|
||||
:statements statements
|
||||
:applied? true})
|
||||
{:index index :statements [] :applied? false :reason :missing-page}))
|
||||
|
||||
(defn- apply-mod-page
|
||||
[index {:keys [id name]}]
|
||||
(if (and (string? name) (get-in index [:pages id]))
|
||||
{:index (assoc-in index [:pages id :name] name)
|
||||
:statements [(set-page-name-statement id name)]
|
||||
:applied? true}
|
||||
{:index index :statements [] :applied? false :reason :unsupported-page-change}))
|
||||
|
||||
(defn- component-syncable-attrs
|
||||
"Projected Component columns that sync may SET (everything but :id)."
|
||||
[]
|
||||
(disj (set (nodes/column-keys "Component")) :id))
|
||||
|
||||
(defn- component-attrs-from-change
|
||||
"Build CREATE attrs for `:add-component` (objects are not projected)."
|
||||
[{:keys [id name path main-instance-id main-instance-page
|
||||
annotation variant-id variant-properties]}]
|
||||
(cond-> {:id id
|
||||
:name (or name "Component")
|
||||
:path (or path "")
|
||||
:main-instance-id main-instance-id
|
||||
:main-instance-page main-instance-page}
|
||||
(some? annotation) (assoc :annotation annotation)
|
||||
(some? variant-id) (assoc :variant-id variant-id)
|
||||
(seq variant-properties) (assoc :variant-properties variant-properties)))
|
||||
|
||||
(defn- apply-add-component
|
||||
[index {:keys [id] :as change}]
|
||||
(if (get-in index [:components id])
|
||||
{:index index :statements [] :applied? true}
|
||||
(let [doc-id (:doc-id index)
|
||||
position (count (:components index))
|
||||
attrs (nodes/project-attrs "Component" (component-attrs-from-change change))
|
||||
edge {:from-table "Component"
|
||||
:from-id id
|
||||
:to-table "Document"
|
||||
:to-id doc-id
|
||||
:position position}]
|
||||
{:index (index-add-component! index
|
||||
{:id id
|
||||
:name (:name attrs)
|
||||
:doc-id doc-id})
|
||||
:statements [(create-node-statement "Component" attrs)
|
||||
(create-edge-statement edge)]
|
||||
:applied? true})))
|
||||
|
||||
(defn- apply-mod-component
|
||||
"Update projected Component attrs from a `:mod-component` change.
|
||||
|
||||
Nil optional values clear the property (Penpot dissocs them). `:objects`
|
||||
is never projected — shape trees live on pages."
|
||||
[index {:keys [id] :as change}]
|
||||
(let [syncable (component-syncable-attrs)
|
||||
sets (into {}
|
||||
(keep (fn [[k v]]
|
||||
(when (and (contains? syncable k) (some? v))
|
||||
[k v])))
|
||||
(dissoc change :type :id :objects))
|
||||
removes (into []
|
||||
(keep (fn [[k v]]
|
||||
(when (and (contains? syncable k) (nil? v))
|
||||
k)))
|
||||
(dissoc change :type :id :objects))
|
||||
stmts (into (mapv (fn [[k v]]
|
||||
(set-node-attr-statement "Component" id k v))
|
||||
sets)
|
||||
(map #(remove-node-attr-statement "Component" id %) removes))
|
||||
index' (if (get-in index [:components id])
|
||||
(cond-> index
|
||||
(contains? sets :name)
|
||||
(assoc-in [:components id :name] (:name sets)))
|
||||
(assoc-in index [:components id]
|
||||
{:id id
|
||||
:name (:name sets)
|
||||
:deleted false}))]
|
||||
(if (empty? stmts)
|
||||
{:index index :statements [] :applied? true}
|
||||
{:index index' :statements stmts :applied? true})))
|
||||
|
||||
(defn- apply-del-component
|
||||
[index {:keys [id skip-undelete?]}]
|
||||
(cond
|
||||
(not (get-in index [:components id]))
|
||||
{:index index :statements [] :applied? true}
|
||||
|
||||
skip-undelete?
|
||||
{:index (index-remove-component! index id)
|
||||
:statements [(delete-edge-statement {:from-table "Component"
|
||||
:from-id id
|
||||
:to-table "Document"
|
||||
:to-id (:doc-id index)})
|
||||
(delete-node-statement "Component" id)]
|
||||
:applied? true}
|
||||
|
||||
:else
|
||||
{:index (assoc-in index [:components id :deleted] true)
|
||||
:statements [(set-node-attr-statement "Component" id :deleted true)]
|
||||
:applied? true}))
|
||||
|
||||
(defn- apply-restore-component
|
||||
[index {:keys [id page-id]}]
|
||||
(let [stmts (cond-> [(set-node-attr-statement "Component" id :deleted false)]
|
||||
page-id
|
||||
(conj (set-node-attr-statement "Component" id :main-instance-page page-id)))
|
||||
index (if (get-in index [:components id])
|
||||
(-> index
|
||||
(assoc-in [:components id :deleted] false)
|
||||
(cond-> page-id
|
||||
(assoc-in [:components id :main-instance-page] page-id)))
|
||||
(assoc-in index [:components id]
|
||||
{:id id :name nil :deleted false}))]
|
||||
{:index index :statements stmts :applied? true}))
|
||||
|
||||
(defn- apply-purge-component
|
||||
[index {:keys [id]}]
|
||||
(if-not (get-in index [:components id])
|
||||
;; Still attempt delete in case the node exists but was not indexed.
|
||||
{:index index
|
||||
:statements [(delete-edge-statement {:from-table "Component"
|
||||
:from-id id
|
||||
:to-table "Document"
|
||||
:to-id (:doc-id index)})
|
||||
(delete-node-statement "Component" id)]
|
||||
:applied? true}
|
||||
{:index (index-remove-component! index id)
|
||||
:statements [(delete-edge-statement {:from-table "Component"
|
||||
:from-id id
|
||||
:to-table "Document"
|
||||
:to-id (:doc-id index)})
|
||||
(delete-node-statement "Component" id)]
|
||||
:applied? true}))
|
||||
|
||||
(defn- apply-change
|
||||
[index change]
|
||||
(case (:type change)
|
||||
:add-obj (apply-add-obj index change)
|
||||
:mod-obj (apply-mod-obj index change)
|
||||
:del-obj (apply-del-obj index change)
|
||||
:add-page (apply-add-page index change)
|
||||
:del-page (apply-del-page index change)
|
||||
:mod-page (apply-mod-page index change)
|
||||
:mov-objects (apply-mov-objects index change)
|
||||
:add-component (apply-add-component index change)
|
||||
:mod-component (apply-mod-component index change)
|
||||
:del-component (apply-del-component index change)
|
||||
:restore-component (apply-restore-component index change)
|
||||
:purge-component (apply-purge-component index change)
|
||||
{:index index :statements [] :applied? false :reason :unsupported-type}))
|
||||
|
||||
(defn apply-changes!
|
||||
"Apply Penpot `changes` to an open Ladybug `conn` and return the updated index.
|
||||
|
||||
Returns `{:index ... :revn ... :applied [...] :skipped [...]}`."
|
||||
[^Connection conn index changes revn]
|
||||
(when (> (long revn) (:revn index))
|
||||
(l/wrn :hint "graph sync revn gap"
|
||||
:file-id (str (:file-id index))
|
||||
:index-revn (:revn index)
|
||||
:change-revn revn))
|
||||
(loop [index index
|
||||
applied []
|
||||
skipped []
|
||||
stmts []
|
||||
changes (seq changes)]
|
||||
(if-let [change (first changes)]
|
||||
(let [{:keys [index statements applied? reason]}
|
||||
(apply-change index change)]
|
||||
(recur index
|
||||
(cond-> applied applied? (conj (:type change)))
|
||||
(cond-> skipped (not applied?) (conj {:type (:type change) :reason reason}))
|
||||
(cond-> stmts applied? (into statements))
|
||||
(rest changes)))
|
||||
(let [final-stmts (cond-> stmts
|
||||
(and (seq applied) (:doc-id index))
|
||||
(conj (set-document-revision-statement (:doc-id index) revn)))
|
||||
index' (if (seq applied)
|
||||
(assoc index :revn (long revn))
|
||||
index)]
|
||||
(when (seq final-stmts)
|
||||
(ladybug/exec-on-connection! conn final-stmts))
|
||||
{:index index'
|
||||
:revn (if (seq applied) (long revn) (:revn index'))
|
||||
:applied applied
|
||||
:skipped skipped}))))
|
||||
|
||||
(defn supported-change?
|
||||
[change]
|
||||
(contains? supported-change-types (:type change)))
|
||||
+296
-19
@@ -13,6 +13,7 @@
|
||||
[app.common.data :as d]
|
||||
[app.common.exceptions :as ex]
|
||||
[app.common.features :as cfeat]
|
||||
[app.common.json :as json]
|
||||
[app.common.logging :as l]
|
||||
[app.common.pprint :as pp]
|
||||
[app.common.time :as ct]
|
||||
@@ -21,6 +22,7 @@
|
||||
[app.config :as cf]
|
||||
[app.db :as db]
|
||||
[app.features.file-migrations :as feat.fmig]
|
||||
[app.http.access-token :as actoken]
|
||||
[app.http.session :as session]
|
||||
[app.rpc.commands.auth :as auth]
|
||||
[app.rpc.commands.files-create :refer [create-file]]
|
||||
@@ -33,6 +35,7 @@
|
||||
[app.storage.tmp :as tmp]
|
||||
[app.util.template :as tmpl]
|
||||
[cuerdas.core :as str]
|
||||
[datoteka.fs :as fs]
|
||||
[datoteka.io :as io]
|
||||
[emoji.core :as emj]
|
||||
[integrant.core :as ig]
|
||||
@@ -57,6 +60,7 @@
|
||||
::yres/body (-> (io/resource "app/templates/debug.tmpl")
|
||||
(tmpl/render {:version (:full cf/version)
|
||||
:profile profile
|
||||
:graph-enabled (contains? cf/flags :graph)
|
||||
:current-clock ct/*clock*
|
||||
:current-offset (if offset
|
||||
(ct/format-duration offset)
|
||||
@@ -330,6 +334,226 @@
|
||||
"content-disposition" (str "attachmen; filename=" (first file-ids) ".penpot")}}))))
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; GRAPH (flag: :graph)
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
;; `app.graph.*` resolves at call time, never at the top of this namespace.
|
||||
;; `app.graph.ladybug` imports `com.ladybugdb.*`, so requiring it links the
|
||||
;; Ladybug native library into the JVM, and this namespace loads on every
|
||||
;; 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
|
||||
"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 [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
|
||||
(when session? "-session") ".lbug")}})))
|
||||
|
||||
(defn- graph-console-response
|
||||
[data]
|
||||
{::yres/status 200
|
||||
::yres/headers {"content-type" "text/html; charset=utf-8"
|
||||
"x-robots-tag" "noindex"}
|
||||
::yres/body (-> (io/resource "app/templates/graph-console.tmpl")
|
||||
(tmpl/render (assoc data :version (:full cf/version))))})
|
||||
|
||||
(defn graph-console-handler
|
||||
[_cfg {:keys [::session/profile-id]}]
|
||||
(let [console-context (requiring-resolve 'app.graph.debug/console-context)]
|
||||
(graph-console-response (console-context profile-id))))
|
||||
|
||||
(defn graph-load-handler
|
||||
[cfg {:keys [params ::session/profile-id]}]
|
||||
(let [file-id (some-> (:file-id params) parse-uuid)
|
||||
load-session! (requiring-resolve 'app.graph.debug/load-session!)]
|
||||
(when-not file-id
|
||||
(ex/raise :type :validation
|
||||
:code :missing-arguments
|
||||
:hint "missing file-id"))
|
||||
(load-session! cfg profile-id file-id)
|
||||
{::yres/status 302
|
||||
::yres/headers {"location" "/dbg/graph"}}))
|
||||
|
||||
(defn graph-unload-handler
|
||||
[_cfg {:keys [::session/profile-id]}]
|
||||
((requiring-resolve 'app.graph.debug/unload-session!) profile-id)
|
||||
{::yres/status 302
|
||||
::yres/headers {"location" "/dbg/graph"}})
|
||||
|
||||
(defn graph-reload-handler
|
||||
"Re-ingest the currently loaded file into the in-memory graph session."
|
||||
[cfg {:keys [::session/profile-id]}]
|
||||
(let [session-info (requiring-resolve 'app.graph.debug/session-info)
|
||||
load-session! (requiring-resolve 'app.graph.debug/load-session!)]
|
||||
(if-let [file-id (some-> (session-info profile-id) :file-id)]
|
||||
(do
|
||||
(load-session! cfg profile-id file-id)
|
||||
{::yres/status 302
|
||||
::yres/headers {"location" "/dbg/graph"}})
|
||||
(ex/raise :type :not-found
|
||||
:code :graph-session-not-loaded
|
||||
:hint "load a file graph before reloading"))))
|
||||
|
||||
(defn graph-sync-status-handler
|
||||
[_cfg {:keys [::session/profile-id]}]
|
||||
(if-let [status ((requiring-resolve 'app.graph.debug/sync-status) profile-id)]
|
||||
{::yres/status 200
|
||||
::yres/headers {"content-type" "application/json; charset=utf-8"}
|
||||
::yres/body (t/encode-str status {:type :json-verbose})}
|
||||
{::yres/status 404
|
||||
::yres/headers {"content-type" "application/json; charset=utf-8"}
|
||||
::yres/body (t/encode-str {:error "no-session"} {:type :json-verbose})}))
|
||||
|
||||
(defn graph-data-handler
|
||||
"Export the in-memory session graph as plain JSON (not transit) for the
|
||||
G6 graph view embedded in the console page."
|
||||
[_cfg {:keys [::session/profile-id]}]
|
||||
(if-let [data ((requiring-resolve 'app.graph.debug/export-graph-data!) profile-id)]
|
||||
{::yres/status 200
|
||||
::yres/headers {"content-type" "application/json; charset=utf-8"}
|
||||
::yres/body (json/encode data)}
|
||||
{::yres/status 404
|
||||
::yres/headers {"content-type" "application/json; charset=utf-8"}
|
||||
::yres/body (json/encode {:error "no-session"})}))
|
||||
|
||||
(def ^:private sql:graph-files
|
||||
"select t.id as team_id, t.name as team_name,
|
||||
p.id as project_id, p.name as project_name,
|
||||
f.id as file_id, f.name as file_name
|
||||
from team as t
|
||||
join team_profile_rel as tpr on (tpr.team_id = t.id)
|
||||
join project as p on (p.team_id = t.id)
|
||||
join file as f on (f.project_id = p.id)
|
||||
where tpr.profile_id = ?
|
||||
and t.deleted_at is null
|
||||
and p.deleted_at is null
|
||||
and f.deleted_at is null
|
||||
order by t.name, p.name, f.name
|
||||
limit 500")
|
||||
|
||||
(defn- graph-files-tree
|
||||
[rows]
|
||||
(->> (group-by (juxt :team-id :team-name) rows)
|
||||
(mapv (fn [[[team-id team-name] team-rows]]
|
||||
{:id (str team-id)
|
||||
:name team-name
|
||||
:projects
|
||||
(->> (group-by (juxt :project-id :project-name) team-rows)
|
||||
(mapv (fn [[[project-id project-name] project-rows]]
|
||||
{:id (str project-id)
|
||||
:name project-name
|
||||
:files (mapv (fn [{:keys [file-id file-name]}]
|
||||
{:id (str file-id) :name file-name})
|
||||
project-rows)}))
|
||||
(sort-by :name)
|
||||
(vec))}))
|
||||
(sort-by :name)
|
||||
(vec)))
|
||||
|
||||
(defn graph-files-handler
|
||||
"List teams -> projects -> files reachable by the current profile, as
|
||||
plain JSON for the graph console file tree."
|
||||
[{:keys [::db/pool]} {:keys [::session/profile-id]}]
|
||||
(let [rows (db/exec! pool [sql:graph-files profile-id])]
|
||||
{::yres/status 200
|
||||
::yres/headers {"content-type" "application/json; charset=utf-8"}
|
||||
::yres/body (json/encode {:teams (graph-files-tree rows)})}))
|
||||
|
||||
(defn- json-request?
|
||||
[request]
|
||||
(some-> request
|
||||
(yreq/get-header "accept")
|
||||
(str/includes? "application/json")))
|
||||
|
||||
(defn graph-query-handler
|
||||
[_cfg {:keys [params ::session/profile-id] :as request}]
|
||||
(let [query (:query params)
|
||||
query-session! (requiring-resolve 'app.graph.debug/query-session!)
|
||||
console-context (requiring-resolve 'app.graph.debug/console-context)]
|
||||
(try
|
||||
(let [result (query-session! profile-id query)]
|
||||
(if (json-request? request)
|
||||
{::yres/status 200
|
||||
::yres/headers {"content-type" "application/json; charset=utf-8"}
|
||||
::yres/body (t/encode-str {:query query
|
||||
:query-result result}
|
||||
{:type :json-verbose})}
|
||||
(graph-console-response (console-context profile-id
|
||||
:query query
|
||||
:query-result result))))
|
||||
(catch Throwable e
|
||||
(let [error (or (:hint (ex-data e)) (ex-message e))]
|
||||
(if (json-request? request)
|
||||
{::yres/status 200
|
||||
::yres/headers {"content-type" "application/json; charset=utf-8"}
|
||||
::yres/body (t/encode-str {:query query :error error}
|
||||
{:type :json-verbose})}
|
||||
(graph-console-response (console-context profile-id
|
||||
:query query
|
||||
:error error))))))))
|
||||
|
||||
(defn import-handler
|
||||
[{:keys [::db/pool] :as cfg} {:keys [params ::session/profile-id] :as request}]
|
||||
(when-not (contains? params :file)
|
||||
@@ -518,6 +742,27 @@
|
||||
;; INIT
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(def normalize-identity
|
||||
"Let a personal access token stand in for a browser session on `/dbg`.
|
||||
|
||||
The identity may arrive either way, and both are the same profile acting for
|
||||
itself. The gate below, devenv or an address in `:admins`, does not change
|
||||
with the carrier. What a token adds is scripted access, so a tool already
|
||||
holding a profile's credentials can also pull the graph a build produced.
|
||||
|
||||
Normalizing here rather than in each handler keeps `::session/profile-id`
|
||||
the one key every debug handler reads, so a console session keyed by profile
|
||||
(`app.graph.debug`) is found whichever way the caller authenticated."
|
||||
{:name ::normalize-identity
|
||||
:compile
|
||||
(fn [& _]
|
||||
(fn [handler]
|
||||
(fn [request]
|
||||
(handler (cond-> request
|
||||
(and (nil? (::session/profile-id request))
|
||||
(some? (::actoken/profile-id request)))
|
||||
(assoc ::session/profile-id (::actoken/profile-id request)))))))})
|
||||
|
||||
(defn authorized?
|
||||
[pool {:keys [::session/profile-id]}]
|
||||
(or (and (= "devenv" (cf/get :host)) profile-id)
|
||||
@@ -539,7 +784,12 @@
|
||||
(letfn [(handle-error [cause]
|
||||
(when-let [data (ex-data cause)]
|
||||
(when (= :validation (:type data))
|
||||
(str "Error: " (or (:hint data) (ex-message cause)) "\n"))))]
|
||||
(let [hint (or (:hint data) (ex-message cause))
|
||||
explain (ex/explain data)]
|
||||
(str "Error: " hint
|
||||
(when (and explain (not (str/includes? hint explain)))
|
||||
(str "\n" explain))
|
||||
"\n")))))]
|
||||
{:name ::errors
|
||||
:compile
|
||||
(fn [& _params]
|
||||
@@ -559,24 +809,51 @@
|
||||
(assert (db/pool? (::db/pool params)) "expected a valid database pool")
|
||||
(assert (session/manager? (::session/manager params)) "expected a valid session manager"))
|
||||
|
||||
(defn- graph-action-routes
|
||||
[cfg]
|
||||
[["/graph-export" {:handler (partial graph-export-handler cfg)}]
|
||||
["/graph-load" {:handler (partial graph-load-handler cfg)}]
|
||||
["/graph-query" {:handler (partial graph-query-handler cfg)}]
|
||||
["/graph-unload" {:handler (partial graph-unload-handler cfg)}]
|
||||
["/graph-reload" {:handler (partial graph-reload-handler cfg)}]
|
||||
["/graph-sync-status" {:handler (partial graph-sync-status-handler cfg)}]
|
||||
["/graph-data" {:handler (partial graph-data-handler cfg)}]
|
||||
["/graph-files" {:handler (partial graph-files-handler cfg)}]])
|
||||
|
||||
(defmethod ig/init-key ::routes
|
||||
[_ {:keys [::db/pool] :as cfg}]
|
||||
[["/readyz" {:handler (partial health-handler cfg)}]
|
||||
["/dbg" {:middleware [[session/authz cfg]
|
||||
[with-authorization pool]]}
|
||||
["" {:handler (partial index-handler cfg)}]
|
||||
["/health" {:handler (partial health-handler cfg)}]
|
||||
["/changelog" {:handler (partial changelog-handler cfg)}]
|
||||
["/error/:id" {:handler (partial error-handler cfg)}]
|
||||
["/error" {:handler (partial error-list-handler cfg)}]
|
||||
["/actions" {:middleware [[errors]]}
|
||||
["/set-virtual-clock"
|
||||
{:handler (partial set-virtual-clock cfg)}]
|
||||
["/resend-email-verification"
|
||||
{:handler (partial resend-email-notification cfg)}]
|
||||
["/handle-team-features"
|
||||
{:handler (partial handle-team-features cfg)}]
|
||||
["/file-export" {:handler (partial export-handler cfg)}]
|
||||
["/file-import" {:handler (partial import-handler cfg)}]
|
||||
["/file-raw-export-import" {:handler (partial raw-export-import-handler cfg)}]]]])
|
||||
;; The graph routes are registered only under the `:graph` flag. Left
|
||||
;; unregistered they 404, and nothing ever resolves `app.graph.*`. The `/dbg`
|
||||
;; admin gate is unchanged: it covers the graph routes exactly as before.
|
||||
(let [graph? (contains? cf/flags :graph)
|
||||
actions (cond-> ["/actions" {:middleware [[errors]]}
|
||||
["/set-virtual-clock"
|
||||
{:handler (partial set-virtual-clock cfg)}]
|
||||
["/resend-email-verification"
|
||||
{:handler (partial resend-email-notification cfg)}]
|
||||
["/handle-team-features"
|
||||
{:handler (partial handle-team-features cfg)}]
|
||||
["/file-export" {:handler (partial export-handler cfg)}]
|
||||
["/file-import" {:handler (partial import-handler cfg)}]
|
||||
["/file-raw-export-import" {:handler (partial raw-export-import-handler cfg)}]]
|
||||
graph? (into (graph-action-routes cfg)))
|
||||
dbg (cond-> ["/dbg" {:middleware [[session/authz cfg]
|
||||
[actoken/authz cfg]
|
||||
[normalize-identity]
|
||||
[with-authorization pool]]}
|
||||
["" {:handler (partial index-handler cfg)}]
|
||||
["/health" {:handler (partial health-handler cfg)}]
|
||||
["/changelog" {:handler (partial changelog-handler cfg)}]
|
||||
["/error/:id" {:handler (partial error-handler cfg)}]
|
||||
["/error" {:handler (partial error-list-handler cfg)}]
|
||||
actions]
|
||||
graph? (conj ["/graph" {:handler (partial graph-console-handler cfg)}]))]
|
||||
(when graph?
|
||||
;; With the flag on, the Ladybug native library belongs to this process,
|
||||
;; so load it here. A missing or unusable library then fails the boot
|
||||
;; instead of the first console request.
|
||||
(require 'app.graph.debug 'app.graph.ingest))
|
||||
|
||||
[["/readyz" {:handler (partial health-handler cfg)}]
|
||||
dbg]))
|
||||
|
||||
@@ -284,6 +284,7 @@
|
||||
::http.debug/routes
|
||||
{::db/pool (ig/ref ::db/pool)
|
||||
::session/manager (ig/ref ::session/manager)
|
||||
::mbus/msgbus (ig/ref ::mbus/msgbus)
|
||||
::sto/storage (ig/ref ::sto/storage)
|
||||
::setup/props (ig/ref ::setup/props)}
|
||||
|
||||
|
||||
@@ -398,6 +398,52 @@
|
||||
(println (sm/humanize-explain explain))
|
||||
(ex/print-throwable cause))))))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; GRAPH / LADYBUG
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
;; The graph namespaces resolve at call time, never at the top of this
|
||||
;; namespace. `app.graph.ladybug` imports `com.ladybugdb.*`, and this namespace
|
||||
;; loads with the REPL server on every boot, so a top-level require would link
|
||||
;; the Ladybug native library into every backend, graph or not. Calling one of
|
||||
;; the functions below loads the library at that point: the operator has asked
|
||||
;; for it explicitly. The `:graph` flag gates the request path
|
||||
;; (`app.http.debug`), not the REPL.
|
||||
|
||||
(defn graph-smoke-test!
|
||||
"Execute a basic Ladybug smoke test (CREATE + count).
|
||||
|
||||
Uses the embedded Ladybug Java API. Use :db-path \":memory:\" (default)
|
||||
or a filesystem path such as /tmp/test.lbug."
|
||||
[& {:keys [db-path] :or {db-path ":memory:"}}]
|
||||
((requiring-resolve 'app.graph.ladybug/smoke-test!) :db-path db-path))
|
||||
|
||||
(defn graph-query-test!
|
||||
"Query Document count for a file's graph db (REPL diagnostic)."
|
||||
[file-id & {:keys [db-path]}]
|
||||
(let [file-id (h/parse-uuid file-id)
|
||||
db-path (or db-path ((requiring-resolve 'app.graph.ladybug/db-path-for-file) file-id))
|
||||
query-scalar! (requiring-resolve 'app.graph.ladybug/query-scalar!)
|
||||
stmt "MATCH (n:Document) RETURN count(n) AS Document_c;"]
|
||||
(query-scalar! db-path stmt)))
|
||||
|
||||
(defn ingest-file-to-graph!
|
||||
"Project a Penpot file into a per-file Ladybug database.
|
||||
|
||||
Loads and realizes the file from the database, ensures the slice schema,
|
||||
projects Document/Page/shape nodes, and returns graph stats.
|
||||
|
||||
Options:
|
||||
- `:db-path` path or `:memory:`
|
||||
- `:reset-db?` delete any existing db first (default true)
|
||||
- `:skip-stats?` skip post-ingest MATCH count queries (default false)"
|
||||
[file-id & opts]
|
||||
(let [ingest-file! (requiring-resolve 'app.graph.ingest/ingest-file!)
|
||||
print-ingest! (requiring-resolve 'app.graph.report/print-ingest!)
|
||||
result (apply ingest-file! sys/system file-id opts)]
|
||||
(print-ingest! result)
|
||||
result))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; PROCESSING
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
@@ -0,0 +1,165 @@
|
||||
;; 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-binder-gate-test
|
||||
"Binder gate for the incremental-sync statement templates.
|
||||
|
||||
Every template `app.graph.sync` emits is *prepared* — parsed and bound by
|
||||
the engine against the live DDL — and never executed. A parse or bind
|
||||
failure (a renamed column, a reserved-word label emitted unquoted, a dropped
|
||||
table) turns the gate red here, before the statement can reach a live
|
||||
session.
|
||||
|
||||
One instance per template is the gate; per-column type coverage belongs to
|
||||
beadpot's schema diff, not here. The templates are `defn-`, so they are
|
||||
reached through their vars."
|
||||
(:require
|
||||
[app.graph.ladybug :as ladybug]
|
||||
[app.graph.schema.nodes :as nodes]
|
||||
[app.graph.sync]
|
||||
[clojure.test :as t]))
|
||||
|
||||
(def ^:private create-node-statement #'app.graph.sync/create-node-statement)
|
||||
(def ^:private delete-node-statement #'app.graph.sync/delete-node-statement)
|
||||
(def ^:private create-edge-statement #'app.graph.sync/create-edge-statement)
|
||||
(def ^:private delete-edge-statement #'app.graph.sync/delete-edge-statement)
|
||||
(def ^:private set-edge-position-statement #'app.graph.sync/set-edge-position-statement)
|
||||
(def ^:private create-instance-of-statement #'app.graph.sync/create-instance-of-statement)
|
||||
(def ^:private delete-instance-of-statement #'app.graph.sync/delete-instance-of-statement)
|
||||
(def ^:private set-node-attr-statement #'app.graph.sync/set-node-attr-statement)
|
||||
(def ^:private set-page-name-statement #'app.graph.sync/set-page-name-statement)
|
||||
(def ^:private remove-node-attr-statement #'app.graph.sync/remove-node-attr-statement)
|
||||
(def ^:private set-document-revision-statement #'app.graph.sync/set-document-revision-statement)
|
||||
|
||||
;; Dummy identities. Fixed rather than generated: a gate failure should read
|
||||
;; the same on every run.
|
||||
(def ^:private doc-id #uuid "00000000-0000-0000-0000-0000000000d0")
|
||||
(def ^:private page-id #uuid "00000000-0000-0000-0000-0000000000a0")
|
||||
(def ^:private shape-id #uuid "00000000-0000-0000-0000-0000000000b0")
|
||||
(def ^:private frame-id #uuid "00000000-0000-0000-0000-0000000000c0")
|
||||
(def ^:private component-id #uuid "00000000-0000-0000-0000-0000000000e0")
|
||||
|
||||
(def ^:private child-edge
|
||||
{:from-table "Rectangle" :from-id shape-id
|
||||
:to-table "Page" :to-id page-id
|
||||
:position 3})
|
||||
|
||||
(def ^:private ^:dynamic *conn* nil)
|
||||
|
||||
(defn- with-graph-connection
|
||||
"Open a `:memory:` database, create the live schema, run the tests on it.
|
||||
|
||||
Nothing is executed against it — the gate only prepares — but the DDL has to
|
||||
be there for the binder to resolve tables and columns against."
|
||||
[next]
|
||||
(ladybug/with-connection! ":memory:"
|
||||
(fn [conn]
|
||||
(ladybug/exec-on-connection! conn (nodes/ddl-statements))
|
||||
(binding [*conn* conn]
|
||||
(next)))))
|
||||
|
||||
(t/use-fixtures :once with-graph-connection)
|
||||
|
||||
(defn- gate
|
||||
"Assert `statement` binds, and that the engine agrees on read/write."
|
||||
[label statement read-only?]
|
||||
(let [result (ladybug/validate-on-connection! *conn* statement)]
|
||||
(t/is (:ok? result)
|
||||
(str label " does not bind: " (:error result) "\n " statement))
|
||||
(when (:ok? result)
|
||||
(t/is (= read-only? (:read-only? result))
|
||||
(str label " read-only? " (:read-only? result) ", expected " read-only?)))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; the eleven sync templates
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(t/deftest create-node-binds
|
||||
(gate "create-node-statement"
|
||||
(create-node-statement "Rectangle" {:id shape-id
|
||||
:name "a shape"
|
||||
:opacity 1.0
|
||||
:hidden false})
|
||||
false))
|
||||
|
||||
(t/deftest delete-node-binds
|
||||
(gate "delete-node-statement"
|
||||
(delete-node-statement "Rectangle" shape-id)
|
||||
false))
|
||||
|
||||
(t/deftest create-edge-binds
|
||||
(gate "create-edge-statement"
|
||||
(create-edge-statement child-edge)
|
||||
false))
|
||||
|
||||
(t/deftest delete-edge-binds
|
||||
(gate "delete-edge-statement"
|
||||
(delete-edge-statement (dissoc child-edge :position))
|
||||
false))
|
||||
|
||||
(t/deftest set-edge-position-binds
|
||||
(gate "set-edge-position-statement"
|
||||
(set-edge-position-statement child-edge)
|
||||
false))
|
||||
|
||||
(t/deftest create-instance-of-binds
|
||||
(gate "create-instance-of-statement"
|
||||
(create-instance-of-statement frame-id component-id)
|
||||
false))
|
||||
|
||||
(t/deftest delete-instance-of-binds
|
||||
(gate "delete-instance-of-statement"
|
||||
(delete-instance-of-statement frame-id)
|
||||
false))
|
||||
|
||||
(t/deftest set-node-attr-binds
|
||||
(gate "set-node-attr-statement"
|
||||
(set-node-attr-statement "Rectangle" shape-id :name "a shape")
|
||||
false))
|
||||
|
||||
(t/deftest set-page-name-binds
|
||||
(gate "set-page-name-statement"
|
||||
(set-page-name-statement page-id "a page")
|
||||
false))
|
||||
|
||||
(t/deftest remove-node-attr-binds
|
||||
(gate "remove-node-attr-statement"
|
||||
(remove-node-attr-statement "Rectangle" shape-id :name)
|
||||
false))
|
||||
|
||||
(t/deftest set-document-revision-binds
|
||||
(gate "set-document-revision-statement"
|
||||
(set-document-revision-statement doc-id 42)
|
||||
false))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; label quoting across the registry
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(t/deftest every-node-label-binds
|
||||
;; `Group` and `Boolean` are reserved words: unquoted they do not parse.
|
||||
;; One MATCH per registered table is the cheapest way to keep `match-label`
|
||||
;; honest as tables come and go.
|
||||
(doseq [table (map :table nodes/node-types)]
|
||||
(gate (str "delete-node-statement on " table)
|
||||
(delete-node-statement table shape-id)
|
||||
false)))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; the gate itself
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(t/deftest read-only-discriminates
|
||||
;; Without this the `read-only? false` assertions above would hold for a
|
||||
;; `validate-on-connection!` that always answered false.
|
||||
(gate "a read query" "MATCH (n:Rectangle) RETURN count(n);" true))
|
||||
|
||||
(t/deftest bad-statement-is-reported-not-thrown
|
||||
(let [result (ladybug/validate-on-connection!
|
||||
*conn* "MATCH (n:Rectangle) SET n.no_such_column = 1;")]
|
||||
(t/is (false? (:ok? result)))
|
||||
(t/is (string? (:error result)))
|
||||
(t/is (nil? (:read-only? result)))))
|
||||
@@ -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.projection.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.projection.document :as projection.document]
|
||||
[app.graph.projection.transforms :as projection.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 (projection.document/projection-data data file)]
|
||||
(ladybug/exec-on-connection! conn (nodes/ddl-statements))
|
||||
(arrow/with-allocator!
|
||||
(fn [allocator] (arrow/load-projection! conn projection allocator)))
|
||||
(projection.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")))
|
||||
@@ -100,6 +100,10 @@
|
||||
:backend-svgo
|
||||
;; If enabled, it makes the Google Fonts available.
|
||||
:google-fonts-provider
|
||||
;; Enables the Ladybug graph subsystem: the `/dbg` graph console and its
|
||||
;; actions. Off by default. With the flag off, `app.graph.*` never loads,
|
||||
;; so the Ladybug native library never enters the JVM.
|
||||
:graph
|
||||
;; Only for development.
|
||||
:nrepl-server
|
||||
;; Interactive repl. Only for development.
|
||||
|
||||
Reference in new issue
Block a user