Move delete-blocks-fn to graph-parser for reuse for nbb

Also:
- Move test to a more appropriate ns - model-test isn't for testing
  higher level parse file behavior
- Delete model fns that are no longer used
- Fix tests which had incorrect target-page-content and were no longer
  testing retractAttribute
- Add options to cli ns for related nbb reuse
- Light cleanup of block deletion

deps/graph-parser/.carve/ignore

@@ -32,3 +32,5 @@ logseq.graph-parser.property/->block-content
 logseq.graph-parser.property/property-value-from-content
 ;; API
 logseq.graph-parser.whiteboard/page-block->tldr-page
+;; API
+logseq.graph-parser/get-blocks-to-delete

deps/graph-parser/src/logseq/graph_parser.cljs

@@ -6,11 +6,77 @@
             [logseq.graph-parser.util :as gp-util]
             [logseq.graph-parser.date-time-util :as date-time-util]
             [logseq.graph-parser.config :as gp-config]
+            [logseq.db.schema :as db-schema]
             [clojure.string :as string]
             [clojure.set :as set]))
 
+(defn- retract-blocks-tx
+  [blocks retain-uuids]
+  (mapcat (fn [{uuid :block/uuid eid :db/id}]
+            (if (and uuid (contains? retain-uuids uuid))
+              (map (fn [attr] [:db.fn/retractAttribute eid attr]) db-schema/retract-attributes)
+              [[:db.fn/retractEntity eid]]))
+          blocks))
+
+(defn- get-file-page
+  "Copy of db/get-file-page. Too basic to couple to main app"
+  [db file-path]
+  (ffirst
+   (d/q
+    '[:find ?page-name
+      :in $ ?path
+      :where
+      [?file :file/path ?path]
+      [?page :block/file ?file]
+      [?page :block/original-name ?page-name]]
+    db
+    file-path)))
+
+(defn- get-page-blocks-no-cache
+  "Copy of db/get-page-blocks-no-cache. Too basic to couple to main app"
+  [db page {:keys [pull-keys]
+            :or {pull-keys '[*]}}]
+  (let [sanitized-page (gp-util/page-name-sanity-lc page)
+        page-id (:db/id (d/entity db [:block/name sanitized-page]))]
+    (when page-id
+      (let [datoms (d/datoms db :avet :block/page page-id)
+            block-eids (mapv :e datoms)]
+        (d/pull-many db pull-keys block-eids)))))
+
+(defn get-blocks-to-delete
+  "Returns the transactional operations to retract blocks belonging to the
+  given page name and file path. This function is required when a file is being
+  parsed from disk; before saving the parsed, blocks from the previous version
+  of that file need to be retracted.
+
+  The 'Page' parsed from the new file version is passed separately from the
+  file-path, as the page name can be set via properties in the file, and thus
+  can change between versions. If it has changed, existing blocks for both the
+  old and new page name will be retracted.
+
+  Blocks are by default fully cleared via retractEntity. However, a collection
+  of block UUIDs to retain can be passed, and any blocks with matching uuids
+  will instead have their attributes cleared individually via
+  'retractAttribute'. This will preserve block references to the retained
+  UUIDs."
+  [db file-page file-path retain-uuid-blocks]
+  (let [existing-file-page (get-file-page db file-path)
+        pages-to-clear (distinct (filter some? [existing-file-page (:block/name file-page)]))
+        blocks (mapcat (fn [page]
+                         (get-page-blocks-no-cache db page {:pull-keys [:db/id :block/uuid]}))
+                       pages-to-clear)
+        retain-uuids (set (keep :block/uuid retain-uuid-blocks))]
+    (retract-blocks-tx (distinct blocks) retain-uuids)))
+
 (defn parse-file
-  "Parse file and save parsed data to the given db. Main parse fn used by logseq app"
+  "Parse file and save parsed data to the given db. Main parse fn used by logseq app.
+Options available:
+
+* :new? - Boolean which indicates if this file already exists. Default is true.
+* :delete-blocks-fn - Optional fn which is called with the new page, file and existing block uuids
+  which may be referenced elsewhere.
+* :skip-db-transact? - Boolean which skips transacting in order to batch transactions. Default is false
+* :extract-options - Options map to pass to extract/extract"
   [conn file content {:keys [new? delete-blocks-fn extract-options skip-db-transact?]
                       :or {new? true
                            delete-blocks-fn (constantly [])
@@ -31,20 +97,20 @@
                       blocks []
                       ast []}}
               (cond (contains? gp-config/mldoc-support-formats format)
-                    (extract/extract file content extract-options')
+                (extract/extract file content extract-options')
 
-                    (gp-config/whiteboard? file)
-                    (extract/extract-whiteboard-edn file content extract-options')
+                (gp-config/whiteboard? file)
+                (extract/extract-whiteboard-edn file content extract-options')
 
-                    :else nil)
+                :else nil)
               block-ids (map (fn [block] {:block/uuid (:block/uuid block)}) blocks)
-              delete-blocks (delete-blocks-fn (first pages) file block-ids)
+              delete-blocks (delete-blocks-fn @conn (first pages) file block-ids)
               block-refs-ids (->> (mapcat :block/refs blocks)
                                   (filter (fn [ref] (and (vector? ref)
                                                          (= :block/uuid (first ref)))))
                                   (map (fn [ref] {:block/uuid (second ref)}))
                                   (seq))
-                   ;; To prevent "unique constraint" on datascript
+              ;; To prevent "unique constraint" on datascript
               block-ids (set/union (set block-ids) (set block-refs-ids))
               pages (extract/with-ref-pages pages blocks)
               pages-index (map #(select-keys % [:block/name]) pages)]

deps/graph-parser/src/logseq/graph_parser/cli.cljs

@@ -49,7 +49,8 @@ TODO: Fail fast when process exits 1"
     (mapv
      (fn [{:file/keys [path content]}]
        (let [{:keys [ast]}
-             (graph-parser/parse-file conn path content {:extract-options extract-options})]
+             (graph-parser/parse-file conn path content (merge {:extract-options extract-options}
+                                                               (:parse-file-options options)))]
          {:file path :ast ast}))
      files)))
 
@@ -59,12 +60,14 @@ TODO: Fail fast when process exits 1"
   as it can't assume that the metadata in logseq/ is up to date. Directory is
   assumed to be using git. This fn takes the following options:
 * :verbose - When enabled prints more information during parsing. Defaults to true
-* :files - Specific files to parse instead of parsing the whole directory"
+* :files - Specific files to parse instead of parsing the whole directory
+* :conn - Database connection to use instead of creating new one
+* :parse-file-options - Options map to pass to graph-parser/parse-file"
   ([dir]
    (parse-graph dir {}))
   ([dir options]
    (let [files (or (:files options) (build-graph-files dir))
-         conn (ldb/start-conn)
+         conn (or (:conn options) (ldb/start-conn))
          config (read-config dir)
         _ (when-not (:files options) (println "Parsing" (count files) "files..."))
          asts (parse-files conn files (merge options {:config config}))]

deps/graph-parser/test/logseq/graph_parser_test.cljs

@@ -74,7 +74,7 @@
                                                         (throw (js/Error "Testing unexpected failure")))]
         (try
           (graph-parser/parse-file conn "foo.md" "- id:: 628953c1-8d75-49fe-a648-f4c612109098"
-                                   {:delete-blocks-fn (fn [page _file]
+                                   {:delete-blocks-fn (fn [_db page _file _uuids]
                                                         (reset! deleted-page page))})
           (catch :default _)))
       (is (= nil @deleted-page)

src/main/frontend/db.cljs

@@ -38,13 +38,13 @@
 
  [frontend.db.model
   blocks-count blocks-count-cache clean-export! delete-blocks get-pre-block
-  delete-file-blocks! delete-page-blocks delete-files delete-pages-by-files
+  delete-files delete-pages-by-files
   filter-only-public-pages-and-blocks get-all-block-contents get-all-tagged-pages
   get-all-templates get-block-and-children get-block-by-uuid get-block-children sort-by-left
   get-block-parent get-block-parents parents-collapsed? get-block-referenced-blocks get-all-referenced-blocks-uuid
   get-block-children-ids get-block-immediate-children get-block-page
   get-custom-css get-date-scheduled-or-deadlines
-  get-file-blocks get-file-last-modified-at get-file get-file-page get-file-page-id file-exists?
+  get-file-last-modified-at get-file get-file-page get-file-page-id file-exists?
   get-files get-files-blocks get-files-full get-journals-length get-pages-with-file
   get-latest-journals get-page get-page-alias get-page-alias-names get-paginated-blocks
   get-page-blocks-count get-page-blocks-no-cache get-page-file get-page-format get-page-properties

src/main/frontend/db/model.cljs

@@ -212,17 +212,6 @@
              (conn/get-db repo-url) pred)
         db-utils/seq-flatten)))
 
-(defn get-file-blocks
-  [repo-url path]
-  (-> (d/q '[:find ?block
-             :in $ ?path
-             :where
-             [?file :file/path ?path]
-             [?p :block/file ?file]
-             [?block :block/page ?p]]
-           (conn/get-db repo-url) path)
-      db-utils/seq-flatten))
-
 (defn set-file-last-modified-at!
   [repo path last-modified-at]
   (when (and repo path last-modified-at)
@@ -1538,21 +1527,6 @@
   [files]
   (mapv (fn [path] [:db.fn/retractEntity [:file/path path]]) files))
 
-(defn delete-file-blocks!
-  [repo-url path]
-  (let [blocks (get-file-blocks repo-url path)]
-    (mapv (fn [eid] [:db.fn/retractEntity eid]) blocks)))
-
-(defn delete-page-blocks
-  [repo-url page]
-  (when page
-    (when-let [db (conn/get-db repo-url)]
-      (let [page (db-utils/pull [:block/name (util/page-name-sanity-lc page)])]
-        (when page
-          (let [datoms (d/datoms db :avet :block/page (:db/id page))
-                block-eids (mapv :e datoms)]
-            (mapv (fn [eid] [:db.fn/retractEntity eid]) block-eids)))))))
-
 (defn delete-pages-by-files
   [files]
   (let [pages (->> (mapv get-file-page files)

src/main/frontend/handler/common/file.cljs

@@ -6,7 +6,6 @@
             [frontend.db :as db]
             ["/frontend/utils" :as utils]
             [frontend.mobile.util :as mobile-util]
-            [logseq.db.schema :as db-schema]
             [logseq.graph-parser :as graph-parser]
             [logseq.graph-parser.util :as gp-util]
             [logseq.graph-parser.config :as gp-config]
@@ -20,49 +19,20 @@
       (when (not= file current-file)
         current-file))))
 
-(defn- retract-blocks-tx
-  [blocks retain-uuids]
-  (let [tx-for-block (fn [block] (let [{uuid :block/uuid eid :db/id} block
-                                       should-retain? (and uuid (contains? retain-uuids uuid))]
-                                   (cond
-                                     should-retain?
-                                     (map (fn [attr] [:db.fn/retractAttribute eid attr]) db-schema/retract-attributes)
-                                     :else
-                                     [[:db.fn/retractEntity eid]])))]
-    (mapcat tx-for-block (distinct blocks)))
-  )
+(defn- validate-existing-file
+  [repo-url file-page file-path]
+  (when-let [current-file (page-exists-in-another-file repo-url file-page file-path)]
+    (when (not= file-path current-file)
+      (let [error (str "Page already exists with another file: " current-file ", current file: " file-path ". Please keep only one of them and re-index your graph.")]
+        (state/pub-event! [:notification/show
+                           {:content error
+                            :status :error
+                            :clear? false}])))))
 
-(defn- retract-file-blocks-tx
-  "Returns the transactional operations to retract blocks belonging to the
-  given page name and file path. This function is required when a file is being
-  parsed from disk; before saving the parsed, blocks from the previous version
-  of that file need to be retracted.
-
-  The 'Page' parsed from the new file version is passed separately from the
-  file-path, as the page name can be set via properties in the file, and thus
-  can change between versions. If it has changed, existing blocks for both the
-  old and new page name will be retracted.
-
-  Blocks are by default fully cleared via retractEntity. However, a collection
-  of block UUIDs to retain can be passed, and any blocks with matching uuids
-  will instead have their attributes cleared individually via
-  'retractAttribute'. This will preserve block references to the retained
-  UUIDs."
-  [repo-url file-page file-path retain-uuid-blocks]
-  (let [existing-file-page (db/get-file-page file-path)
-        pages-to-clear (distinct (filter some? [existing-file-page (:block/name file-page)]))
-        blocks (mapcat (fn [page] (db/get-page-blocks-no-cache repo-url page {:pull-keys [:db/id :block/uuid]})) pages-to-clear)
-        retain-uuids (if (seq retain-uuid-blocks) (set (filter some? (map :block/uuid retain-uuid-blocks))) [])
-        tx (retract-blocks-tx blocks retain-uuids)]
-    (when-let [current-file (page-exists-in-another-file repo-url file-page file-path)]
-      (when (not= file-path current-file)
-        (let [error (str "Page already exists with another file: " current-file ", current file: " file-path ". Please keep only one of them and re-index your graph.")]
-          (state/pub-event! [:notification/show
-                             {:content error
-                              :status :error
-                              :clear? false}]))))
-    tx
-    ))
+(defn- validate-and-get-blocks-to-delete
+  [repo-url db file-page file-path retain-uuid-blocks]
+  (validate-existing-file repo-url file-page file-path)
+  (graph-parser/get-blocks-to-delete db file-page file-path retain-uuid-blocks))
 
 (defn reset-file!
   "Main fn for updating a db with the results of a parsed file"
@@ -92,7 +62,7 @@
          new? (nil? (db/entity [:file/path file]))
          options (merge (dissoc options :verbose)
                         {:new? new?
-                         :delete-blocks-fn (partial retract-file-blocks-tx repo-url)
+                         :delete-blocks-fn (partial validate-and-get-blocks-to-delete repo-url)
                          :extract-options (merge
                                            {:user-config (state/get-config)
                                             :date-formatter (state/get-date-formatter)

src/test/frontend/db/model_test.cljs

@@ -1,9 +1,7 @@
 (ns frontend.db.model-test
-  (:require [cljs.test :refer [use-fixtures deftest testing is are]]
+  (:require [cljs.test :refer [use-fixtures deftest is are]]
             [frontend.db.model :as model]
-            [frontend.test.helper :as test-helper :refer [load-test-files]]
-            [logseq.graph-parser.util.block-ref :as block-ref]
-            ))
+            [frontend.test.helper :as test-helper :refer [load-test-files]]))
 
 (use-fixtures :each {:before test-helper/start-test-db!
                      :after test-helper/destroy-test-db!})
@@ -123,45 +121,4 @@
          (#'model/get-unnecessary-namespaces-name '("one/two/tree" "one" "one/two" "non nested tag" "non nested link")))
       "Must be  one/two one"))
 
-(deftest refs-to-page-maintained-on-reload
-  (testing 
-    "Refs to blocks on a page are retained if that page is reload."
-    (let [ test-uuid "16c90195-6a03-4b3f-839d-095a496d9acd"
-          target-page-content (str "- target block\n  id:: " (block-ref/->block-ref test-uuid))
-          referring-page-content (str "- " (block-ref/->block-ref test-uuid))]
-      (load-test-files [{:file/path "pages/target.md"
-                         :file/content target-page-content}
-                        {:file/path "pages/referrer.md"
-                         :file/content referring-page-content}])
-      (is (= (model/get-all-referenced-blocks-uuid) [(parse-uuid test-uuid)]))
-      (load-test-files [{:file/path "pages/target.md"
-                         :file/content target-page-content}])
-      (is (= (model/get-all-referenced-blocks-uuid) [(parse-uuid test-uuid)]))
-      )))
-
-(deftest reload-file-with-page-rename
-  (testing 
-    "Reload a file when the disk contents result in the file having a new page name."
-    (let [ test-uuid "16c90195-6a03-4b3f-839d-095a496d9efc"
-          target-page-content (str "- target block\n  id:: " (block-ref/->block-ref test-uuid))
-          referring-page-content (str "- " (block-ref/->block-ref test-uuid))
-          update-referring-page-content (str "title:: updatedPage\n- " (block-ref/->block-ref test-uuid))
-          get-page-block-count (fn [page-name] (let [page-id (:db/id (model/get-page page-name))]
-                                                 (if (some? page-id)
-                                                   (model/get-page-blocks-count test-helper/test-db page-id)
-                                                   0)))]
-      (load-test-files [{:file/path "pages/target.md"
-                         :file/content target-page-content}
-                        {:file/path "pages/referrer.md"
-                         :file/content referring-page-content}])
-      (is (= [(parse-uuid test-uuid)] (model/get-all-referenced-blocks-uuid)))
-      (is (= 1 (get-page-block-count "referrer")))
-      (is (= 0 (get-page-block-count "updatedPage")))
-      (load-test-files [{:file/path "pages/referrer.md"
-                         :file/content update-referring-page-content}])
-      (is (= (model/get-all-referenced-blocks-uuid) [(parse-uuid test-uuid)]))
-      (is (= 0 (get-page-block-count "referrer")))
-      (is (= 2 (get-page-block-count "updatedPage")))
-      )))
-
 #_(cljs.test/test-ns 'frontend.db.model-test)

src/test/frontend/extensions/zotero/extractor_test.cljs

@@ -43,7 +43,6 @@
         (is (= 8 authors)))
 
       (testing "tags"
-        (prn (-> properties :tags))
         ;; tags split by `,` are counted into different tags
         ;; https://github.com/logseq/logseq/commit/435c2110bcc2d30ed743ba31375450f1a705b00b
         (is (= 20 tags)))))

src/test/frontend/handler/repo_test.cljs

@@ -1,9 +1,11 @@
 (ns frontend.handler.repo-test
-  (:require [cljs.test :refer [deftest use-fixtures]]
+  (:require [cljs.test :refer [deftest use-fixtures testing is]]
             [frontend.handler.repo :as repo-handler]
-            [frontend.test.helper :as test-helper]
+            [frontend.test.helper :as test-helper :refer [load-test-files]]
             [logseq.graph-parser.cli :as gp-cli]
             [logseq.graph-parser.test.docs-graph-helper :as docs-graph-helper]
+            [logseq.graph-parser.util.block-ref :as block-ref]
+            [frontend.db.model :as model]
             [frontend.db.conn :as conn]))
 
 (use-fixtures :each {:before test-helper/start-test-db!
@@ -19,3 +21,44 @@
         db (conn/get-db test-helper/test-db)]
 
     (docs-graph-helper/docs-graph-assertions db (map :file/path files))))
+
+(deftest parse-files-and-load-to-db-with-block-refs-on-reload
+  (testing "Refs to blocks on a page are retained if that page is reloaded"
+    (let [test-uuid "16c90195-6a03-4b3f-839d-095a496d9acd"
+          target-page-content (str "- target block\n  id:: " test-uuid)
+          referring-page-content (str "- " (block-ref/->block-ref test-uuid))]
+      (load-test-files [{:file/path "pages/target.md"
+                         :file/content target-page-content}
+                        {:file/path "pages/referrer.md"
+                         :file/content referring-page-content}])
+      (is (= [(parse-uuid test-uuid)] (model/get-all-referenced-blocks-uuid)))
+
+      (load-test-files [{:file/path "pages/target.md"
+                         :file/content target-page-content}])
+      (is (= [(parse-uuid test-uuid)] (model/get-all-referenced-blocks-uuid))))))
+
+(deftest parse-files-and-load-to-db-with-page-rename
+  (testing
+    "Reload a file when the disk contents result in the file having a new page name"
+    (let [test-uuid "16c90195-6a03-4b3f-839d-095a496d9efc"
+          target-page-content (str "- target block\n  id:: " test-uuid)
+          referring-page-content (str "- " (block-ref/->block-ref test-uuid))
+          update-referring-page-content (str "title:: updatedPage\n- " (block-ref/->block-ref test-uuid))
+          get-page-block-count (fn [page-name]
+                                 (let [page-id (:db/id (model/get-page page-name))]
+                                   (if (some? page-id)
+                                     (model/get-page-blocks-count test-helper/test-db page-id)
+                                     0)))]
+      (load-test-files [{:file/path "pages/target.md"
+                         :file/content target-page-content}
+                        {:file/path "pages/referrer.md"
+                         :file/content referring-page-content}])
+      (is (= [(parse-uuid test-uuid)] (model/get-all-referenced-blocks-uuid)))
+      (is (= 1 (get-page-block-count "referrer")))
+      (is (= 0 (get-page-block-count "updatedPage")))
+
+      (load-test-files [{:file/path "pages/referrer.md"
+                         :file/content update-referring-page-content}])
+      (is (= [(parse-uuid test-uuid)] (model/get-all-referenced-blocks-uuid)))
+      (is (= 0 (get-page-block-count "referrer")))
+      (is (= 2 (get-page-block-count "updatedPage"))))))