diff --git a/deps/graph-parser/src/logseq/graph_parser/exporter.cljs b/deps/graph-parser/src/logseq/graph_parser/exporter.cljs index 8b4870f53..108591e30 100644 --- a/deps/graph-parser/src/logseq/graph_parser/exporter.cljs +++ b/deps/graph-parser/src/logseq/graph_parser/exporter.cljs @@ -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 diff --git a/deps/graph-parser/test/logseq/graph_parser/exporter_test.cljs b/deps/graph-parser/test/logseq/graph_parser/exporter_test.cljs index bcee0e658..404519421 100644 --- a/deps/graph-parser/test/logseq/graph_parser/exporter_test.cljs +++ b/deps/graph-parser/test/logseq/graph_parser/exporter_test.cljs @@ -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"))) diff --git a/deps/graph-parser/test/resources/exporter-test-graph/pages/CreativeWork.md b/deps/graph-parser/test/resources/exporter-test-graph/pages/CreativeWork.md new file mode 100644 index 000000000..a356f3df9 --- /dev/null +++ b/deps/graph-parser/test/resources/exporter-test-graph/pages/CreativeWork.md @@ -0,0 +1,3 @@ +parent:: [[Thing]] + +- creative block \ No newline at end of file