wip add more tests

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

@@ -41,7 +41,7 @@
 
               ;; File can be saved as plain edn (mostly, the whiteboard files)
               (= format :edn)
-              (gp-util/safe-read-string content)
+              (extract/extract-whiteboard-edn file content extract-options')
 
               :else nil)
 

deps/graph-parser/src/logseq/graph_parser/extract.cljc

@@ -15,6 +15,15 @@
             #?(:org.babashka/nbb [logseq.graph-parser.log :as log]
                :default [lambdaisland.glogi :as log])))
 
+(defn- filepath->page-name
+  [filepath]
+  (when-let [file-name (last (string/split filepath #"/"))]
+    (let [result (first (gp-util/split-last "." file-name))
+          ext (string/lower-case (gp-util/get-file-ext filepath))]
+      (if (or (gp-config/mldoc-support? ext) (= "edn" ext))
+        (js/decodeURIComponent (string/replace result "." "/"))
+        result))))
+
 (defn- get-page-name
   [file ast page-name-order]
   ;; headline
@@ -29,11 +38,7 @@
                                (and first-block
                                     (string? title)
                                     title))
-            file-name (when-let [file-name (last (string/split file #"/"))]
-                        (let [result (first (gp-util/split-last "." file-name))]
-                          (if (gp-config/mldoc-support? (string/lower-case (gp-util/get-file-ext file)))
-                            (js/decodeURIComponent (string/replace result "." "/"))
-                            result)))]
+            file-name (filepath->page-name file)]
         (or property-name
             (if (= page-name-order "heading")
               (or first-block-name file-name)
@@ -78,9 +83,6 @@
       (seq aliases)
       (assoc :block/alias aliases)
 
-      (gp-config/whiteboard? file)
-      (assoc :block/whiteboard? true)
-
       (:tags properties)
       (assoc :block/tags (let [tags (:tags properties)
                                tags (if (string? tags) [tags] tags)
@@ -176,6 +178,25 @@
          :blocks blocks
          :ast ast}))))
 
+(defn extract-whiteboard-edn
+  "Extracts whiteboard page from given edn file
+   Whiteboard page edn is a subset of page schema
+   - it will only contain a single page (for now). The page properties contains 'bindings' etc
+   - blocks will be adapted to tldraw shapes. All blocks's parent is the given page."
+  [file content {:keys [verbose] :or {verbose true} :as options}]
+  (let [_ (when verbose (println "Parsing start: " file))
+        {:keys [pages blocks]} (gp-util/safe-read-string content)
+        page-block (first pages)]
+    (when (:block/whiteboard? page-block)
+      (let [page-name (filepath->page-name file)
+            page-entity (build-page-entity {} file page-name page-name nil options)
+            page-block (merge page-block page-entity {:block/uuid (d/squuid)})
+            blocks (->> blocks
+                        (map #(assoc % :block/level 1))
+                        (gp-block/with-parent-and-left {:block/name page-name}))]
+        {:pages [page-block]
+         :blocks blocks}))))
+
 (defn- with-block-uuid
   [pages]
   (->> (gp-util/distinct-by :block/name pages)

deps/graph-parser/test/logseq/graph_parser/extract_test.cljs

@@ -49,3 +49,23 @@
     - line2
       - line3
      - line4"))))
+
+(def foo-edn
+  "Example exported whiteboard page as an edn exportable."
+  '{:blocks
+    [{:block/content "foo content",
+      :block/format :markdown,
+      :block/unordered true}],
+    :pages
+    ({:block/format :markdown,
+      :block/whiteboard? true,
+      :block/original-name "my foo whiteboard"})})
+
+(deftest test-extract-whiteboard-edn
+  []
+  (let [{:keys [pages blocks]} (extract/extract-whiteboard-edn "foo.edn" (pr-str foo-edn) {})
+        page (first pages)]
+    (is (= (get-in page [:block/file :file/path]) "foo.edn"))
+    (is (= (get-in page [:block/name]) "foo"))
+    (is (every? #(and (= (:block/left %) {:block/name "foo"})
+                      (= (:block/parent %) {:block/name "foo"})) blocks))))

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

@@ -5,6 +5,17 @@
             [logseq.graph-parser.block :as gp-block]
             [datascript.core :as d]))
 
+(def foo-edn
+  "Example exported whiteboard page as an edn exportable."
+  '{:blocks
+    [{:block/content "foo content",
+      :block/format :markdown,
+      :block/unordered true}],
+    :pages
+    ({:block/format :markdown,
+      :block/whiteboard? true,
+      :block/original-name "my foo whiteboard"})})
+
 (deftest parse-file
   (testing "id properties"
     (let [conn (ldb/start-conn)]
@@ -33,11 +44,26 @@
     (let [conn (ldb/start-conn)
           deleted-page (atom nil)]
       (with-redefs [gp-block/with-pre-block-if-exists (fn stub-failure [& _args]
-                                              (throw (js/Error "Testing unexpected failure")))]
+                                                        (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]
-                                                       (reset! deleted-page page))})
+                                   {:delete-blocks-fn (fn [page _file]
+                                                        (reset! deleted-page page))})
           (catch :default _)))
       (is (= nil @deleted-page)
-          "Page should not be deleted when there is unexpected failure"))))
+          "Page should not be deleted when there is unexpected failure")))
+
+  (testing "parsing whiteboard page"
+    (let [conn (ldb/start-conn)]
+      (graph-parser/parse-file conn "foo.edn" (pr-str foo-edn) {})
+      (is (= {:block/name "foo" :block/file {:file/path "foo.edn"}}
+             (let [blocks (d/q '[:find (pull ?b [* {:block/parent
+                                                    [:block/name
+                                                     {:block/file
+                                                      [:file/path]}]}])
+                                 :in $
+                                 :where [?b :block/content] [(missing? $ ?b :block/name)]]
+                               @conn)
+                   parent (:block/parent (ffirst blocks))]
+               parent))
+          "parsed block in the whiteboard page has correct parent page"))))

package.json

@@ -63,7 +63,8 @@
         "cljs:report": "clojure -M:cljs run shadow.cljs.build-report app report.html",
         "cljs:build-electron": "clojure -A:cljs compile app electron",
         "cljs:lint": "clojure -M:clj-kondo --parallel --lint src --cache false",
-        "tldraw:build": "cd tldraw && yarn build"
+        "tldraw:build": "cd tldraw && yarn build",
+        "postinstall": "yarn tldraw:build"
     },
     "dependencies": {
         "@capacitor/android": "3.2.2",

src/main/frontend/handler/whiteboard.cljs

@@ -1,9 +1,6 @@
 (ns frontend.handler.whiteboard
   (:require [frontend.state :as state]
-            [clojure.string :as string]
-            [frontend.db :as db]
-            [frontend.db.model :as model]
-            [goog.object :as gobj]))
+            [clojure.string :as string]))
 
 ;; FIXME: embed /draw should be supported too
 (defn whiteboard-mode?
@@ -29,49 +26,4 @@
                               [{:id (.-id fs)
                                 :logseqLink page-or-block-id}])))))))
 
-(defn- get-page-block [page-name]
-  (db/pull '[*] (:db/id (model/get-page page-name))))
-
-(defn- block->shape [block]
-  (let [properties (:block/properties block)]
-    (merge properties
-           ;; Use the block's id as the shape's id.
-           {:id (str (:block/uuid block))})))
-
-(defn- shape->block [blocks-by-uuid shape]
-  (let [properties shape
-        block (get blocks-by-uuid (:id shape))]
-    (merge block
-           {:properties properties})))
-
-(defn get-whiteboard-cjs [page-name]
-  (let [page-block (get-page-block page-name)
-        blocks (model/get-page-blocks-no-cache page-name)]
-    [page-block blocks]))
-
-(defn whiteboard-cjs->tldr [page-block blocks]
-  (let [shapes (map block->shape blocks)
-        page-name (:block/name page-block)
-        page-properties (:block/properties page-block)]
-    (clj->js {:currentPageId page-name
-              :pages [(merge page-properties
-                             {:id "page"
-                              :name "page"
-                              :shapes shapes})]})))
-
-(defn page-name->tldr [page-name]
-  (let [[page-block blocks] (get-whiteboard-cjs page-name)]
-    (whiteboard-cjs->tldr page-block blocks)))
-
-(defn transact-tldr! [page-name tldr]
-  (let [[page-block blocks] (get-whiteboard-cjs page-name)
-        {:keys [pages]} (js->clj tldr)
-        page (first pages) ;; should only contain one page
-        shapes (:shapes page)
-        blocks-by-uuid (reduce (fn [acc shape]
-                                 (assoc (:id shape) shape acc))
-                               blocks {})
-        blocks (map #(shape->block blocks-by-uuid %) shapes)]
-    [page-block blocks]))
-
 ;; (set! (. js/window -foo) (page-name->tldr "edn-test"))

src/main/frontend/modules/file/core.cljs

@@ -142,7 +142,7 @@
         (db/transact! tx)
         (when ok-handler (ok-handler))))))
 
-(defn- remove-db-id [block] (dissoc block :db/id))
+(defn- remove-transit-ids [block] (dissoc block :db/id :block/file))
 
 (defn save-tree-aux!
   [page-block tree]
@@ -150,8 +150,8 @@
         file-path (get-in page-block [:block/file :file/path])
         edn? (string/ends-with? file-path ".edn")
         new-content (if edn?
-                      (util/pp-str {:blocks (map remove-db-id tree)
-                                    :pages (list (remove-db-id page-block))})
+                      (util/pp-str {:blocks (map remove-transit-ids tree)
+                                    :pages (list (remove-transit-ids page-block))})
                       (tree->file-content tree {:init-level init-level}))
         _ (assert (string? file-path) "File path should satisfy string?")
         ;; FIXME: name conflicts between multiple graphs

src/main/frontend/modules/outliner/whiteboard.cljs

@@ -1 +0,0 @@
-(ns frontend.modules.outliner.whiteboard)

src/main/frontend/modules/whiteboard/core.cljs

@@ -0,0 +1,49 @@
+(ns frontend.modules.whiteboard.core
+  (:require [frontend.db :as db]
+            [frontend.db.model :as model]
+            [goog.object :as gobj]))
+
+(defn- get-page-block [page-name]
+  (db/pull '[*] (:db/id (model/get-page page-name))))
+
+(defn- block->shape [block]
+  (let [properties (:block/properties block)]
+    (merge properties
+           ;; Use the block's id as the shape's id.
+           {:id (str (:block/uuid block))})))
+
+(defn- shape->block [blocks-by-uuid shape]
+  (let [properties shape
+        block (get blocks-by-uuid (:id shape))]
+    (merge block
+           {:properties properties})))
+
+(defn get-whiteboard-cjs [page-name]
+  (let [page-block (get-page-block page-name)
+        blocks (model/get-page-blocks-no-cache page-name)]
+    [page-block blocks]))
+
+(defn whiteboard-cjs->tldr [page-block blocks]
+  (let [shapes (map block->shape blocks)
+        page-name (:block/name page-block)
+        page-properties (:block/properties page-block)]
+    (clj->js {:currentPageId page-name
+              :pages [(merge page-properties
+                             {:id "page"
+                              :name "page"
+                              :shapes shapes})]})))
+
+(defn page-name->tldr [page-name]
+  (let [[page-block blocks] (get-whiteboard-cjs page-name)]
+    (whiteboard-cjs->tldr page-block blocks)))
+
+(defn transact-tldr! [page-name tldr]
+  (let [[page-block blocks] (get-whiteboard-cjs page-name)
+        {:keys [pages]} (js->clj tldr)
+        page (first pages) ;; should only contain one page
+        shapes (:shapes page)
+        blocks-by-uuid (reduce (fn [acc shape]
+                                 (assoc (:id shape) shape acc))
+                               blocks {})
+        blocks (map #(shape->block blocks-by-uuid %) shapes)]
+    [page-block blocks]))

src/test/frontend/modules/whiteboard/core_test.cljs

@@ -1,5 +1,5 @@
-(ns frontend.modules.file.core-test
-  (:require [cljs.test :refer [use-fixtures] :as test]
+(ns frontend.modules.whiteboard.core-test
+  (:require [cljs.test :refer [use-fixtures]]
             [frontend.test.fixtures :as fixtures]
             [frontend.test.helper :as helper]))
 
@@ -10,3 +10,5 @@
   fixtures/load-test-env
   fixtures/react-components
   fixtures/reset-db)
+
+