fix: properties of :classes and :properties didn't generate

from scripts. Fixes schema graph generation
experiment/tanstack-table
Gabriel Horner 2024-05-13 15:32:35 -04:00
parent a2a951ddcb
commit 330571effe
2 changed files with 86 additions and 76 deletions

View File

@ -53,7 +53,7 @@
(defn- translate-property-value (defn- translate-property-value
"Translates a property value for create-graph edn. A value wrapped in vector "Translates a property value for create-graph edn. A value wrapped in vector
may indicate a reference type e.g. [:page \"some page\"]" may indicate a reference type e.g. [:page \"some page\"]"
[val {:keys [page-uuids block-uuids]}] [val page-uuids]
(if (vector? val) (if (vector? val)
(case (first val) (case (first val)
;; Converts a page name to block/uuid ;; Converts a page name to block/uuid
@ -62,44 +62,33 @@
[:block/uuid page-uuid] [:block/uuid page-uuid]
(throw (ex-info (str "No uuid for page '" (second val) "'") {:name (second val)}))) (throw (ex-info (str "No uuid for page '" (second val) "'") {:name (second val)})))
:block/uuid :block/uuid
val val)
;; TODO: If not used by :default and replace uuid-maps with just page-uuids everywhere
:block
(or (block-uuids (second val))
(throw (ex-info (str "No uuid for block '" (second val) "'") {:name (second val)})))
(throw (ex-info "Invalid property value type. Valid values are :block and :page" {})))
val)) val))
(defn- get-ident [all-idents kw] (defn- get-ident [all-idents kw]
(or (get all-idents kw) (or (get all-idents kw)
(throw (ex-info (str "No ident found for " kw) {})))) (throw (ex-info (str "No ident found for " kw) {}))))
(defn- ->block-properties [properties uuid-maps all-idents] (defn- ->block-properties [properties page-uuids all-idents]
(->> (->>
(map (map
(fn [[prop-name val]] (fn [[prop-name val]]
[(get-ident all-idents prop-name) [(get-ident all-idents prop-name)
;; set indicates a :many value ;; set indicates a :many value
(if (set? val) (if (set? val)
(set (map #(translate-property-value % uuid-maps) val)) (set (map #(translate-property-value % page-uuids) val))
(translate-property-value val uuid-maps))]) (translate-property-value val page-uuids))])
properties) properties)
(into {}))) (into {})))
(defn- create-uuid-maps (defn- create-page-uuids
"Creates maps of unique page names, block contents and property names to their uuids" "Creates maps of unique page names, block contents and property names to their uuids"
[pages-and-blocks] [pages-and-blocks]
(let [page-uuids (->> pages-and-blocks (->> pages-and-blocks
(map :page) (map :page)
(map (juxt #(or (:block/name %) (common-util/page-name-sanity-lc (:block/original-name %))) (map (juxt #(or (:block/name %) (common-util/page-name-sanity-lc (:block/original-name %)))
:block/uuid)) :block/uuid))
(into {})) (into {})))
block-uuids (->> pages-and-blocks
(mapcat :blocks)
(map (juxt :block/content :block/uuid))
(into {}))]
{:page-uuids page-uuids
:block-uuids block-uuids}))
(defn- build-property-refs [properties all-idents] (defn- build-property-refs [properties all-idents]
(mapv (mapv
@ -144,7 +133,7 @@
(set (map #(vector :block/uuid (:block/uuid %)) v)) (set (map #(vector :block/uuid (:block/uuid %)) v))
(vector :block/uuid (:block/uuid v)))))) (vector :block/uuid (:block/uuid v))))))
(defn- ->block-tx [{:keys [properties] :as m} properties-config uuid-maps all-idents page-id] (defn- ->block-tx [{:keys [properties] :as m} properties-config page-uuids all-idents page-id]
(let [new-block {:db/id (new-db-id) (let [new-block {:db/id (new-db-id)
:block/format :markdown :block/format :markdown
:block/page {:db/id page-id} :block/page {:db/id page-id}
@ -153,7 +142,7 @@
pvalue-tx-m (->property-value-tx-m new-block properties properties-config all-idents) pvalue-tx-m (->property-value-tx-m new-block properties properties-config all-idents)
block-props (when (seq properties) block-props (when (seq properties)
(->block-properties (merge properties (property-value-properties pvalue-tx-m)) (->block-properties (merge properties (property-value-properties pvalue-tx-m))
uuid-maps all-idents))] page-uuids all-idents))]
(cond-> [] (cond-> []
;; Place property values first since they are referenced by block ;; Place property values first since they are referenced by block
(seq pvalue-tx-m) (seq pvalue-tx-m)
@ -165,7 +154,7 @@
(merge block-props (merge block-props
{:block/refs (build-property-refs properties all-idents)}))))))) {:block/refs (build-property-refs properties all-idents)})))))))
(defn- build-properties-tx [properties uuid-maps all-idents] (defn- build-properties-tx [properties page-uuids all-idents]
(let [property-db-ids (->> (keys properties) (let [property-db-ids (->> (keys properties)
(map #(vector (name %) (new-db-id))) (map #(vector (name %) (new-db-id)))
(into {})) (into {}))
@ -181,54 +170,71 @@
{:property-attributes {:property-attributes
{:db/id (or (property-db-ids (name prop-name)) {:db/id (or (property-db-ids (name prop-name))
(throw (ex-info "No :db/id for property" {:property prop-name})))}})) (throw (ex-info "No :db/id for property" {:property prop-name})))}}))
[(merge (let [new-block
(sqlite-util/build-new-property (get-ident all-idents prop-name) (merge (sqlite-util/build-new-property (get-ident all-idents prop-name)
(:block/schema prop-m) (:block/schema prop-m)
{:block-uuid (:block/uuid prop-m)}) {:block-uuid (:block/uuid prop-m)})
{:db/id (or (property-db-ids (name prop-name)) {:db/id (or (property-db-ids (name prop-name))
(throw (ex-info "No :db/id for property" {:property prop-name})))} (throw (ex-info "No :db/id for property" {:property prop-name})))})
(when-let [props (not-empty (:properties prop-m))] pvalue-tx-m (->property-value-tx-m new-block (:properties prop-m) properties all-idents)]
(merge (cond-> []
(->block-properties props uuid-maps all-idents) (seq pvalue-tx-m)
{:block/refs (build-property-refs props all-idents)})) (into (mapcat #(if (set? %) % [%]) (vals pvalue-tx-m)))
(when (seq schema-classes) true
{:property/schema.classes (conj
(mapv #(hash-map :db/ident (get-ident all-idents %)) (merge
schema-classes)}))])) new-block
(when-let [props (not-empty (:properties prop-m))]
(merge
(->block-properties (merge props (property-value-properties pvalue-tx-m)) page-uuids all-idents)
{:block/refs (build-property-refs props all-idents)}))
(when (seq schema-classes)
{:property/schema.classes
(mapv #(hash-map :db/ident (get-ident all-idents %))
schema-classes)})))))))
properties))] properties))]
new-properties-tx)) new-properties-tx))
(defn- build-classes-tx [classes uuid-maps all-idents] (defn- build-classes-tx [classes properties-config uuid-maps all-idents]
(let [class-db-ids (->> (keys classes) (let [class-db-ids (->> (keys classes)
(map #(vector (name %) (new-db-id))) (map #(vector (name %) (new-db-id)))
(into {})) (into {}))
classes-tx (mapv classes-tx (vec
(fn [[class-name {:keys [class-parent schema-properties] :as class-m}]] (mapcat
(merge (fn [[class-name {:keys [class-parent schema-properties] :as class-m}]]
(-> (let [new-block
(sqlite-util/build-new-class (->
{:block/name (common-util/page-name-sanity-lc (name class-name)) (sqlite-util/build-new-class
:block/original-name (name class-name) {:block/name (common-util/page-name-sanity-lc (name class-name))
:block/uuid (d/squuid) :block/original-name (name class-name)
:db/ident (get-ident all-idents class-name) :block/uuid (d/squuid)
:db/id (or (class-db-ids (name class-name)) :db/ident (get-ident all-idents class-name)
(throw (ex-info "No :db/id for class" {:class class-name})))}) :db/id (or (class-db-ids (name class-name))
;; TODO: Move this concern to schema script (throw (ex-info "No :db/id for class" {:class class-name})))})
(dissoc :class/parent)) ;; TODO: Move this concern to schema script
(dissoc class-m :properties :class-parent :schema-properties) (dissoc :class/parent))
(when-let [props (not-empty (:properties class-m))] pvalue-tx-m (->property-value-tx-m new-block (:properties class-m) properties-config all-idents)]
(merge (cond-> []
(->block-properties props uuid-maps all-idents) (seq pvalue-tx-m)
{:block/refs (build-property-refs props all-idents)})) (into (mapcat #(if (set? %) % [%]) (vals pvalue-tx-m)))
(when class-parent true
{:class/parent (conj
(or (class-db-ids class-parent) (merge
(throw (ex-info (str "No :db/id for " class-parent) {})))}) new-block
(when schema-properties (dissoc class-m :properties :class-parent :schema-properties)
{:class/schema.properties (when-let [props (not-empty (:properties class-m))]
(mapv #(hash-map :db/ident (get-ident all-idents (keyword %))) (merge
schema-properties)}))) (->block-properties (merge props (property-value-properties pvalue-tx-m)) uuid-maps all-idents)
classes)] {:block/refs (build-property-refs props all-idents)}))
(when class-parent
{:class/parent
(or (class-db-ids class-parent)
(throw (ex-info (str "No :db/id for " class-parent) {})))})
(when schema-properties
{:class/schema.properties
(mapv #(hash-map :db/ident (get-ident all-idents (keyword %)))
schema-properties)}))))))
classes))]
classes-tx)) classes-tx))
@ -279,8 +285,8 @@
all-idents)) all-idents))
(defn- build-pages-and-blocks-tx (defn- build-pages-and-blocks-tx
[pages-and-blocks all-idents uuid-maps {:keys [page-id-fn properties] [pages-and-blocks all-idents page-uuids {:keys [page-id-fn properties]
:or {page-id-fn :db/id}}] :or {page-id-fn :db/id}}]
(vec (vec
(mapcat (mapcat
(fn [{:keys [page blocks]}] (fn [{:keys [page blocks]}]
@ -303,7 +309,7 @@
new-page new-page
(when (seq (:properties page)) (when (seq (:properties page))
(->block-properties (merge (:properties page) (property-value-properties pvalue-tx-m)) (->block-properties (merge (:properties page) (property-value-properties pvalue-tx-m))
uuid-maps page-uuids
all-idents)) all-idents))
(when (seq (:properties page)) (when (seq (:properties page))
{:block/refs (build-property-refs (:properties page) all-idents) {:block/refs (build-property-refs (:properties page) all-idents)
@ -312,7 +318,7 @@
;; blocks tx ;; blocks tx
(reduce (fn [acc m] (reduce (fn [acc m]
(into acc (into acc
(->block-tx m properties uuid-maps all-idents (page-id-fn new-page)))) (->block-tx m properties page-uuids all-idents (page-id-fn new-page))))
[] []
blocks)))) blocks))))
pages-and-blocks))) pages-and-blocks)))
@ -365,10 +371,10 @@
(seq blocks) (seq blocks)
(assoc :blocks (mapv #(merge {:block/uuid (random-uuid)} %) blocks)))) (assoc :blocks (mapv #(merge {:block/uuid (random-uuid)} %) blocks))))
pages-and-blocks) pages-and-blocks)
uuid-maps (create-uuid-maps pages-and-blocks') page-uuids (create-page-uuids pages-and-blocks')
all-idents (create-all-idents properties classes graph-namespace) all-idents (create-all-idents properties classes graph-namespace)
properties-tx (build-properties-tx properties uuid-maps all-idents) properties-tx (build-properties-tx properties page-uuids all-idents)
classes-tx (build-classes-tx classes uuid-maps all-idents) classes-tx (build-classes-tx classes properties page-uuids all-idents)
class-ident->id (->> classes-tx (map (juxt :db/ident :db/id)) (into {})) class-ident->id (->> classes-tx (map (juxt :db/ident :db/id)) (into {}))
;; Replace idents with db-ids to avoid any upsert issues ;; Replace idents with db-ids to avoid any upsert issues
properties-tx' (mapv (fn [m] properties-tx' (mapv (fn [m]
@ -380,7 +386,7 @@
cs))) cs)))
m)) m))
properties-tx) properties-tx)
pages-and-blocks-tx (build-pages-and-blocks-tx pages-and-blocks' all-idents uuid-maps options)] pages-and-blocks-tx (build-pages-and-blocks-tx pages-and-blocks' all-idents page-uuids options)]
;; Properties first b/c they have schema and are referenced by all. Then classes b/c they can be referenced by pages. Then pages ;; Properties first b/c they have schema and are referenced by all. Then classes b/c they can be referenced by pages. Then pages
(vec (concat properties-tx' (vec (concat properties-tx'
classes-tx classes-tx

View File

@ -365,7 +365,11 @@
:class/schema.properties :class/parent :class/schema.properties :class/parent
:db/cardinality :property/schema.classes]) :db/cardinality :property/schema.classes])
(seq props) (seq props)
(assoc :block/properties (update-keys props name)) (assoc :block/properties (-> (update-keys props name)
(update-vals (fn [v]
(if (:db/id v)
(:block/content (d/entity db (:db/id v)))
v)))))
(seq (:class/schema.properties m)) (seq (:class/schema.properties m))
(update :class/schema.properties #(set (map :block/original-name %))) (update :class/schema.properties #(set (map :block/original-name %)))
(some? (:class/parent m)) (some? (:class/parent m))