feat(opml): support opml import

src/main/frontend/components/external.cljs

@@ -4,12 +4,16 @@
             [clojure.string :as string]
             [frontend.handler.notification :as notification]
             [frontend.handler.external :as external-handler]
-            [frontend.ui :as ui]))
+            [frontend.ui :as ui]
+            [reitit.frontend.easy :as rfe]))
 
-(defonce *importing? (atom nil))
+(defonce *roam-importing? (atom nil))
+(defonce *opml-importing? (atom nil))
+(defonce *opml-imported-pages (atom nil))
 (rum/defc import-cp < rum/reactive
   []
-  (let [importing? (rum/react *importing?)]
+  (let [roam-importing? (rum/react *roam-importing?)
+        opml-importing? (rum/react *opml-importing?)]
     [:div#import
      [:h1.title "Import JSON from Roam Research (experimental)"]
      [:p.text-sm.mb-8 "Export to Roam Research is coming!"]
@@ -22,18 +26,51 @@
                           file-name (gobj/get file "name")]
                       (if (string/ends-with? file-name ".json")
                         (do
-                          (reset! *importing? true)
+                          (reset! *roam-importing? true)
                           (let [reader (js/FileReader.)]
                             (set! (.-onload reader)
                                   (fn [e]
                                     (let [text (.. e -target -result)]
                                       (external-handler/import-from-roam-json! text
-                                                                               #(reset! *importing? false)))))
+                                                                               #(reset! *roam-importing? false)))))
                             (.readAsText reader file)))
                         (notification/show! "Please choose a JSON file."
                                             :error))))}]
      [:div.mt-4
-      (case importing?
+      (case roam-importing?
         true (ui/loading "Loading")
         false [:b "Importing finished!"]
+        nil)]
+     ;;
+     [:h1.title "Import OPML"]
+
+     [:input
+      {:id "import-opml"
+       :type "file"
+       :on-change (fn [e]
+                    (let [file (first (array-seq (.-files (.-target e))))
+                          file-name (gobj/get file "name")]
+                      (if (string/ends-with? file-name ".opml")
+                        (do
+                          (reset! *opml-importing? true)
+                          (let [reader (js/FileReader.)]
+                            (set! (.-onload reader)
+                                  (fn [e]
+                                    (let [text (.. e -target -result)]
+                                      (external-handler/import-from-opml! text
+                                                                          (fn [pages]
+                                                                            (reset! *opml-imported-pages pages)
+                                                                            (reset! *opml-importing? false))))))
+                            (.readAsText reader file)))
+                        (notification/show! "Please choose a OPML file."
+                                            :error))))}]
+     [:div.mt-4
+      (case opml-importing?
+        true (ui/loading "Loading")
+        false [:div
+               [:b "Importing finished!"]
+               [:tr
+                (mapv (fn [page-name] [:tb
+                                       [:a {:href (rfe/href :page {:name page-name})} page-name]])
+                      @*opml-imported-pages)]]
         nil)]]))

src/main/frontend/format/block.cljs

@@ -378,14 +378,15 @@
   (some (fn [x] (and (vector? x) (= "Src" (first x)))) (:body block)))
 
 (defn- get-block-content
-  [utf8-content block format]
+  [utf8-content block format block-content]
   (let [meta (:meta block)
-        content (if-let [end-pos (:end-pos meta)]
-                  (utf8/substring utf8-content
-                                  (:start-pos meta)
-                                  end-pos)
-                  (utf8/substring utf8-content
-                                  (:start-pos meta)))
+        content (or block-content
+                    (if-let [end-pos (:end-pos meta)]
+                      (utf8/substring utf8-content
+                                      (:start-pos meta)
+                                      end-pos)
+                      (utf8/substring utf8-content
+                                      (:start-pos meta))))
         content-orig content]
     (let [content (when content
                     (let [content (text/remove-level-spaces content format)]
@@ -432,9 +433,11 @@
                 properties {}
                 last-pos last-pos
                 last-level 1000
-                children []]
+                children []
+                block-all-content []]
            (if (seq blocks)
-             (let [[block {:keys [start_pos end_pos]}] (first blocks)
+             (let [[block {:keys [start_pos end_pos] :as block-content}] (first blocks)
+                   block-content (when (string? block-content) block-content)
                    unordered? (:unordered (second block))
                    markdown-heading? (and (false? unordered?) (= :markdown format))]
                (cond
@@ -443,11 +446,11 @@
                        timestamps' (merge timestamps timestamps)
                        other-body (->> (second block)
                                        (drop-while #(= ["Break_Line"] %)))]
-                   (recur headings (conj block-body ["Paragraph" other-body]) (rest blocks) timestamps' properties last-pos last-level children))
+                   (recur headings (conj block-body ["Paragraph" other-body]) (rest blocks) timestamps' properties last-pos last-level children (conj block-all-content block-content)))
 
                  (property/properties-ast? block)
                  (let [properties (extract-properties (second block))]
-                   (recur headings block-body (rest blocks) timestamps properties last-pos last-level children))
+                   (recur headings block-body (rest blocks) timestamps properties last-pos last-level children (conj block-all-content block-content)))
 
                  (heading-block? block)
                  (let [id (or (when-let [custom-id (or (get-in properties [:properties :custom-id])
@@ -495,7 +498,7 @@
                                  (assoc-in [:meta :end-pos] last-pos)
                                  ((fn [block]
                                     (assoc block
-                                           :content (get-block-content encoded-content block format)))))
+                                           :content (get-block-content encoded-content block format (and block-content (string/join "\n" (reverse (conj block-all-content block-content)))))))))
                        block (if (seq timestamps)
                                (merge block (timestamps->scheduled-and-deadline timestamps))
                                block)
@@ -504,11 +507,11 @@
                                  with-block-refs
                                  block-tags->pages)
                        last-pos' (get-in block [:meta :start-pos])]
-                   (recur (conj headings block) [] (rest blocks) {} {} last-pos' (:level block) children))
+                   (recur (conj headings block) [] (rest blocks) {} {} last-pos' (:level block) children []))
 
                  :else
                  (let [block-body' (conj block-body block)]
-                   (recur headings block-body' (rest blocks) timestamps properties last-pos last-level children))))
+                   (recur headings block-body' (rest blocks) timestamps properties last-pos last-level children (conj block-all-content block-content)))))
              (do
                (when (seq block-body)
                  (reset! pre-block-body (reverse block-body)))

src/main/frontend/format/mldoc.cljs

@@ -14,6 +14,7 @@
 
 (defonce parseJson (gobj/get Mldoc "parseJson"))
 (defonce parseInlineJson (gobj/get Mldoc "parseInlineJson"))
+(defonce parseOPML (gobj/get Mldoc "parseOPML"))
 (defonce exportToHtml (gobj/get Mldoc "exportToHtml"))
 (defonce anchorLink (gobj/get Mldoc "anchorLink"))
 (defonce parseAndExportMarkdown (gobj/get Mldoc "parseAndExportMarkdown"))
@@ -56,6 +57,10 @@
   [text config]
   (parseInlineJson text config))
 
+(defn parse-opml
+  [content]
+  (parseOPML content))
+
 (defn parse-export-markdown
   [content config references]
   (parseAndExportMarkdown content
@@ -227,6 +232,17 @@
       (log/error :edn/convert-failed e)
       [])))
 
+(defn opml->edn
+  [content]
+  (try
+    (if (string/blank? content)
+      {}
+      (let [[headers blocks] (-> content (parse-opml) (util/json->clj))]
+        [headers (collect-page-properties blocks)]))
+    (catch js/Error e
+      (log/error :edn/convert-failed e)
+      [])))
+
 (defn inline->edn
   [text config]
   (try

src/main/frontend/handler/editor.cljs

@@ -1901,7 +1901,7 @@
     (state/set-editor-show-block-search! false)
     (cursor/move-cursor-forward input 2)))
 
-(defn- get-block-tree-insert-pos-after-target
+(defn get-block-tree-insert-pos-after-target
   "return [target-block sibling? delete-editing-block? editing-block]"
   ([target-block-id sibling?]
    (get-block-tree-insert-pos-after-target target-block-id sibling? nil))
@@ -2000,7 +2000,7 @@
          (assoc m :block/file (select-keys file [:db/id]))
          m)))))
 
-(defn- paste-block-vec-tree-at-target
+(defn paste-block-vec-tree-at-target
   ([tree exclude-properties]
    (paste-block-vec-tree-at-target tree exclude-properties nil nil nil))
   ([tree exclude-properties content-update-fn]
@@ -2639,6 +2639,14 @@
   (when-let [page (state/get-current-page)]
     (db/get-page-format page)))
 
+(defn blocks->tree-by-level
+  [blocks]
+  (let [min-level (apply min (mapv :block/level blocks))
+        prefix-level (if (> min-level 1) (- min-level 1) 0)]
+    (->> blocks
+                   (mapv #(assoc % :level (- (:block/level %) prefix-level)))
+                   (blocks-vec->tree))))
+
 (defn- paste-text-parseable
   [format text]
   (let [tree (->>

src/main/frontend/handler/external.cljs

@@ -7,7 +7,11 @@
             [frontend.date :as date]
             [frontend.config :as config]
             [clojure.string :as string]
-            [frontend.db :as db]))
+            [frontend.db :as db]
+            [frontend.format.mldoc :as mldoc]
+            [frontend.format.block :as block]
+            [frontend.handler.page :as page]
+            [frontend.handler.editor :as editor]))
 
 (defonce debug-files (atom nil))
 (defn index-files!
@@ -58,3 +62,31 @@
                     (fn []
                       (common-handler/check-changed-files-status)
                       (finished-ok-handler))))))
+
+
+;;; import OPML files
+(defn import-from-opml!
+  [data finished-ok-handler]
+  (when-let [repo (state/get-current-repo)]
+    (let [[headers parsed-blocks] (mldoc/opml->edn data)
+          parsed-blocks (block/extract-blocks parsed-blocks "" true :markdown) ; TODO: only support md in opml's text attr yet
+          page-name (:title headers)]
+      (when (not (page/page-exists? page-name))
+        (page/create! page-name {:redirect? false}))
+      (let [page-block (db/entity [:block/name (string/lower-case page-name)])
+            children (:block/_parent page-block)
+            blocks (db/sort-by-left children page-block)
+            last-block (last blocks)
+            snd-last-block (last (butlast blocks))
+            [target-block sibling?] (if (and last-block (seq (:block/content last-block)))
+                                      [last-block true]
+                                      (if snd-last-block
+                                        [snd-last-block true]
+                                        [page-block false]))
+            tree (editor/blocks->tree-by-level parsed-blocks)]
+        (editor/paste-block-vec-tree-at-target
+         tree [] nil
+         #(editor/get-block-tree-insert-pos-after-target
+           (:db/id target-block) sibling?)
+         page-block)
+        (finished-ok-handler [page-name])))))