fix: db import with property-parent-classes option

Also fixes some bugs with docs graph having classes split into more than
one db/ident. Part of LOG-3176
pull/11433/head
Gabriel Horner 2024-07-24 14:55:06 -04:00
parent c0c443be0a
commit 3411f344e3
3 changed files with 61 additions and 29 deletions

View File

@ -43,15 +43,21 @@
(assoc :block/created-at updated-at))]
block))
(defn- find-or-create-class
[db class-name all-idents]
(if-let [db-ident (get @all-idents (keyword class-name))]
{:db/ident db-ident}
(let [m (db-class/build-new-class db {:block/original-name class-name
:block/name (common-util/page-name-sanity-lc class-name)})]
(swap! all-idents assoc (keyword class-name) (:db/ident m))
m)))
(defn- convert-tag-to-class
"Converts a tag block with class or returns nil if this tag should be removed
because it has been moved"
[db tag-block page-names-to-uuids tag-classes]
[db tag-block page-names-to-uuids tag-classes all-idents]
(if-let [new-class (:block.temp/new-class tag-block)]
(merge (db-class/build-new-class
db
{:block/original-name new-class
:block/name (common-util/page-name-sanity-lc new-class)})
(merge (find-or-create-class db new-class all-idents)
(when-let [existing-tag-uuid (get page-names-to-uuids (common-util/page-name-sanity-lc new-class))]
{:block/uuid existing-tag-uuid}))
(when (contains? tag-classes (:block/name tag-block))
@ -63,7 +69,8 @@
(:block/name tag-block)))]
[:block/uuid existing-tag-uuid]
;; Creates or updates page within same tx
(-> (db-class/build-new-class db tag-block)
(-> (merge tag-block
(find-or-create-class db (:block/original-name tag-block) all-idents))
;; override with imported timestamps
(dissoc :block/created-at :block/updated-at)
(merge (add-missing-timestamps
@ -75,7 +82,7 @@
{:page-name page-name}))))
(defn- update-page-tags
[block db tag-classes page-names-to-uuids]
[block db tag-classes page-names-to-uuids all-idents]
(if (seq (:block/tags block))
(let [page-tags (->> (:block/tags block)
(remove #(or (:block.temp/new-class %) (contains? tag-classes (:block/name %))))
@ -85,7 +92,7 @@
true
(update :block/tags
(fn [tags]
(keep #(convert-tag-to-class db % page-names-to-uuids tag-classes) tags)))
(keep #(convert-tag-to-class db % page-names-to-uuids tag-classes all-idents) tags)))
(seq page-tags)
(merge {:logseq.property/page-tags page-tags})))
block))
@ -107,7 +114,7 @@
(string/trim)))
(defn- update-block-tags
[block db tag-classes page-names-to-uuids]
[block db tag-classes page-names-to-uuids all-idents]
(if (seq (:block/tags block))
(let [original-tags (remove :block.temp/new-class (:block/tags block))]
(-> block
@ -123,7 +130,7 @@
(map #(add-uuid-to-page-map % page-names-to-uuids))))
(update :block/tags
(fn [tags]
(keep #(convert-tag-to-class db % page-names-to-uuids tag-classes) tags)))))
(keep #(convert-tag-to-class db % page-names-to-uuids tag-classes all-idents) tags)))))
block))
(defn- update-block-marker
@ -527,7 +534,7 @@
(defn- handle-page-properties
[{:block/keys [properties] :as block*} db page-names-to-uuids refs
{:keys [property-parent-classes log-fn] :as options}]
{:keys [property-parent-classes log-fn import-state] :as options}]
(let [{:keys [block properties-tx]} (handle-page-and-block-properties block* db page-names-to-uuids refs options)
block'
(if (seq properties)
@ -536,16 +543,16 @@
distinct)]
(cond-> block
(seq parent-classes-from-properties)
(assoc :block/type "class")
(merge (find-or-create-class db (:block/original-name block) (:all-idents import-state)))
(seq parent-classes-from-properties)
(assoc :class/parent
(let [new-class (first parent-classes-from-properties)]
(when (> (count parent-classes-from-properties) 1)
(log-fn :skipped-parent-classes "Only one parent class is allowed so skipped ones after the first one" :classes parent-classes-from-properties))
(sqlite-util/build-new-class
{:block/original-name new-class
:block/uuid (or (get-pid db new-class) (d/squuid))
:block/name (common-util/page-name-sanity-lc new-class)})))))
(merge (find-or-create-class db new-class (:all-idents import-state))
(if-let [existing-tag-uuid (get page-names-to-uuids (common-util/page-name-sanity-lc new-class))]
{:block/uuid existing-tag-uuid}
{:block/uuid (d/squuid)}))))))
(dissoc block* :block/properties))]
{:block block' :properties-tx properties-tx}))
@ -614,7 +621,7 @@
(assoc :block/parent {:block/uuid (get-page-uuid page-names-to-uuids (:block/name (:block/parent block)))})))
(defn- build-block-tx
[db block* pre-blocks page-names-to-uuids {:keys [tag-classes] :as options}]
[db block* pre-blocks page-names-to-uuids {:keys [tag-classes import-state] :as options}]
;; (prn ::block-in block)
(let [;; needs to come before update-block-refs to detect new property schemas
{:keys [block properties-tx]}
@ -624,7 +631,7 @@
(fix-pre-block-references pre-blocks page-names-to-uuids)
(fix-block-name-lookup-ref page-names-to-uuids)
(update-block-refs page-names-to-uuids options)
(update-block-tags db tag-classes page-names-to-uuids)
(update-block-tags db tag-classes page-names-to-uuids (:all-idents import-state))
(update-block-marker options)
(update-block-priority options)
add-missing-timestamps
@ -643,7 +650,7 @@
aliases))))
(defn- build-new-page
[m db tag-classes page-names-to-uuids]
[m db tag-classes page-names-to-uuids all-idents]
(-> (cond-> m
;; Fix pages missing :block/original-name. Shouldn't happen
(not (:block/original-name m))
@ -654,13 +661,13 @@
;; TODO: org-mode content needs to be handled
(assoc :block/format :markdown)
(dissoc :block/whiteboard?)
(update-page-tags db tag-classes page-names-to-uuids)))
(update-page-tags db tag-classes page-names-to-uuids all-idents)))
(defn- build-pages-tx
"Given all the pages and blocks parsed from a file, return a map containing
all non-whiteboard pages to be transacted, pages' properties and additional
data for subsequent steps"
[conn pages blocks {:keys [tag-classes property-classes property-parent-classes notify-user]
[conn pages blocks {:keys [tag-classes property-classes property-parent-classes notify-user import-state]
:as options}]
(let [all-pages (->> (extract/with-ref-pages pages blocks)
;; remove unused property pages unless the page has content
@ -680,7 +687,7 @@
(let [;; These attributes are not allowed to be transacted because they must not change across files
disallowed-attributes [:block/name :block/uuid :block/format :block/original-name :block/journal-day
:block/created-at :block/updated-at]
allowed-attributes (into [:block/tags :block/alias :class/parent :block/type]
allowed-attributes (into [:block/tags :block/alias :class/parent :block/type :db/ident]
(keep #(when (db-malli-schema/user-property? (key %)) (key %))
m))
block-changes (select-keys m allowed-attributes)]
@ -692,8 +699,8 @@
(seq (:block/alias m))
(update-page-alias page-names-to-uuids)
(:block/tags m)
(update-page-tags @conn tag-classes page-names-to-uuids))))
(build-new-page m @conn tag-classes page-names-to-uuids)))
(update-page-tags @conn tag-classes page-names-to-uuids (:all-idents import-state)))))
(build-new-page m @conn tag-classes page-names-to-uuids (:all-idents import-state))))
(map :block all-pages-m))]
{:pages-tx pages-tx
:page-properties-tx (mapcat :properties-tx all-pages-m)
@ -897,7 +904,7 @@
;; uuids to be valid. Also upstream-properties-tx comes after blocks-tx to possibly override blocks
tx (concat whiteboard-pages pages-index page-properties-tx property-page-properties-tx pages-tx' blocks-index blocks-tx)
tx' (common-util/fast-remove-nils tx)
;; _ (cljs.pprint/pprint {:tx tx'})
;; _ (when (not (seq whiteboard-pages)) (cljs.pprint/pprint {:tx tx'}))
main-tx-report (d/transact! conn tx')
upstream-properties-tx

View File

@ -162,7 +162,7 @@
(is (= 16 (count (d/q '[:find ?b :where [?b :block/type "journal"]] @conn))))
;; Don't count pages like url.md that have properties but no content
(is (= 5
(is (= 6
(count (->> (d/q '[:find [(pull ?b [:block/original-name :block/type]) ...]
:where [?b :block/original-name] [_ :block/page ?b]] @conn)
(filter #(= ["page"] (:block/type %))))))
@ -356,7 +356,7 @@
(:logseq.property/page-tags (readable-properties @conn (find-page-by-name @conn "chat-gpt"))))
"tagged page has new page and other pages marked with '#' and '[[]]` imported as tags to page-tags")))))
(deftest-async export-file-with-tag-classes-option
(deftest-async export-files-with-tag-classes-option
(p/let [file-graph-dir "test/resources/exporter-test-graph"
files (mapv #(node-path/join file-graph-dir %) ["journals/2024_02_07.md" "pages/Interstellar.md"])
conn (d/create-conn db-schema/schema-for-db-based-graph)
@ -384,7 +384,7 @@
(readable-properties @conn (find-page-by-name @conn "Interstellar")))
"tagged page has configured tag imported as a class"))))
(deftest-async export-file-with-property-classes-option
(deftest-async export-files-with-property-classes-option
(p/let [file-graph-dir "test/resources/exporter-test-graph"
files (mapv #(node-path/join file-graph-dir %) ["journals/2024_02_23.md" "pages/url.md"])
conn (d/create-conn db-schema/schema-for-db-based-graph)
@ -429,7 +429,7 @@
(:block/tags (readable-properties @conn (find-page-by-name @conn "url"))))
"tagged page has configured tag imported as a class"))))
(deftest-async export-file-with-ignored-properties
(deftest-async export-files-with-ignored-properties
(p/let [file-graph-dir "test/resources/exporter-test-graph"
files (mapv #(node-path/join file-graph-dir %) ["ignored/icon-page.md"])
conn (d/create-conn db-schema/schema-for-db-based-graph)
@ -438,3 +438,25 @@
(is (= 2
(count (filter #(= :icon (:property %)) @(:ignored-properties import-state))))
"icon properties are visibly ignored in order to not fail import")))
(deftest-async export-files-with-property-parent-classes-option
(p/let [file-graph-dir "test/resources/exporter-test-graph"
files (mapv #(node-path/join file-graph-dir %) ["pages/CreativeWork.md" "pages/Movie.md"])
conn (d/create-conn db-schema/schema-for-db-based-graph)
_ (d/transact! conn (sqlite-create-graph/build-db-initial-data "{}"))
_ (import-files-to-db files conn {:property-parent-classes ["parent"]})]
(is (empty? (map :entity (:errors (db-validate/validate-db! @conn))))
"Created graph has no validation errors")
(is (= #{:user.class/Movie :user.class/CreativeWork :user.class/Thing}
(->> @conn
(d/q '[:find [?ident ...]
:where [?b :block/type "class"] [?b :db/ident ?ident] (not [?b :logseq.property/built-in?])])
set))
"All classes are correctly defined by :type")
(is (= "CreativeWork" (get-in (d/entity @conn :user.class/Movie) [:class/parent :block/original-name]))
"Existing page correctly set as class parent")
(is (= "Thing" (get-in (d/entity @conn :user.class/CreativeWork) [:class/parent :block/original-name]))
"New page correctly set as class parent")))

View File

@ -0,0 +1,3 @@
parent:: [[Thing]]
- creative block