mirror of
https://github.com/penpot/penpot.git
synced 2026-08-07 05:18:36 +00:00
♻️ Derive graph node schema from Malli registry
This commit is contained in:
Alejandro Alonso
parent
b36bbf3bb9
commit
b3850d39c0
@ -10,7 +10,9 @@
|
||||
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.common.json :as json]
|
||||
[app.graph.ladybug :as ladybug]
|
||||
[app.graph.schema.nodes :as nodes]
|
||||
[clojure.java.io :as io]
|
||||
[clojure.string :as str]
|
||||
[datoteka.fs :as fs])
|
||||
@ -39,9 +41,14 @@
|
||||
(defn- csv-cell
|
||||
[v]
|
||||
(cond
|
||||
(nil? v) ""
|
||||
(uuid? v) (str v)
|
||||
(string? v) (csv-escape-string v)
|
||||
(number? v) (str (long v))
|
||||
(number? v) (if (== v (long v)) (str (long v)) (str (double v)))
|
||||
(boolean? v) (str v)
|
||||
(keyword? v) (csv-escape-string (name v))
|
||||
(map? v) (csv-escape-string (json/encode v))
|
||||
(coll? v) (csv-escape-string (json/encode v))
|
||||
:else (csv-escape-string (str v))))
|
||||
|
||||
(defn- cypher-file-path
|
||||
@ -50,16 +57,9 @@
|
||||
(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)]
|
||||
[^File file table rows]
|
||||
(let [columns (nodes/column-keys table)]
|
||||
(with-open [w (io/writer file :encoding "UTF-8")]
|
||||
(.write w (str (str/join "," (map name columns)) "\n"))
|
||||
(doseq [row rows]
|
||||
@ -126,7 +126,7 @@
|
||||
(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)
|
||||
(write-node-csv! csv-file table 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))
|
||||
|
||||
@ -73,10 +73,10 @@
|
||||
(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)))
|
||||
(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))
|
||||
@ -143,6 +143,7 @@
|
||||
^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:"
|
||||
|
||||
@ -10,6 +10,7 @@
|
||||
Uses the embedded Java API (`com.ladybugdb/lbug`)."
|
||||
(:require
|
||||
[app.common.exceptions :as ex]
|
||||
[app.common.json :as json]
|
||||
[clojure.string :as str]
|
||||
[datoteka.fs :as fs])
|
||||
(:import
|
||||
@ -57,16 +58,37 @@
|
||||
[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-value
|
||||
[v]
|
||||
(cond
|
||||
(nil? v) "NULL"
|
||||
(uuid? v) (format-uuid v)
|
||||
(string? v) (format-string v)
|
||||
(number? v) (format-int 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 format-typed-value
|
||||
[ladybug-type v]
|
||||
(cond
|
||||
(= ladybug-type "JSON") (format-json v)
|
||||
(and (string? ladybug-type)
|
||||
(str/ends-with? ladybug-type "[]")) (format-json v)
|
||||
:else (format-value v)))
|
||||
|
||||
(defn- ensure-semicolon
|
||||
[statement]
|
||||
(let [s (str/trim (str statement))]
|
||||
@ -146,6 +168,27 @@
|
||||
(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]
|
||||
@ -176,6 +219,7 @@
|
||||
(let [^Connection conn (Connection. db)]
|
||||
(try
|
||||
(.setQueryTimeout conn (long query-timeout-ms))
|
||||
(ensure-extensions! conn)
|
||||
(f conn)
|
||||
(finally
|
||||
(.close conn))))
|
||||
|
||||
@ -12,48 +12,34 @@
|
||||
(:require
|
||||
[app.common.logging :as l]
|
||||
[app.common.uuid :as uuid]
|
||||
[app.graph.project.specs :as specs]
|
||||
[app.graph.schema :as graph.schema]))
|
||||
[app.graph.schema.nodes :as nodes]))
|
||||
|
||||
(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))})
|
||||
(-> file
|
||||
(assoc :id (or (:id data) (:id file)))
|
||||
(dissoc :data)))
|
||||
|
||||
(defn- page-attrs
|
||||
[page index]
|
||||
(cond-> {:id (:id page)
|
||||
:name (:name page)}
|
||||
(some? index) (assoc :index (long index))))
|
||||
(-> page
|
||||
(dissoc :objects)
|
||||
(cond-> (some? index) (assoc :index (long index)))))
|
||||
|
||||
(defn- shape-table
|
||||
[shape]
|
||||
(get shape-type->table (keyword (:type shape))))
|
||||
(nodes/table-for-type (:type shape)))
|
||||
|
||||
(defn- shape-node-attrs
|
||||
[shape]
|
||||
(specs/check-shape-node {:id (:id shape)
|
||||
:name (:name shape)}))
|
||||
[table shape]
|
||||
(nodes/project-attrs table shape))
|
||||
|
||||
(defn- container-table?
|
||||
[table]
|
||||
(contains? graph.schema/container-node-tables table))
|
||||
(contains? nodes/container-tables table))
|
||||
|
||||
(defn- child-shape-ids
|
||||
"Child ids in Penpot z-order (reversed from the stored :shapes list)."
|
||||
@ -73,7 +59,7 @@
|
||||
[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-in [:nodes table] (fnil conj []) (shape-node-attrs table shape))
|
||||
(update :edges conj {:from-table table
|
||||
:from-id shape-id
|
||||
:to-table parent-table
|
||||
@ -109,7 +95,7 @@
|
||||
(let [page-id (:id page)
|
||||
objects (:objects page)
|
||||
root (get objects root-frame-id)
|
||||
page-node (specs/check-page (page-attrs page position))
|
||||
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"
|
||||
@ -128,7 +114,7 @@
|
||||
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))
|
||||
doc-node (nodes/project-attrs "Document" (document-attrs file data))
|
||||
pages (seq (reverse (:pages data)))
|
||||
acc0 (-> (initial-acc)
|
||||
(update-in [:nodes "Document"] (fnil conj []) doc-node)
|
||||
|
||||
@ -1,50 +0,0 @@
|
||||
;; 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"))
|
||||
@ -5,84 +5,26 @@
|
||||
;; Copyright (c) KALEIDOS INC Sucursal en España SL
|
||||
|
||||
(ns app.graph.schema
|
||||
"Ladybug DDL for the graph-backed Penpot vertical slice.
|
||||
"Ladybug DDL facade 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."
|
||||
Node metadata and DDL generation live in `app.graph.schema.nodes`."
|
||||
(:require
|
||||
[clojure.string :as str]))
|
||||
[app.graph.schema.nodes :as nodes]))
|
||||
|
||||
(def schema-version
|
||||
"penpot-graph-slice-2")
|
||||
nodes/schema-version)
|
||||
|
||||
(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"]]}])
|
||||
nodes/container-tables)
|
||||
|
||||
(def shape-node-tables
|
||||
(mapv :name (drop 2 node-tables)))
|
||||
nodes/shape-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);"))
|
||||
(def node-tables
|
||||
(mapv (fn [{:keys [table schema]}]
|
||||
{:name table :schema schema})
|
||||
nodes/node-types))
|
||||
|
||||
(defn ddl-statements
|
||||
[]
|
||||
(conj (vec (map create-node-table-ddl node-tables))
|
||||
is-child-of-ddl))
|
||||
(nodes/ddl-statements))
|
||||
|
||||
232
backend/src/app/graph/schema/nodes.clj
Normal file
232
backend/src/app/graph/schema/nodes.clj
Normal file
@ -0,0 +1,232 @@
|
||||
;; 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, CSV columns, validation, type dispatch — all flow from that."
|
||||
(:require
|
||||
[app.common.exceptions :as ex]
|
||||
[app.common.schema :as sm]
|
||||
[app.common.types.file :as ctf]
|
||||
[app.common.types.page :as ctp]
|
||||
[app.graph.schema.projection :as projection]
|
||||
[app.graph.schema.types :as types]
|
||||
[clojure.string :as str]))
|
||||
|
||||
(def schema-version
|
||||
"penpot-graph-slice-2")
|
||||
|
||||
;; beadpot/graph/schemas.py drop_fields
|
||||
(def ^:private document-projection
|
||||
{:source ctf/schema:file
|
||||
:drop [:data]})
|
||||
|
||||
(def ^:private page-projection
|
||||
{:source ctp/schema:page
|
||||
:drop [:objects]})
|
||||
|
||||
(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)}]
|
||||
(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-ladybug-type
|
||||
"Ladybug column type for projected key `k` on `table`."
|
||||
[table k]
|
||||
(some (fn [entry]
|
||||
(when (= k (first entry))
|
||||
(types/ladybug-type (entry-child-schema entry))))
|
||||
(projection/schema-map-entries (:schema (node-entry table)))))
|
||||
|
||||
(defn column-keys
|
||||
"Projected column keys for `table`, in registry order."
|
||||
[table]
|
||||
(mapv first (projection/schema-map-entries (:schema (node-entry table)))))
|
||||
|
||||
(defn columns
|
||||
"Projected column names for `table`, in registry order."
|
||||
[table]
|
||||
(mapv name (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
|
||||
[attrs k]
|
||||
(or (get attrs k)
|
||||
(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 project-attrs
|
||||
"Select and validate the projected columns for `table` from `attrs`."
|
||||
[table attrs]
|
||||
(let [projected (into {}
|
||||
(keep (fn [k]
|
||||
(when-let [v (get-projected-attr attrs k)]
|
||||
[k v]))
|
||||
(column-keys table)))]
|
||||
(when (empty? projected)
|
||||
(raise-empty-projection! table attrs))
|
||||
(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 property key for inline Cypher literals."
|
||||
[k]
|
||||
(str "`" (name k) "`"))
|
||||
|
||||
(defn- create-node-table-ddl
|
||||
[{:keys [table pk schema]}]
|
||||
(let [cols (for [entry (projection/schema-map-entries schema)
|
||||
:let [k (first entry)
|
||||
child (entry-child-schema entry)]]
|
||||
(str "`" (name k) "` " (types/ladybug-type child)))]
|
||||
(str "CREATE NODE TABLE `" table "` ("
|
||||
(str/join ", " (concat cols [(str "PRIMARY KEY (`" (name pk) "`)")]))
|
||||
");")))
|
||||
|
||||
(defn 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-tables)
|
||||
(for [shape shape-tables
|
||||
container container-tables]
|
||||
(str "FROM `" shape "` TO `" container "`"))))
|
||||
", `position` INT64);"))
|
||||
|
||||
(defn ddl-statements
|
||||
[]
|
||||
(conj (mapv create-node-table-ddl node-types)
|
||||
(is-child-of-ddl)))
|
||||
85
backend/src/app/graph/schema/projection.clj
Normal file
85
backend/src/app/graph/schema/projection.clj
Normal file
@ -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.
|
||||
|
||||
Same model as beadpot's `drop_fields`: start from the canonical schema
|
||||
and remove 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 (beadpot `drop_fields`)
|
||||
- `: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))
|
||||
60
backend/src/app/graph/schema/types.clj
Normal file
60
backend/src/app/graph/schema/types.clj
Normal file
@ -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.schema.types
|
||||
"Map Malli schemas to Ladybug column types.
|
||||
|
||||
Analogue of beadpot's `get_ladybug_type` (util/ladybug.py)."
|
||||
(:require
|
||||
[app.common.logging :as l]
|
||||
[app.common.schema :as sm]
|
||||
[app.common.time :as ct]
|
||||
[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"})
|
||||
|
||||
(defn- normalize-schema
|
||||
[schema]
|
||||
(let [s (sm/schema schema)]
|
||||
(if (m/-ref-schema? s)
|
||||
(recur (m/deref s malli-opts))
|
||||
s)))
|
||||
|
||||
(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)
|
||||
(case t
|
||||
(:maybe :and) (ladybug-type (first (m/children s malli-opts)))
|
||||
(:vector :sequential :set)
|
||||
(str (ladybug-type (first (m/children s malli-opts))) "[]")
|
||||
|
||||
:enum "STRING"
|
||||
(:map :map-of) "JSON"
|
||||
(do
|
||||
(l/wrn :hint "unmapped malli type for ladybug column, defaulting to STRING"
|
||||
:malli-type t)
|
||||
"STRING")))))
|
||||
@ -7,13 +7,7 @@
|
||||
(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))
|
||||
[app.graph.schema.nodes :as nodes]))
|
||||
|
||||
(defn- count-on-connection
|
||||
[conn statement]
|
||||
@ -23,12 +17,12 @@
|
||||
"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))
|
||||
(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 {:IsChildOf (count-on-connection
|
||||
conn
|
||||
"MATCH ()-[e:IsChildOf]->() RETURN count(e) AS IsChildOf_c;")}})
|
||||
|
||||
@ -10,36 +10,19 @@
|
||||
[app.common.logging :as l]
|
||||
[app.common.uuid :as uuid]
|
||||
[app.graph.ladybug :as ladybug]
|
||||
[app.graph.project.specs :as specs]
|
||||
[app.graph.schema.nodes :as nodes]
|
||||
[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))))
|
||||
(nodes/table-for-type (:type shape)))
|
||||
|
||||
(defn- build-parent-map
|
||||
[edges]
|
||||
@ -139,45 +122,50 @@
|
||||
:children children-index}))
|
||||
|
||||
|
||||
(defn- format-node-value
|
||||
[table k v]
|
||||
(ladybug/format-typed-value (nodes/column-ladybug-type table k) v))
|
||||
|
||||
(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) "});")))
|
||||
[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 k) ": "
|
||||
(format-node-value table k v)))]
|
||||
(str "CREATE (:" label " {" (str/join ", " pairs) "});")))
|
||||
|
||||
(defn- delete-node-statement
|
||||
[table shape-id]
|
||||
(str "MATCH (n:" (node-label table) " {id: " (ladybug/format-uuid 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:" (node-label from-table) " {id: " (ladybug/format-uuid from-id) "}), "
|
||||
"(p:" (node-label to-table) " {id: " (ladybug/format-uuid to-id) "}) "
|
||||
(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- 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) "})"
|
||||
(str "MATCH (s:" (nodes/match-label from-table) " {id: " (ladybug/format-uuid from-id) "})"
|
||||
"-[r:IsChildOf]->"
|
||||
"(p:" (node-label to-table) " {id: " (ladybug/format-uuid to-id) "}) "
|
||||
"(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:" (node-label from-table) " {id: " (ladybug/format-uuid from-id) "})"
|
||||
(str "MATCH (s:" (nodes/match-label from-table) " {id: " (ladybug/format-uuid from-id) "})"
|
||||
"-[r:IsChildOf]->"
|
||||
"(p:" (node-label to-table) " {id: " (ladybug/format-uuid to-id) "}) "
|
||||
"(p:" (nodes/match-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-node-attr-statement
|
||||
[table shape-id attr value]
|
||||
(str "MATCH (s:" (nodes/match-label table) " {id: " (ladybug/format-uuid shape-id) "}) "
|
||||
"SET s." (nodes/cypher-property-key attr) " = "
|
||||
(format-node-value table attr value) ";"))
|
||||
|
||||
(defn- set-page-name-statement
|
||||
[page-id name]
|
||||
@ -188,7 +176,7 @@
|
||||
(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) ";"))
|
||||
"SET d.revn = " (ladybug/format-int revn) ";"))
|
||||
|
||||
(defn- resolve-parent-for-add
|
||||
[index {:keys [parent-id frame-id page-id]}]
|
||||
@ -229,9 +217,9 @@
|
||||
index))
|
||||
|
||||
(defn- index-add-page!
|
||||
[index {:keys [id name index doc-id]}]
|
||||
[index {:keys [id name doc-id] page-index :index}]
|
||||
(-> index
|
||||
(assoc-in [:pages id] {:id id :name name :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!
|
||||
@ -248,13 +236,13 @@
|
||||
(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 [])]
|
||||
(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
|
||||
@ -275,9 +263,9 @@
|
||||
[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))]
|
||||
(assoc change
|
||||
:frame-id (:parent-id change)
|
||||
:page-id page-id))]
|
||||
(cond
|
||||
(empty? shape-ids)
|
||||
{:index index :statements [] :applied? true}
|
||||
@ -338,32 +326,35 @@
|
||||
(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 parent-id frame-id index]} change
|
||||
(let [{:keys [id obj page-id] pos :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)})
|
||||
(let [position (long (or pos (default-position index (:parent-id parent))))
|
||||
attrs (nodes/project-attrs table (assoc obj :id id))
|
||||
edge (merge {:from-table table
|
||||
:from-id id
|
||||
:to-table (:parent-table parent)
|
||||
:to-id (:parent-id parent)
|
||||
:position position}
|
||||
)]
|
||||
: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)))})
|
||||
{: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}))))))
|
||||
@ -371,14 +362,22 @@
|
||||
(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)
|
||||
(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 [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))]
|
||||
(let [updates (into {} (map (juxt :attr :val) set-ops))
|
||||
statements (for [[attr value] updates]
|
||||
(set-node-attr-statement table id attr value))
|
||||
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}))
|
||||
|
||||
@ -391,7 +390,7 @@
|
||||
|
||||
(defn- apply-del-obj
|
||||
[index {:keys [id]}]
|
||||
(if-let [shape (get-in index [:shapes id])]
|
||||
(if (get-in index [:shapes id])
|
||||
(let [to-delete (delete-order-deepest-first (:children index) id)
|
||||
statements
|
||||
(vec (concat
|
||||
@ -416,9 +415,9 @@
|
||||
[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))})
|
||||
page (nodes/validate-node "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"
|
||||
@ -427,21 +426,21 @@
|
||||
:to-id doc-id
|
||||
:position position}]
|
||||
{:index (index-add-page! index
|
||||
{:id page-id
|
||||
:name (:name page)
|
||||
:index (:index page)
|
||||
:doc-id doc-id})
|
||||
{: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])]
|
||||
(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))))
|
||||
(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})]
|
||||
|
||||
@ -352,7 +352,7 @@
|
||||
"content-disposition" (str "attachment; filename=" file-id ".lbug")}})))
|
||||
|
||||
(defn- graph-console-response
|
||||
[profile-id data]
|
||||
[data]
|
||||
{::yres/status 200
|
||||
::yres/headers {"content-type" "text/html; charset=utf-8"
|
||||
"x-robots-tag" "noindex"}
|
||||
@ -361,8 +361,7 @@
|
||||
|
||||
(defn graph-console-handler
|
||||
[_cfg {:keys [::session/profile-id]}]
|
||||
(graph-console-response profile-id
|
||||
(graph.debug/console-context profile-id)))
|
||||
(graph-console-response (graph.debug/console-context profile-id)))
|
||||
|
||||
(defn graph-load-handler
|
||||
[cfg {:keys [params ::session/profile-id]}]
|
||||
@ -420,8 +419,7 @@
|
||||
::yres/body (t/encode-str {:query query
|
||||
:query-result result}
|
||||
{:type :json-verbose})}
|
||||
(graph-console-response profile-id
|
||||
(graph.debug/console-context profile-id
|
||||
(graph-console-response (graph.debug/console-context profile-id
|
||||
:query query
|
||||
:query-result result))))
|
||||
(catch Throwable e
|
||||
@ -431,8 +429,7 @@
|
||||
::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
|
||||
(graph-console-response (graph.debug/console-context profile-id
|
||||
:query query
|
||||
:error error))))))))
|
||||
|
||||
@ -645,7 +642,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]
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user