diff --git a/scripts/src/logseq/tasks/db_graph/create_graph.cljs b/scripts/src/logseq/tasks/db_graph/create_graph.cljs index d48d450f68..b32107bde8 100644 --- a/scripts/src/logseq/tasks/db_graph/create_graph.cljs +++ b/scripts/src/logseq/tasks/db_graph/create_graph.cljs @@ -129,7 +129,7 @@ (into {})) new-properties-tx (vec (mapcat - (fn [[prop-name prop-m]] + (fn [[prop-name {:keys [schema-classes] :as prop-m}]] (if (:closed-values prop-m) (let [db-ident (get-ident all-idents prop-name)] (db-property-build/build-closed-values @@ -148,7 +148,11 @@ (when-let [props (not-empty (:properties prop-m))] (merge (->block-properties props uuid-maps all-idents) - {:block/refs (build-property-refs props 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))] new-properties-tx)) @@ -159,13 +163,16 @@ classes-tx (mapv (fn [[class-name {:keys [class-parent schema-properties] :as class-m}]] (merge - (sqlite-util/build-new-class - {:block/name (common-util/page-name-sanity-lc (name class-name)) - :block/original-name (name class-name) - :block/uuid (d/squuid) - :db/ident (get-ident all-idents class-name) - :db/id (or (class-db-ids (name class-name)) - (throw (ex-info "No :db/id for class" {:class class-name})))}) + (-> + (sqlite-util/build-new-class + {:block/name (common-util/page-name-sanity-lc (name class-name)) + :block/original-name (name class-name) + :block/uuid (d/squuid) + :db/ident (get-ident all-idents class-name) + :db/id (or (class-db-ids (name class-name)) + (throw (ex-info "No :db/id for class" {:class class-name})))}) + ;; TODO: Move this concern to schema script + (dissoc :class/parent)) (dissoc class-m :properties :class-parent :schema-properties) (when-let [props (not-empty (:properties class-m))] (merge @@ -251,6 +258,7 @@ Additional keys available: * :closed-values - Define closed values with a vec of maps. A map contains keys :uuid, :value and :icon. * :properties - Define properties on a property page. + * :schema-classes - Vec of class names. Defines a property's range classes * :classes - This is a map to configure classes where the keys are class names and the values are maps of datascript attributes e.g. `{:block/original-name \"Foo\"}`. Additional keys available: @@ -281,6 +289,17 @@ all-idents (create-all-idents properties classes graph-namespace) properties-tx (build-properties-tx properties uuid-maps all-idents) classes-tx (build-classes-tx classes uuid-maps all-idents) + class-ident->id (->> classes-tx (map (juxt :db/ident :db/id)) (into {})) + ;; Replace idents with db-ids to avoid any upsert issues + properties-tx' (mapv (fn [m] + (if (:property/schema.classes m) + (update m :property/schema.classes + (fn [cs] + (mapv #(or (some->> (:db/ident %) class-ident->id (hash-map :db/id)) + (throw (ex-info (str "No :db/id found for :db/ident " (pr-str (:db/ident %))) {}))) + cs))) + m)) + properties-tx) pages-and-blocks-tx (vec (mapcat @@ -310,7 +329,7 @@ blocks)))) pages-and-blocks'))] ;; Properties first b/c they have schema. Then pages b/c they can be referenced by blocks - (vec (concat properties-tx + (vec (concat properties-tx' classes-tx (filter :block/name pages-and-blocks-tx) (remove :block/name pages-and-blocks-tx))))) diff --git a/scripts/src/logseq/tasks/db_graph/create_graph_with_schema_org.cljs b/scripts/src/logseq/tasks/db_graph/create_graph_with_schema_org.cljs index 020e5d4c94..bff7df57e3 100644 --- a/scripts/src/logseq/tasks/db_graph/create_graph_with_schema_org.cljs +++ b/scripts/src/logseq/tasks/db_graph/create_graph_with_schema_org.cljs @@ -24,10 +24,6 @@ [babashka.cli :as cli] [logseq.db.frontend.malli-schema :as db-malli-schema])) -(defn- get-class-uuid [class-uuids class-id] - (or (class-uuids class-id) - (throw (ex-info (str "No :block/uuid for " class-id) {})))) - (defn- get-comment-string [rdfs-comment renamed-pages] (let [desc* (if (map? rdfs-comment) @@ -42,7 +38,7 @@ (defn- strip-schema-prefix [s] (string/replace-first s "schema:" "")) -(defn- ->class-page [class-m class-uuids class-properties {:keys [verbose renamed-classes renamed-pages]}] +(defn- ->class-page [class-m class-properties {:keys [verbose renamed-classes renamed-pages]}] (let [parent-class* (class-m "rdfs:subClassOf") parent-class (cond (map? parent-class*) @@ -67,7 +63,6 @@ url (str "https://schema.org/" (get inverted-renamed-classes class-name class-name))] (cond-> {:block/original-name class-name :block/type "class" - :block/uuid (get-class-uuid class-uuids (class-m "@id")) :properties (cond-> {:url url} (class-m "rdfs:comment") (assoc :description (get-comment-string (class-m "rdfs:comment") renamed-pages)))} @@ -102,7 +97,7 @@ (when (class-map %) :page)) range-includes)) -(defn- ->property-page [property-m class-map class-uuids {:keys [verbose renamed-pages renamed-properties]}] +(defn- ->property-page [property-m class-map {:keys [verbose renamed-pages renamed-properties]}] (let [range-includes (get-range-includes property-m) schema-type (get-schema-type range-includes class-map) ;; Pick first range to determine type as only one range is supported currently @@ -110,6 +105,12 @@ (println "Picked property type:" {:property (property-m "@id") :type schema-type :range-includes (vec range-includes)})) _ (assert schema-type (str "No schema found for property " (property-m "@id"))) + _ (when (= schema-type :page) + (when-let [datatype-classes (not-empty (set/intersection (set range-includes) + (set (keys schema->logseq-data-types))))] + (throw (ex-info (str "property " (pr-str (property-m "@id")) + " with type :page has DataType class values which aren't supported: " datatype-classes) {})))) + inverted-renamed-properties (set/map-invert renamed-properties) class-name (strip-schema-prefix (property-m "@id")) url (str "https://schema.org/" (get inverted-renamed-properties class-name class-name)) @@ -118,19 +119,12 @@ (= schema-type :page) (assoc :cardinality :many) (property-m "rdfs:comment") - (assoc :description (get-comment-string (property-m "rdfs:comment") renamed-pages)) - (= schema-type :page) - (assoc :classes (let [invalid-classes (remove class-uuids range-includes) - _ (when (seq invalid-classes) - (throw (ex-info (str "No uuids found for range(s): " invalid-classes) {}))) - datatype-classes (set/intersection (set range-includes) (set (keys schema->logseq-data-types))) - _ (when (seq datatype-classes) - (throw (ex-info (str "property " (pr-str (property-m "@id")) - " has DataType class values which aren't supported: " datatype-classes) {})))] - (set (map class-uuids range-includes)))))] + (assoc :description (get-comment-string (property-m "rdfs:comment") renamed-pages)))] {(keyword (strip-schema-prefix (property-m "@id"))) - {:block/schema schema - :properties {:url url}}})) + (cond-> {:block/schema schema + :properties {:url url}} + (= schema-type :page) + (assoc :schema-classes (map strip-schema-prefix range-includes)))})) (defn- get-class-to-properties "Given a vec of class ids and a vec of properties map to process, return a map of @@ -240,10 +234,10 @@ all-properties)) (defn- generate-classes - [select-classes class-uuids class-to-properties options] + [select-classes class-to-properties options] (let [classes (->> select-classes (map #(vector (strip-schema-prefix (get % "@id")) - (->class-page % class-uuids class-to-properties options))) + (->class-page % class-to-properties options))) (into {}))] (assert (= ["Thing"] (keep #(when-not (:class-parent %) (:block/original-name %)) @@ -252,7 +246,7 @@ classes)) (defn- generate-properties - [select-properties class-map class-uuids options] + [select-properties class-map options] (when (:verbose options) (println "Properties by type:" (->> select-properties @@ -261,8 +255,7 @@ frequencies) "\n")) (apply merge - (mapv #(->property-page % class-map class-uuids options) - select-properties))) + (mapv #(->property-page % class-map options) select-properties))) (defn- get-all-classes-and-properties "Get all classes and properties from raw json file" @@ -316,10 +309,6 @@ ["schema:Person" "schema:CreativeWorkSeries" "schema:Organization" "schema:Movie" "schema:CreativeWork" "schema:Thing"] (keys class-map)) - ;; Generate class uuids as they are needed for properties (:page) and pages - class-uuids (->> all-classes - (map #(vector (% "@id") (random-uuid))) - (into {})) class-to-properties (get-class-to-properties select-class-ids all-properties) select-properties (set (mapcat val class-to-properties)) options' (assoc options @@ -329,23 +318,20 @@ ;; Generate pages and properties properties (generate-properties (filter #(contains? select-properties (% "@id")) all-properties) - class-map class-uuids options') + class-map options') properties' (if (:subset options) ;; only keep classes that are in subset to keep graph valid - (let [select-class-uuids (->> select-class-ids (map class-uuids) set)] + (let [select-class-ids' (->> select-class-ids (map strip-schema-prefix) set)] (-> properties (update-vals (fn [m] - (let [classes (get-in m [:block/schema :classes])] - (if (seq classes) - (assoc m :property/schema.classes - (set (map (fn [id] [:block/uuid id]) - (filter #(contains? select-class-uuids %) classes)))) - m)))))) + (if (:schema-classes m) + (update m :schema-classes (fn [cs] (set (filterv #(contains? select-class-ids' %) cs)))) + m))))) properties) classes (generate-classes (map #(class-map %) select-class-ids) - class-uuids class-to-properties options')] + class-to-properties options')] {:graph-namespace :schema :classes classes :properties properties'})) @@ -365,30 +351,27 @@ (let [ents (remove #(db-malli-schema/internal-ident? (:db/ident %)) (d/q '[:find [(pull ?b [* {:class/schema.properties [:block/original-name]} + {:property/schema.classes [:block/original-name]} {:class/parent [:block/original-name]}]) ...] :in $ :where [?b :db/ident ?ident]] - db)) - block-uuid->name* (->> (d/q '[:find (pull ?b [:block/original-name :block/uuid]) :where [?b :block/original-name]] db) - (map first) - (map (juxt :block/uuid :block/original-name)) - (into {})) - block-uuid->name #(or (block-uuid->name* %) (throw (ex-info (str "No entity found for " %) {})))] + db))] (fs/writeFileSync "schema-org.edn" (pr-str (->> ents (map (fn [m] (let [props (db-property/properties m)] (cond-> (select-keys m [:block/name :block/type :block/original-name :block/schema :db/ident - :class/schema.properties :class/parent]) + :class/schema.properties :class/parent + :db/cardinality :property/schema.classes]) (seq props) (assoc :block/properties (update-keys props name)) (seq (:class/schema.properties m)) (update :class/schema.properties #(set (map :block/original-name %))) (some? (:class/parent m)) (update :class/parent :block/original-name) - (seq (get-in m [:block/schema :classes])) - (update-in [:block/schema :classes] #(set (map block-uuid->name %))))))) + (seq (:property/schema.classes m)) + (update :property/schema.classes #(set (map :block/original-name %))))))) set))))) (defn -main [args]