diff --git a/backend/deps.edn b/backend/deps.edn index c60adf10ca..9bdf318dd7 100644 --- a/backend/deps.edn +++ b/backend/deps.edn @@ -64,7 +64,9 @@ ;; Pretty Print specs pretty-spec/pretty-spec {:mvn/version "0.1.4"} software.amazon.awssdk/s3 {:mvn/version "2.46.18"} - software.amazon.awssdk/sts {:mvn/version "2.46.18"}} + software.amazon.awssdk/sts {:mvn/version "2.46.18"} + + com.ladybugdb/lbug {:mvn/version "0.18.0"}} :paths ["src" "resources" "target/classes"] :aliases diff --git a/backend/resources/app/templates/debug.tmpl b/backend/resources/app/templates/debug.tmpl index 42894b570c..32e0732411 100644 --- a/backend/resources/app/templates/debug.tmpl +++ b/backend/resources/app/templates/debug.tmpl @@ -222,6 +222,21 @@ Debug Main Page +
+ Export graph (Ladybug): + Given a FILE-ID, builds the graph projection and downloads + the `.lbug` database file. + +
+
+ +
+
+ + Open graph console +
+
+
Import binfile: Import penpot file in binary format. diff --git a/backend/resources/app/templates/graph-console.tmpl b/backend/resources/app/templates/graph-console.tmpl new file mode 100644 index 0000000000..52c4d1b5c8 --- /dev/null +++ b/backend/resources/app/templates/graph-console.tmpl @@ -0,0 +1,390 @@ +{% extends "app/templates/base.tmpl" %} + +{% block title %} +Graph Console +{% endblock %} + +{% block content %} + +
+
+

← Back to debug

+ +
+ Load graph in memory + + Projects the Penpot file into an in-memory Ladybug database for this + admin session. Loading a new file replaces the previous one. + +
+
+ +
+
+ +
+
+ {% if session %} +
+
+ +
+
+ {% endif %} +
+ + {% if session %} +
+ Loaded session + +

+ File: {{session.name}} ({{session.file-id}})
+ Loaded at revision: {{session.revn}}
+ Graph revision: {% if session.graph-revn %}{{session.graph-revn}}{% else %}{{session.revn}}{% endif %}
+ Schema: {{session.schema-version}}
+ Loaded at: {{session.loaded-at}} +

+

+ Feed: connecting… + +

+
+ +
+ {% if session.projection.stats %} +

+ Projection: + documents={{session.projection.stats.documents}}, + pages={{session.projection.stats.pages}}, + shapes={{session.projection.stats.shapes}} +

+ {% endif %} + +
+ +
+ File changes (live) + + Subscribes to the workspace WebSocket feed for visibility. The backend + applies supported changes incrementally to the in-memory Ladybug graph + via msgbus (:file-change). + +
Waiting for changes…
+ + + + + + + + + +
+ +
+ Cypher query +
+
+ +
+
+ +
+
+
+ +
+ {% if error %} +
+ Error + 
{{error}}
+
+ {% endif %} + + {% if query-result %} +
+ Results ({{query-result.row-count}} rows{% if query-result.truncated? %}, truncated{% endif %}) + + + + {% for column in query-result.columns %} + + {% endfor %} + + + + {% for row in query-result.rows %} + + {% for cell in row %} + + {% endfor %} + + {% endfor %} + +
{{column}}
{{cell}}
+
+ {% endif %} +
+ {% endif %} +
+
+ +{% if session %} + +{% endif %} +{% endblock %} diff --git a/backend/src/app/graph/bulk.clj b/backend/src/app/graph/bulk.clj new file mode 100644 index 0000000000..9d24cb5dcc --- /dev/null +++ b/backend/src/app/graph/bulk.clj @@ -0,0 +1,139 @@ +;; 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.bulk + "Bulk Ladybug ingest via COPY FROM CSV. + + Node and relationship rows are written to a temporary staging directory + and loaded with one COPY statement per table (or per rel FROM/TO pair)." + (:require + [app.graph.ladybug :as ladybug] + [clojure.java.io :as io] + [clojure.string :as str] + [datoteka.fs :as fs]) + (:import + java.io.File)) + +(set! *warn-on-reflection* true) + +(def ^:private copy-csv-options + "Ladybug COPY CSV options. QUOTE must be set explicitly or commas in + string fields are treated as column separators." + "HEADER=true, DELIM=',', QUOTE='\"'") + +(defn- csv-normalize-string + "Graph node names are single-line labels; flatten Penpot text newlines." + [s] + (-> (str s) + (str/replace #"\r\n" " ") + (str/replace #"\r" " ") + (str/replace #"\n" " "))) + +(defn- csv-escape-string + [s] + (str "\"" (str/replace (csv-normalize-string s) "\"" "\"\"") "\"")) + +(defn- csv-cell + [v] + (cond + (uuid? v) (str v) + (string? v) (csv-escape-string v) + (number? v) (str (long v)) + :else (csv-escape-string (str v)))) + +(defn- cypher-file-path + [^File file] + (-> (.getAbsolutePath file) + (str/replace "\\" "\\\\") + (str/replace "'" "\\'"))) + +(defn- node-columns + [rows] + (let [cols (into #{} (mapcat keys rows)) + preferred [:id :name :version :revision :index]] + (into (vec (filter cols preferred)) + (sort (remove (set preferred) cols))))) + +(defn- write-node-csv! + [^File file rows] + (let [columns (node-columns rows)] + (with-open [w (io/writer file :encoding "UTF-8")] + (.write w (str (str/join "," (map name columns)) "\n")) + (doseq [row rows] + (.write w (str (str/join "," (map #(csv-cell (get row %)) columns)) + "\n")))))) + +(defn- write-edge-csv! + [^File file edges] + (with-open [w (io/writer file :encoding "UTF-8")] + (.write w "from,to,position\n") + (doseq [{:keys [from-id to-id position]} edges] + (.write w (str (csv-cell from-id) "," + (csv-cell to-id) "," + (csv-cell position) "\n"))))) + +(defn- delete-tree! + [path] + (when (fs/exists? path) + (doseq [f (reverse (file-seq (io/file path)))] + (.delete ^File f)))) + +(defn staging-dir + "Directory for temporary COPY CSV files." + [db-path file-id] + (if (= db-path ":memory:") + (str (fs/path (System/getProperty "java.io.tmpdir") + "penpot-graph-bulk" + (str file-id))) + (str (fs/path (str db-path ".bulk") (str file-id))))) + +(defn- copy-node-table! + [conn table ^File csv-file] + (let [statement (str "COPY `" table "` FROM '" (cypher-file-path csv-file) + "' (" copy-csv-options ");")] + (try + (ladybug/exec-on-connection! conn [statement]) + (catch clojure.lang.ExceptionInfo e + (throw (ex-info (str "COPY node table failed: " table) + (merge (ex-data e) + {:table table + :csv-file (.getAbsolutePath csv-file)}) + e)))))) + +(defn- copy-edge-group! + [conn from-table to-table ^File csv-file] + (let [statement (str "COPY `IsChildOf` FROM '" (cypher-file-path csv-file) "' " + "(from='" from-table "', to='" to-table "', " + copy-csv-options ");")] + (try + (ladybug/exec-on-connection! conn [statement]) + (catch clojure.lang.ExceptionInfo e + (throw (ex-info (str "COPY edge group failed: " from-table " -> " to-table) + (merge (ex-data e) + {:from-table from-table + :to-table to-table + :csv-file (.getAbsolutePath csv-file)}) + e)))))) + +(defn load-projection! + "Load projected nodes and edges into an open Ladybug connection." + [conn {:keys [nodes edges]} staging-path] + (fs/create-dir staging-path) + (try + (doseq [[table rows] (sort-by key nodes) + :when (seq rows)] + (let [csv-file (io/file staging-path (str table ".csv"))] + (write-node-csv! csv-file rows) + (copy-node-table! conn table csv-file))) + (doseq [[[from-table to-table] group] + (sort-by identity (group-by (juxt :from-table :to-table) edges)) + :when (seq group)] + (let [csv-file (io/file staging-path + (str "IsChildOf_" from-table "_" to-table ".csv"))] + (write-edge-csv! csv-file group) + (copy-edge-group! conn from-table to-table csv-file))) + (finally + (delete-tree! staging-path)))) diff --git a/backend/src/app/graph/debug.clj b/backend/src/app/graph/debug.clj new file mode 100644 index 0000000000..b50e939075 --- /dev/null +++ b/backend/src/app/graph/debug.clj @@ -0,0 +1,190 @@ +;; 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.sync :as graph.sync] + [app.msgbus :as mbus] + [clojure.string :as str] + [promesa.exec.csp :as sp]) + (:import + com.ladybugdb.Connection + com.ladybugdb.Database)) + +(set! *warn-on-reflection* true) + +(def default-query + "MATCH (n:Document) RETURN n.id AS id, n.name AS name;") + +(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- 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 [result (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) + (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) + (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)) + session + (-> {:db db + :conn conn + :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 `statement` against the in-memory graph for `profile-id`." + [profile-id statement] + (when (str/blank? statement) + (ex/raise :type :validation + :code :missing-query + :hint "cypher query is required")) + (if-let [{:keys [conn]} (get @sessions (session-key profile-id))] + (-> (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"))) + +(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 query-result + :error error + :message message + :default-query default-query}) diff --git a/backend/src/app/graph/ingest.clj b/backend/src/app/graph/ingest.clj index 569bb82008..b5bfb9dac7 100644 --- a/backend/src/app/graph/ingest.clj +++ b/backend/src/app/graph/ingest.clj @@ -5,37 +5,80 @@ ;; Copyright (c) KALEIDOS INC Sucursal en España SL (ns app.graph.ingest - "Penpot file -> Ladybug graph projection. - - Skeleton stage: loads the canonical file from the backend and exercises - Ladybug. Document projection will replace the smoke test step." + "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.bulk :as bulk] [app.graph.ladybug :as ladybug] - [app.srepl.helpers :as h])) + [app.graph.project.document :as project.document] + [app.graph.project.transforms :as project.transforms] + [app.graph.schema :as schema] + [app.graph.stats :as stats] + [app.srepl.helpers :as h]) + (:import + com.ladybugdb.Connection)) -(defn ingest-file! - [system file-id & {:keys [db-path smoke-test?] - :or {smoke-test? true}}] +(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)) - db-path (or db-path (ladybug/db-path-for-file 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))) - (l/inf :hint "graph ingest skeleton" + (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! + "Project `file-id` into an already open Ladybug `conn`." + [system ^Connection conn file-id & {: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) - ;; TODO: project (:data file) into Ladybug node/rel tables. - (let [ladybug-result (when smoke-test? - (ladybug/smoke-test! system :db-path db-path))] - {:file-id file-id - :revn (:revn file) - :name (get-in file [:data :name]) - :db-path db-path - :ladybug ladybug-result}))) + :db-path db-path + :schema schema/schema-version) + (let [ddl (schema/ddl-statements) + {:keys [nodes edges stats]} + (project.document/projection-data data file) + staging-path (bulk/staging-dir db-path file-id)] + (ladybug/exec-on-connection! conn ddl) + (bulk/load-projection! conn {:nodes nodes :edges edges} staging-path) + (ladybug/exec-on-connection! conn ["CHECKPOINT;"]) + {:file-id file-id + :revn (:revn file) + :name (or (:name data) (:name file)) + :db-path db-path + :schema-version schema/schema-version + :projection {:stats stats + :nodes nodes + :edges edges} + :transforms (project.transforms/apply-transforms! system db-path data file) + :stats (when-not skip-stats? + (stats/summarize-connection conn))}))) + +(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)) + (ladybug/with-connection! db-path + (fn [conn] + (ingest-on-connection! system conn file-id + :db-path db-path + :skip-stats? skip-stats? + :skip-validation? skip-validation?))))) diff --git a/backend/src/app/graph/ladybug.clj b/backend/src/app/graph/ladybug.clj index 4b309db524..533971aff7 100644 --- a/backend/src/app/graph/ladybug.clj +++ b/backend/src/app/graph/ladybug.clj @@ -5,25 +5,22 @@ ;; Copyright (c) KALEIDOS INC Sucursal en España SL (ns app.graph.ladybug - "Thin Ladybug access layer for graph-backed Penpot. + "Ladybug access layer for graph-backed Penpot. - Uses the `lbug` CLI for now. A JNI-backed implementation can replace - `exec!` later without changing callers." + Uses the embedded Java API (`com.ladybugdb/lbug`)." (:require [app.common.exceptions :as ex] - [app.util.shell :as shell] [clojure.string :as str] [datoteka.fs :as fs]) (:import - java.io.File - java.nio.file.Files)) + com.ladybugdb.Connection + com.ladybugdb.Database + com.ladybugdb.FlatTuple + com.ladybugdb.QueryResult + com.ladybugdb.Value)) (set! *warn-on-reflection* true) -(defn- lbug-bin - [] - (or (System/getenv "PENPOT_LBUG_BIN") "lbug")) - (defn default-graph-dir [] (or (System/getenv "PENPOT_GRAPH_DIR") "/tmp/penpot-graph")) @@ -32,47 +29,197 @@ [file-id] (str (fs/path (default-graph-dir) (str file-id ".lbug")))) -(defn- write-temp-script! - [statements] - (let [^File file (File/createTempFile "penpot-graph-" ".cypher") - content (str/join "\n" (concat statements [":quit"]))] - (spit file content) - (.getAbsolutePath file))) +(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-value + [v] + (cond + (nil? v) "NULL" + (uuid? v) (format-uuid v) + (string? v) (format-string v) + (number? v) (format-int v) + (boolean? v) (if v "true" "false") + :else (format-string (str 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 (.getValue 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- 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)) + (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)) + +(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 one or more Cypher statements against a Ladybug database. + "Execute Cypher statements against a Ladybug database. `db-path` is either `:memory:` or a filesystem path to a `.lbug` database." - [system db-path statements & {:keys [timeout] :or {timeout 120}}] - (assert (sequential? statements) "statements should be a sequential collection") - (when-not (= db-path ":memory:") - (fs/create-dir (fs/parent db-path))) - (let [script-path (write-temp-script! statements) - result (shell/exec! - system - {:cmd [(lbug-bin) db-path "-i" script-path "-m" "csv" "-s" "-b"] - :timeout timeout})] - (Files/deleteIfExists (fs/path script-path)) - (when (not= 0 (:exit result)) - (ex/raise :type :internal - :code :ladybug-exec-failed - :hint "Ladybug query execution failed" - :db-path db-path - :exit (:exit result) - :err (:err result) - :out (:out result))) - result)) + [db-path statements] + (with-connection! db-path + (fn [conn] + (exec-on-connection! conn statements)))) -(defn smoke-test-statements - [] - ["CREATE NODE TABLE Person(name STRING, age INT64, PRIMARY KEY(name));" - "CREATE (:Person {name: 'Alice', age: 25});" - "CREATE (:Person {name: 'Bob', age: 30});" - "MATCH (a:Person) RETURN a.name AS NAME, a.age AS AGE ORDER BY NAME;"]) +(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 + MATCH against Ladybug." - [system & {:keys [db-path] :or {db-path ":memory:"}}] - (let [result (exec! system db-path (smoke-test-statements))] - {:db-path db-path - :out (:out result)})) + "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;")}))) diff --git a/backend/src/app/graph/project/document.clj b/backend/src/app/graph/project/document.clj new file mode 100644 index 0000000000..ec00e74806 --- /dev/null +++ b/backend/src/app/graph/project/document.clj @@ -0,0 +1,147 @@ +;; 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.project.document + "Project a Penpot file-data map into Ladybug nodes and structural edges. + + Projects Document, Page, the full shape tree (skipping the root frame), + and `IsChildOf` edges from shapes to their page or container parent." + (:require + [app.common.logging :as l] + [app.common.uuid :as uuid] + [app.graph.project.specs :as specs] + [app.graph.schema :as graph.schema])) + +(def root-frame-id + uuid/zero) + +(def ^:private shape-type->table + {:frame "Frame" + :rect "Rectangle" + :group "Group" + :circle "Circle" + :path "Path" + :text "Text" + :bool "Boolean" + :image "Image" + :svg-raw "SVGRaw"}) + +(defn- document-attrs + [file data] + {:id (or (:id data) (:id file)) + :name (or (:name data) (:name file) "Untitled") + :version (long (or (:version data) 67)) + :revision (long (or (:revn file) 0))}) + +(defn- page-attrs + [page index] + (cond-> {:id (:id page) + :name (:name page)} + (some? index) (assoc :index (long index)))) + +(defn- shape-table + [shape] + (get shape-type->table (keyword (:type shape)))) + +(defn- shape-node-attrs + [shape] + (specs/check-shape-node {:id (:id shape) + :name (:name shape)})) + +(defn- container-table? + [table] + (contains? graph.schema/container-node-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 :shapes 0}}) + +(declare project-shape-ids) + +(defn- project-shape + [objects acc table shape parent-table parent-id position] + (let [shape-id (:id shape) + acc' (-> acc + (update-in [:nodes table] (fnil conj []) (shape-node-attrs shape)) + (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) + acc'))) + +(defn- project-shape-ids + [objects acc parent-table parent-id child-ids] + (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) + (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 (specs/check-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) + acc'))) + +(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 (specs/check-document (document-attrs file data)) + pages (seq (reverse (:pages data))) + acc0 (-> (initial-acc) + (update-in [:nodes "Document"] (fnil conj []) doc-node) + (assoc-in [:stats :documents] 1)) + acc (if (empty? pages) + acc0 + (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))) + acc0 + (map-indexed vector pages)))] + (select-keys acc [:nodes :edges :stats]))) diff --git a/backend/src/app/graph/project/specs.clj b/backend/src/app/graph/project/specs.clj new file mode 100644 index 0000000000..3050b02e04 --- /dev/null +++ b/backend/src/app/graph/project/specs.clj @@ -0,0 +1,50 @@ +;; 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.project.specs + "Malli schemas for graph projection payloads. + + These are intentionally small subsets of the Penpot file model: they + validate only the attributes written into Ladybug nodes for the + current vertical slice." + (:require + [app.common.schema :as sm])) + +(def schema:document + [:map {:title "GraphDocument"} + [:id ::sm/uuid] + [:name :string] + [:version {:optional true} :int] + [:revision {:optional true} :int]]) + +(def schema:page + [:map {:title "GraphPage"} + [:id ::sm/uuid] + [:name :string] + [:index {:optional true} :int]]) + +(def schema:shape-node + [:map {:title "GraphShapeNode"} + [:id ::sm/uuid] + [:name :string]]) + +(def check-document + (sm/check-fn schema:document + :type :validation + :code :graph-document-projection + :hint "invalid graph document projection")) + +(def check-page + (sm/check-fn schema:page + :type :validation + :code :graph-page-projection + :hint "invalid graph page projection")) + +(def check-shape-node + (sm/check-fn schema:shape-node + :type :validation + :code :graph-shape-projection + :hint "invalid graph shape projection")) diff --git a/backend/src/app/graph/project/transforms.clj b/backend/src/app/graph/project/transforms.clj new file mode 100644 index 0000000000..9d64f1b224 --- /dev/null +++ b/backend/src/app/graph/project/transforms.clj @@ -0,0 +1,15 @@ +;; 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.project.transforms + "Derived graph links (instances, tokens, nested containment, etc.). + + Stub for now: beadpot's `apply_transformations` will be ported here.") + +(defn apply-transforms! + "Apply derived transformations to an already projected graph." + [_system _db-path _data _file] + {:transforms 0}) diff --git a/backend/src/app/graph/report.clj b/backend/src/app/graph/report.clj new file mode 100644 index 0000000000..d615a26447 --- /dev/null +++ b/backend/src/app/graph/report.clj @@ -0,0 +1,60 @@ +;; 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])) + +(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))) + + (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) diff --git a/backend/src/app/graph/schema.clj b/backend/src/app/graph/schema.clj new file mode 100644 index 0000000000..e66b393c09 --- /dev/null +++ b/backend/src/app/graph/schema.clj @@ -0,0 +1,88 @@ +;; 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 for the graph-backed Penpot vertical slice. + + Table names follow beadpot conventions. This is an intentionally small + subset of the full schema and will grow incrementally." + (:require + [clojure.string :as str])) + +(def schema-version + "penpot-graph-slice-2") + +(def container-node-tables + #{"Frame" "Group" "Boolean" "SVGRaw"}) + +(def node-tables + [{:name "Document" + :columns [["id" "UUID"] + ["name" "STRING"] + ["version" "INT64"] + ["revision" "INT64"]]} + {:name "Page" + :columns [["id" "UUID"] + ["name" "STRING"] + ["index" "INT64"]]} + {:name "Frame" + :columns [["id" "UUID"] + ["name" "STRING"]]} + {:name "Rectangle" + :columns [["id" "UUID"] + ["name" "STRING"]]} + {:name "Group" + :columns [["id" "UUID"] + ["name" "STRING"]]} + {:name "Circle" + :columns [["id" "UUID"] + ["name" "STRING"]]} + {:name "Path" + :columns [["id" "UUID"] + ["name" "STRING"]]} + {:name "Text" + :columns [["id" "UUID"] + ["name" "STRING"]]} + {:name "Boolean" + :columns [["id" "UUID"] + ["name" "STRING"]]} + {:name "Image" + :columns [["id" "UUID"] + ["name" "STRING"]]} + {:name "SVGRaw" + :columns [["id" "UUID"] + ["name" "STRING"]]}]) + +(def shape-node-tables + (mapv :name (drop 2 node-tables))) + +(defn- create-node-table-ddl + [{:keys [name columns]}] + (let [cols (str/join ", " + (concat + (map (fn [[col type]] + (str "`" col "` " type)) + columns) + ["PRIMARY KEY (`id`)"]))] + (str "CREATE NODE TABLE `" name "` (" cols ");"))) + +(def is-child-of-ddl + (str "CREATE REL TABLE `IsChildOf` (" + "FROM `Page` TO `Document`, " + (str/join ", " + (concat + (map (fn [shape] + (str "FROM `" shape "` TO `Page`")) + shape-node-tables) + (for [shape shape-node-tables + container container-node-tables] + (str "FROM `" shape "` TO `" container "`")))) + ", `position` INT64);")) + +(defn ddl-statements + [] + (conj (vec (map create-node-table-ddl node-tables)) + is-child-of-ddl)) diff --git a/backend/src/app/graph/stats.clj b/backend/src/app/graph/stats.clj new file mode 100644 index 0000000000..a4ed69dbcd --- /dev/null +++ b/backend/src/app/graph/stats.clj @@ -0,0 +1,39 @@ +;; 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 :as schema])) + +(defn- node-label-for-match + [table] + (if (#{"Group" "Boolean"} table) + (str "`" table "`") + table)) + +(defn- count-on-connection + [conn statement] + (or (ladybug/query-scalar-on-connection! conn statement) 0)) + +(defn summarize-connection + "Return node/edge counts using an open Ladybug connection." + [conn] + {:nodes (into {} + (map (fn [{:keys [name]}] + [name (count-on-connection + conn + (str "MATCH (n:" (node-label-for-match name) ") " + "RETURN count(n) AS " name "_c;"))]) + schema/node-tables)) + :edges {:IsChildOf (count-on-connection + conn + "MATCH ()-[e:IsChildOf]->() RETURN count(e) AS IsChildOf_c;")}}) + +(defn summarize + "Return node/edge counts from the graph database." + [db-path] + (ladybug/with-connection! db-path summarize-connection)) diff --git a/backend/src/app/graph/sync.clj b/backend/src/app/graph/sync.clj new file mode 100644 index 0000000000..221481586b --- /dev/null +++ b/backend/src/app/graph/sync.clj @@ -0,0 +1,525 @@ +;; 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.project.specs :as specs] + [clojure.string :as str]) + (:import + com.ladybugdb.Connection)) + +(set! *warn-on-reflection* true) + +(def ^:private shape-type->table + {:frame "Frame" + :rect "Rectangle" + :group "Group" + :circle "Circle" + :path "Path" + :text "Text" + :bool "Boolean" + :image "Image" + :svg-raw "SVGRaw"}) + +(def ^:private supported-change-types + #{:add-obj :mod-obj :del-obj :add-page :del-page :mod-page :mov-objects}) + +(defn- node-label + [table] + (if (#{"Group" "Boolean"} table) + (str "`" table "`") + table)) + +(defn- shape-table + [shape] + (get shape-type->table (keyword (: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- shape-index-table? + [table] + (not (contains? #{"Document" "Page" :Document :Page} 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)) + :page-id (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) + 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 + :shapes shapes + :children children-index})) + + +(defn- create-node-statement + [table {:keys [id name version revision index]}] + (let [label (node-label table) + attrs (cond-> [(str "id: " (ladybug/format-uuid id)) + (str "name: " (ladybug/format-string name))] + (some? version) (conj (str "version: " (ladybug/format-int version))) + (some? revision) (conj (str "revision: " (ladybug/format-int revision))) + (some? index) (conj (str "index: " (ladybug/format-int index))))] + (str "CREATE (:" label " {" (str/join ", " attrs) "});"))) + +(defn- delete-node-statement + [table shape-id] + (str "MATCH (n:" (node-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:" (node-label from-table) " {id: " (ladybug/format-uuid from-id) "}), " + "(p:" (node-label to-table) " {id: " (ladybug/format-uuid to-id) "}) " + "CREATE (s)-[:IsChildOf {position: " (ladybug/format-int position) "}]->(p);")) + +(defn- delete-edge-statement + [{:keys [from-table from-id to-table to-id]}] + (str "MATCH (s:" (node-label from-table) " {id: " (ladybug/format-uuid from-id) "})" + "-[r:IsChildOf]->" + "(p:" (node-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:" (node-label from-table) " {id: " (ladybug/format-uuid from-id) "})" + "-[r:IsChildOf]->" + "(p:" (node-label to-table) " {id: " (ladybug/format-uuid to-id) "}) " + "SET r.position = " (ladybug/format-int position) ";")) + +(defn- set-shape-name-statement + [table shape-id name] + (str "MATCH (s:" (node-label table) " {id: " (ladybug/format-uuid shape-id) "}) " + "SET s.name = " (ladybug/format-string name) ";")) + +(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- set-document-revision-statement + [doc-id revn] + (str "MATCH (d:Document {id: " (ladybug/format-uuid doc-id) "}) " + "SET d.revision = " (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- default-position + [index parent-id] + (count (get-in index [:children parent-id] #{}))) + +(defn- index-add-shape! + [index {:keys [id name table parent-id parent-table position page-id]}] + (-> index + (assoc-in [:shapes id] + {:id id + :name name + :table table + :parent-id parent-id + :parent-table parent-table + :position position + :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 index doc-id]}] + (-> index + (assoc-in [:pages id] {:id id :name name :index index}) + (update :children update doc-id (fnil conj #{}) id))) + +(defn- index-move-shape! + [index shape-id {:keys [parent-id parent-table position page-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) + (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)))) + +(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- mov-position + [idx parent-id {:keys [index after-shape]}] + (cond + (some? index) (long index) + after-shape (let [after-pos (get-in idx [:shapes after-shape :position])] + (if (some? after-pos) + (inc (long after-pos)) + (default-position idx parent-id))) + :else (default-position idx parent-id))) + +(defn- 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 [base-position (mov-position index (:parent-id parent) change) + parent-id (:parent-id parent) + parent-table (:parent-table parent) + page-id' (or page-id + (when (= parent-table "Page") parent-id) + (get-in index [:shapes (first shape-ids) :page-id]))] + (loop [index index + statements [] + shape-ids (map-indexed vector shape-ids)] + (if-let [[offset shape-id] (first shape-ids)] + (if-let [shape (get-in index [:shapes shape-id])] + (let [position (+ base-position (long offset)) + same-edge? (and (= parent-id (:parent-id shape)) + (= parent-table (:parent-table shape)) + (= position (:position shape))) + edge {:from-table (:table shape) + :from-id shape-id + :to-table parent-table + :to-id parent-id + :position position} + statements (if same-edge? + statements + (into statements + (if (= parent-id (:parent-id shape)) + [(set-edge-position-statement edge)] + [(delete-edge-statement + {:from-table (:table shape) + :from-id shape-id + :to-table (:parent-table shape) + :to-id (:parent-id shape)}) + (create-edge-statement edge)]))) + index (if same-edge? + index + (index-move-shape! index shape-id + {:parent-id parent-id + :parent-table parent-table + :position position + :page-id page-id'}))] + (recur index statements (rest shape-ids))) + (recur index statements (rest shape-ids))) + {:index index + :statements statements + :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- apply-add-obj + [index change] + (let [{:keys [id obj page-id parent-id frame-id index]} change + table (shape-table obj)] + (if-not table + {:index index :statements [] :applied? false :reason :unsupported-shape-type} + (let [parent (resolve-parent-for-add index change)] + (if-not parent + {:index index :statements [] :applied? false :reason :missing-parent} + (let [position (long (or index (default-position index (:parent-id parent)))) + attrs (specs/check-shape-node {:id id :name (:name obj)}) + edge (merge {:from-table table + :from-id id + :to-table (:parent-table parent) + :to-id (:parent-id parent) + :position position} + )] + {:index (index-add-shape! index + {:id id + :name (:name attrs) + :table table + :parent-id (:parent-id parent) + :parent-table (:parent-table parent) + :position position + :page-id (or page-id (when (= (:parent-table parent) "Page") + (:parent-id parent)))}) + :statements [(create-node-statement table attrs) + (create-edge-statement edge)] + :applied? true})))))) + +(defn- apply-mod-obj + [index {:keys [id operations]}] + (if-let [shape (get-in index [:shapes id])] + (let [name-ops (filter #(and (= :set (:type %)) (= :name (:attr %))) operations)] + (if (empty? name-ops) + {:index index :statements [] :applied? false :reason :unsupported-operations} + (let [name (:val (last name-ops)) + table (:table shape) + attrs (specs/check-shape-node {:id id :name name})] + {:index (assoc-in index [:shapes id :name] (:name attrs)) + :statements [(set-shape-name-statement table id (:name attrs))] + :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 [shape (get-in index [:shapes id])] + (let [to-delete (delete-order-deepest-first (:children index) id) + statements + (vec (concat + (mapcat (fn [shape-id] + (let [{:keys [table parent-id parent-table]} + (get-in index [:shapes shape-id])] + [(delete-edge-statement + {:from-table table + :from-id shape-id + :to-table parent-table + :to-id parent-id}) + (delete-node-statement table shape-id)])) + to-delete)))] + {:index (reduce index-remove-shape! index to-delete) + :statements statements + :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 (specs/check-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-let [page (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- 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) + {: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))) diff --git a/backend/src/app/http/debug.clj b/backend/src/app/http/debug.clj index 979c9951f8..61a0bf7328 100644 --- a/backend/src/app/http/debug.clj +++ b/backend/src/app/http/debug.clj @@ -21,6 +21,8 @@ [app.config :as cf] [app.db :as db] [app.features.file-migrations :as feat.fmig] + [app.graph.debug :as graph.debug] + [app.graph.ingest :as graph.ingest] [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] @@ -326,6 +329,113 @@ "content-disposition" (str "attachmen; filename=" (first file-ids) ".penpot")}})))) +(defn graph-export-handler + "Build (or rebuild) the Ladybug graph for a file and stream the `.lbug` + database. MVP: synchronous ingest on each request." + [cfg {:keys [params]}] + (let [file-id (some-> params :file-id parse-uuid)] + (when-not file-id + (ex/raise :type :validation + :code :missing-arguments + :hint "missing file-id")) + + (let [{:keys [db-path]} (graph.ingest/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)) + {::yres/status 200 + ::yres/body (io/input-stream db-path) + ::yres/headers {"content-type" "application/octet-stream" + "content-disposition" (str "attachment; filename=" file-id ".lbug")}}))) + +(defn- graph-console-response + [profile-id 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]}] + (graph-console-response profile-id + (graph.debug/console-context profile-id))) + +(defn graph-load-handler + [cfg {:keys [params ::session/profile-id]}] + (let [file-id (some-> (:file-id params) parse-uuid)] + (when-not file-id + (ex/raise :type :validation + :code :missing-arguments + :hint "missing file-id")) + (graph.debug/load-session! cfg profile-id file-id) + {::yres/status 302 + ::yres/headers {"location" "/dbg/graph"}})) + +(defn graph-unload-handler + [_cfg {:keys [::session/profile-id]}] + (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]}] + (if-let [file-id (some-> (graph.debug/session-info profile-id) :file-id)] + (do + (graph.debug/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 (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- 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)] + (try + (let [result (graph.debug/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 profile-id + (graph.debug/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 profile-id + (graph.debug/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) @@ -563,6 +673,7 @@ ["" {:handler (partial index-handler cfg)}] ["/health" {:handler (partial health-handler cfg)}] ["/changelog" {:handler (partial changelog-handler cfg)}] + ["/graph" {:handler (partial graph-console-handler cfg)}] ["/error/:id" {:handler (partial error-handler cfg)}] ["/error" {:handler (partial error-list-handler cfg)}] ["/actions" {:middleware [[errors]]} @@ -573,6 +684,12 @@ ["/handle-team-features" {:handler (partial handle-team-features cfg)}] ["/file-export" {:handler (partial export-handler 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)}] ["/file-import" {:handler (partial import-handler cfg)}] ["/file-raw-export-import" {:handler (partial raw-export-import-handler cfg)}]]]]) diff --git a/backend/src/app/main.clj b/backend/src/app/main.clj index ca8fba8af1..c9f445a6fc 100644 --- a/backend/src/app/main.clj +++ b/backend/src/app/main.clj @@ -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)} diff --git a/backend/src/app/srepl/main.clj b/backend/src/app/srepl/main.clj index 3e5c85fb2a..64331b85d9 100644 --- a/backend/src/app/srepl/main.clj +++ b/backend/src/app/srepl/main.clj @@ -27,6 +27,7 @@ [app.features.file-snapshots :as fsnap] [app.graph.ingest :as graph.ingest] [app.graph.ladybug :as graph.ladybug] + [app.graph.report :as graph.report] [app.http.session :as session] [app.loggers.audit :as audit] [app.main :as main] @@ -405,21 +406,35 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn graph-smoke-test! - "Execute a basic Ladybug smoke test (CREATE + MATCH). + "Execute a basic Ladybug smoke test (CREATE + count). - Requires the `lbug` CLI on PATH, or set PENPOT_LBUG_BIN. Use :db-path - \":memory:\" (default) or a filesystem path such as /tmp/test.lbug." + 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:"}}] - (graph.ladybug/smoke-test! main/system :db-path db-path)) + (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 (graph.ladybug/db-path-for-file file-id)) + stmt "MATCH (n:Document) RETURN count(n) AS Document_c;"] + (graph.ladybug/query-scalar! db-path stmt))) (defn ingest-file-to-graph! - "Skeleton graph ingest for a Penpot file. + "Project a Penpot file into a per-file Ladybug database. - Loads and realizes the file from the database, prepares the per-file - Ladybug database path, and (for now) runs the Ladybug smoke test. - Full document projection is not implemented yet." - [file-id & {:as opts}] - (graph.ingest/ingest-file! main/system file-id opts)) + 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 [result (apply graph.ingest/ingest-file! main/system file-id opts)] + (graph.report/print-ingest! result) + result)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; PROCESSING