From 6725c83f5cdda834c935737e88f9cbbd0a9cfd00 Mon Sep 17 00:00:00 2001 From: Tienson Qin Date: Mon, 22 Jan 2024 09:47:48 +0800 Subject: [PATCH] fix: export issues --- src/main/frontend/db_worker.cljs | 4 +- src/main/frontend/extensions/zip.cljs | 15 +- src/main/frontend/handler/export.cljs | 32 +- src/main/frontend/handler/export/common.cljs | 11 +- src/main/frontend/handler/export/opml.cljs | 13 +- ...~3f773ed876c3d1b88bdcae855dbed02d3f2d4c62~ | 470 ++++++++++++++++++ src/main/frontend/handler/export/text.cljs | 8 +- 7 files changed, 516 insertions(+), 37 deletions(-) create mode 100644 src/main/frontend/handler/export/opml.cljs.~3f773ed876c3d1b88bdcae855dbed02d3f2d4c62~ diff --git a/src/main/frontend/db_worker.cljs b/src/main/frontend/db_worker.cljs index 7e5ab7c9573..23d5fe2a022 100644 --- a/src/main/frontend/db_worker.cljs +++ b/src/main/frontend/db_worker.cljs @@ -417,12 +417,12 @@ (get-all-pages [this repo] (when-let [conn (worker-state/get-datascript-conn repo)] - (bean/->js (worker-export/get-all-pages repo @conn)))) + (pr-str (worker-export/get-all-pages repo @conn)))) (get-all-page->content [this repo] (when-let [conn (worker-state/get-datascript-conn repo)] - (bean/->js (worker-export/get-all-page->content repo @conn)))) + (pr-str (worker-export/get-all-page->content repo @conn)))) ;; RTC (rtc-start diff --git a/src/main/frontend/extensions/zip.cljs b/src/main/frontend/extensions/zip.cljs index 7264becb2f6..4a24e3da1d0 100644 --- a/src/main/frontend/extensions/zip.cljs +++ b/src/main/frontend/extensions/zip.cljs @@ -1,6 +1,5 @@ (ns frontend.extensions.zip (:require [clojure.string :as string] - [frontend.config :as config] ["jszip" :as JSZip] [promesa.core :as p])) @@ -11,15 +10,13 @@ (aset args "lastModified" last-modified) (js/File. blob-content file-name args))) -(defn make-zip [zip-filename file-name->content repo] +(defn make-zip [zip-filename file-name->content _repo] (let [zip (JSZip.) - zip-foldername (subs zip-filename (inc (string/last-index-of zip-filename "/"))) - src-filepath (string/replace repo config/local-db-prefix "") - folder (.folder zip zip-foldername)] + folder (.folder zip zip-filename)] (doseq [[file-name content] file-name->content] - (.file folder (-> file-name - (string/replace src-filepath "") - (string/replace #"^/+" "")) - content)) + (when-not (string/blank? content) + (.file folder (-> file-name + (string/replace #"^/+" "")) + content))) (p/let [zip-blob (.generateAsync zip #js {:type "blob"})] (make-file zip-blob (str zip-filename ".zip") {:type "application/zip"})))) diff --git a/src/main/frontend/handler/export.cljs b/src/main/frontend/handler/export.cljs index 7de3fa21140..713ad11dec7 100644 --- a/src/main/frontend/handler/export.cljs +++ b/src/main/frontend/handler/export.cljs @@ -50,7 +50,7 @@ (defn export-repo-as-zip! [repo] - (p/let [files (export-common-handler/ (string/replace repo config/local-db-prefix "") @@ -121,23 +121,25 @@ (defn- > edn-str - js/encodeURIComponent - (str "data:text/edn;charset=utf-8,")) - filename (file-name repo :edn)] - (if (mobile-util/native-platform?) - (export-file-on-mobile edn-str filename) - (when-let [anchor (gdom/getElement "download-as-edn-v2")] - (.setAttribute anchor "href" data-str) - (.setAttribute anchor "download" filename) - (.click anchor)))))) + (p/let [edn-str (> edn-str + js/encodeURIComponent + (str "data:text/edn;charset=utf-8,")) + filename (file-name repo :edn)] + (if (mobile-util/native-platform?) + (export-file-on-mobile edn-str filename) + (when-let [anchor (gdom/getElement "download-as-edn-v2")] + (.setAttribute anchor "href" data-str) + (.setAttribute anchor "download" filename) + (.click anchor))))))) (defn- nested-update-id [vec-tree] diff --git a/src/main/frontend/handler/export/common.cljs b/src/main/frontend/handler/export/common.cljs index 13a534c3d01..3dc2a87b7ab 100644 --- a/src/main/frontend/handler/export/common.cljs +++ b/src/main/frontend/handler/export/common.cljs @@ -16,7 +16,8 @@ [promesa.core :as p] [frontend.persist-db.browser :as db-browser] [cljs-bean.core :as bean] - [frontend.worker.export :as worker-export])) + [frontend.worker.export :as worker-export] + [clojure.edn :as edn])) ;;; TODO: split frontend.handler.export.text related states (def ^:dynamic *state* @@ -194,19 +195,19 @@ [repo] (when-let [^object worker @db-browser/*worker] (p/let [result (.get-all-pages worker repo)] - (bean/->clj result)))) + (edn/read-string result)))) (defn content [repo] (when-let [^object worker @db-browser/*worker] (p/let [result (.get-all-page->content worker repo)] - (bean/->clj result)))) + (edn/read-string result)))) (defn content (content repo)] (clojure.core/map (fn [[page-title content]] - {:path (str page-title ".md") + {:path (str page-title "."suffix) :content content :title page-title :format :markdown}) diff --git a/src/main/frontend/handler/export/opml.cljs b/src/main/frontend/handler/export/opml.cljs index 01743664a76..d462280810c 100644 --- a/src/main/frontend/handler/export/opml.cljs +++ b/src/main/frontend/handler/export/opml.cljs @@ -15,7 +15,8 @@ [goog.dom :as gdom] [hiccups.runtime :as h] [frontend.format.mldoc :as mldoc] - [promesa.core :as p])) + [promesa.core :as p] + [frontend.config :as config])) ;;; *opml-state* (def ^:private ^:dynamic @@ -451,16 +452,20 @@ [files options] (mapv (fn [{:keys [path content title format]}] - (when title + (when (and title (not (string/blank? content))) (util/profile (print-str :export-files-as-opml path) [path (export-helper content format options :title title)]))) files)) (defn export-repo-as-opml! [repo] - (p/let [files (common/ repo + (string/replace config/db-version-prefix "") + (string/replace config/local-db-prefix "")) + files (->> (export-files-as-opml files nil) + (clojure.core/remove nil?)) zip-file-name (str repo "_opml_" (quot (util/time-ms) 1000))] (p/let [zipfile (zip/make-zip zip-file-name files repo)] (when-let [anchor (gdom/getElement "export-as-opml")] diff --git a/src/main/frontend/handler/export/opml.cljs.~3f773ed876c3d1b88bdcae855dbed02d3f2d4c62~ b/src/main/frontend/handler/export/opml.cljs.~3f773ed876c3d1b88bdcae855dbed02d3f2d4c62~ new file mode 100644 index 00000000000..1562649737b --- /dev/null +++ b/src/main/frontend/handler/export/opml.cljs.~3f773ed876c3d1b88bdcae855dbed02d3f2d4c62~ @@ -0,0 +1,470 @@ +(ns frontend.handler.export.opml + "export blocks/pages as opml" + (:refer-clojure :exclude [map filter mapcat concat remove newline]) + (:require ["/frontend/utils" :as utils] + [clojure.string :as string] + [clojure.zip :as z] + [frontend.db :as db] + [frontend.extensions.zip :as zip] + [frontend.handler.export.common :as common :refer + [*state* raw-text simple-asts->string space]] + [frontend.handler.export.zip-helper :refer [get-level goto-last + goto-level]] + [frontend.state :as state] + [frontend.util :as util :refer [concatv mapcatv removev]] + [goog.dom :as gdom] + [hiccups.runtime :as h] + [frontend.format.mldoc :as mldoc] + [promesa.core :as p])) + +;;; *opml-state* +(def ^:private ^:dynamic + *opml-state* + {:outside-em-symbol nil}) + +;;; utils for construct opml hiccup +;; - a +;; - b +;; - c +;; - d +;; [:outline +;; {:text "a"} +;; [:outline {:text "b"} [:outline {:text "c"}]] +;; [:outline {:text "d"}]] + +(defn- branch? [node] (= :outline (first node))) + +(defn- outline-hiccup-zip + [root] + (z/zipper branch? + rest + (fn [node children] (with-meta (apply vector :outline children) (meta node))) + root)) + +(def ^:private init-opml-body-hiccup + (z/down (outline-hiccup-zip [:outline [:placeholder]]))) + +(defn- goto-last-outline + "[:outline [:outline [:outline]]] + ^ + goto here" + + [loc] + (-> loc + goto-last + z/up)) + +(defn- add-same-level-outline-at-right + [loc attr-map] + {:pre [(map? attr-map)]} + (-> loc + (z/insert-right [:outline attr-map]) + z/right)) + +(defn- add-next-level-outline + [loc attr-map] + {:pre [(map? attr-map)]} + (-> loc + (z/append-child [:outline attr-map]) + goto-last-outline)) + +(defn- append-text-to-current-outline + [loc text] + (-> loc + z/down + (z/edit #(update % :text str text)) + z/up)) + +(defn- append-text-to-current-outline* + "if current-level = 0(it's just `init-opml-body-hiccup`), need to add a new outline item." + [loc text] + (if (pos? (get-level loc)) + (append-text-to-current-outline loc text) + ;; at root + (-> loc + z/down + (add-same-level-outline-at-right {:text nil}) + (append-text-to-current-outline text)))) + +(defn- zip-loc->opml + [hiccup title] + (let [[_ _ & body] hiccup] + (str + "\n" + (utils/prettifyXml + (h/render-html + [:opml {:version "2.0"} + [:head [:title title]] + (concatv [:body] body)]))))) + +;;; utils for construct opml hiccup (ends) + +;;; block/inline-ast -> hiccup & simple-ast + +(declare inline-ast->simple-ast + block-ast->hiccup) + +(defn- emphasis-wrap-with + [inline-coll em-symbol] + (binding [*opml-state* (assoc *opml-state* :outside-em-symbol (first em-symbol))] + (concatv [(raw-text em-symbol)] + (mapcatv inline-ast->simple-ast inline-coll) + [(raw-text em-symbol)]))) + +(defn- inline-emphasis + [[[type] inline-coll]] + (let [outside-em-symbol (:outside-em-symbol *opml-state*)] + (case type + "Bold" + (emphasis-wrap-with + inline-coll (if (= outside-em-symbol "*") "__" "**")) + "Italic" + (emphasis-wrap-with + inline-coll (if (= outside-em-symbol "*") "_" "*")) + "Underline" + (binding [*opml-state* (assoc *opml-state* :outside-em-symbol outside-em-symbol)] + (mapcatv (fn [inline] (cons space (inline-ast->simple-ast inline))) inline-coll)) + "Strike_through" + (emphasis-wrap-with inline-coll "~~") + "Highlight" + (emphasis-wrap-with inline-coll "^^") + ;; else + (assert false (print-str :inline-emphasis type "is invalid"))))) + +;; FIXME: how to add newlines to opml text attr? +(defn- inline-break-line + [] + [space]) + +(defn- inline-link + [{full-text :full_text}] + [(raw-text full-text)]) + +(defn- inline-nested-link + [{content :content}] + [(raw-text content)]) + +(defn- inline-subscript + [inline-coll] + (concatv [(raw-text "_{")] + (mapcatv (fn [inline] (cons space (inline-ast->simple-ast inline))) inline-coll) + [(raw-text "}")])) + + +(defn- inline-superscript + [inline-coll] + (concatv [(raw-text "^{")] + (mapcatv (fn [inline] (cons space (inline-ast->simple-ast inline))) inline-coll) + [(raw-text "}")])) + +(defn- inline-footnote-reference + [{name :name}] + [(raw-text "[" name "]")]) + +(defn- inline-cookie + [ast-content] + [(raw-text + (case (first ast-content) + "Absolute" + (let [[_ current total] ast-content] + (str "[" current "/" total "]")) + "Percent" + (str "[" (second ast-content) "%]")))]) + +(defn- inline-latex-fragment + [ast-content] + (let [[type content] ast-content + wrapper (case type + "Inline" "$" + "Displayed" "$$")] + [space (raw-text (str wrapper content wrapper)) space])) + +(defn- inline-macro + [{:keys [name arguments]}] + (-> + (if (= name "cloze") + (string/join "," arguments) + (let [l (cond-> ["{{" name] + (pos? (count arguments)) (conj "(" (string/join "," arguments) ")") + true (conj "}}"))] + (string/join l))) + raw-text + vector)) + +(defn- inline-entity + [{unicode :unicode}] + [(raw-text unicode)]) + +(defn- inline-timestamp + [ast-content] + (let [[type timestamp-content] ast-content] + (-> (case type + "Scheduled" ["SCHEDULED: " (common/timestamp-to-string timestamp-content)] + "Deadline" ["DEADLINE: " (common/timestamp-to-string timestamp-content)] + "Date" [(common/timestamp-to-string timestamp-content)] + "Closed" ["CLOSED: " (common/timestamp-to-string timestamp-content)] + "Clock" ["CLOCK: " (common/timestamp-to-string (second timestamp-content))] + "Range" (let [{:keys [start stop]} timestamp-content] + [(str (common/timestamp-to-string start) "--" (common/timestamp-to-string stop))])) + string/join + raw-text + vector))) + +(defn- inline-email + [{:keys [local_part domain]}] + [(raw-text (str "<" local_part "@" domain ">"))]) + + +(defn- inline-ast->simple-ast + [inline] + (let [[ast-type ast-content] inline] + (case ast-type + "Emphasis" + (inline-emphasis ast-content) + ("Break_Line" "Hard_Break_Line") + (inline-break-line) + "Verbatim" + [(raw-text ast-content)] + "Code" + [(raw-text "`" ast-content "`")] + "Tag" + [(raw-text "#" (common/hashtag-value->string ast-content))] + "Spaces" ; what's this ast-type for ? + nil + "Plain" + [(raw-text ast-content)] + "Link" + (inline-link ast-content) + "Nested_link" + (inline-nested-link ast-content) + "Target" + [(raw-text (str "<<" ast-content ">>"))] + "Subscript" + (inline-subscript ast-content) + "Superscript" + (inline-superscript ast-content) + "Footnote_Reference" + (inline-footnote-reference ast-content) + "Cookie" + (inline-cookie ast-content) + "Latex_Fragment" + (inline-latex-fragment ast-content) + "Macro" + (inline-macro ast-content) + "Entity" + (inline-entity ast-content) + "Timestamp" + (inline-timestamp ast-content) + "Radio_Target" + [(raw-text (str "<<<" ast-content ">>>"))] + "Email" + (inline-email ast-content) + "Inline_Hiccup" + [(raw-text ast-content)] + "Inline_Html" + [(raw-text ast-content)] + ("Export_Snippet" "Inline_Source_Block") + nil + (assert false (print-str :inline-ast->simple-ast ast-type "not implemented yet"))))) + +(defn- block-paragraph + [loc inline-coll] + (-> loc + goto-last-outline + (append-text-to-current-outline* + (simple-asts->string + (cons space (mapcatv inline-ast->simple-ast inline-coll)))))) + +(defn- block-heading + [loc {:keys [title _tags marker level _numbering priority _anchor _meta _unordered _size]}] + (let [loc (goto-last-outline loc) + current-level (get-level loc) + title* (mapcatv inline-ast->simple-ast title) + marker* (and marker (raw-text marker)) + priority* (and priority (raw-text (common/priority->string priority))) + simple-asts (removev nil? (concatv [marker* space priority* space] title*)) + ;; remove leading spaces + simple-asts (drop-while #(= % space) simple-asts) + s (simple-asts->string simple-asts)] + (if (> level current-level) + (add-next-level-outline loc {:text s}) + (-> loc + (goto-level level) + z/rightmost + (add-same-level-outline-at-right {:text s}))))) + +(declare block-list) +(defn- block-list-item + [loc {:keys [content items]}] + (let [current-level (get-level loc) + ;; if current loc node is empty(= {}), + ;; the outline node is already created. + loc (if (empty? (second (z/node loc))) + loc + (add-same-level-outline-at-right loc {:text nil})) + loc* (reduce block-ast->hiccup loc content) + loc** (if (seq items) (block-list loc* items) loc*)] + (-> loc** + (goto-level current-level) + z/rightmost))) + +(defn- block-list + [loc list-items] + (reduce block-list-item (add-next-level-outline loc {}) list-items)) + +(defn- block-example + [loc str-coll] + (append-text-to-current-outline* loc (string/join " " str-coll))) + +(defn- block-src + [loc {:keys [_language lines]}] + (append-text-to-current-outline* loc (string/join " " lines))) + +(defn- block-quote + [loc block-ast-coll] + (reduce block-ast->hiccup loc block-ast-coll)) + +(defn- block-latex-env + [loc [name options content]] + (append-text-to-current-outline* + loc + (str "\\begin{" name "}" options "\n" + content "\n" + "\\end{" name "}"))) + +(defn- block-displayed-math + [loc s] + (append-text-to-current-outline* loc s)) + +(defn- block-footnote-definition + [loc [name inline-coll]] + (let [inline-simple-asts (mapcatv inline-ast->simple-ast inline-coll)] + (append-text-to-current-outline* + loc + (str "[^" name "]: " (simple-asts->string inline-simple-asts))))) + +(defn- block-ast->hiccup + [loc block-ast] + (let [[ast-type ast-content] block-ast] + (case ast-type + "Paragraph" + (block-paragraph loc ast-content) + "Paragraph_line" + (assert false "Paragraph_line is mldoc internal ast") + "Paragraph_Sep" + loc + "Heading" + (block-heading loc ast-content) + "List" + (block-list loc ast-content) + ("Directive" "Results" "Property_Drawer" "Export" "CommentBlock" "Custom") + loc + "Example" + (block-example loc ast-content) + "Src" + (block-src loc ast-content) + "Quote" + (block-quote loc ast-content) + "Latex_Fragment" + (append-text-to-current-outline* loc (simple-asts->string (inline-latex-fragment ast-content))) + "Latex_Environment" + (block-latex-env loc (rest block-ast)) + "Displayed_Math" + (block-displayed-math loc ast-content) + "Drawer" + loc + "Footnote_Definition" + (block-footnote-definition loc (rest block-ast)) + "Horizontal_Rule" + loc + "Table" + loc + "Comment" + loc + "Raw_Html" + loc + "Hiccup" + loc + (assert false (print-str :block-ast->simple-ast ast-type "not implemented yet"))))) + +;;; block/inline-ast -> hiccup (ends) + +;;; export fns +(defn- export-helper + [content format options & {:keys [title] :or {title "untitled"}}] + (let [remove-options (set (:remove-options options)) + other-options (:other-options options)] + (binding [*state* (merge *state* + {:export-options + {:remove-emphasis? (contains? remove-options :emphasis) + :remove-page-ref-brackets? (contains? remove-options :page-ref) + :remove-tags? (contains? remove-options :tag) + :keep-only-level<=N (:keep-only-level<=N other-options)}}) + *opml-state* *opml-state*] + (let [ast (mldoc/->edn content format) + ast (mapv common/remove-block-ast-pos ast) + ast (removev common/Properties-block-ast? ast) + keep-level<=n (get-in *state* [:export-options :keep-only-level<=N]) + ast (if (pos? keep-level<=n) + (common/keep-only-level<=n ast keep-level<=n) + ast) + ast* (common/replace-block&page-reference&embed ast) + ast** (if (= "no-indent" (get-in *state* [:export-options :indent-style])) + (mapv common/replace-Heading-with-Paragraph ast*) + ast*) + config-for-walk-block-ast (cond-> {} + (get-in *state* [:export-options :remove-emphasis?]) + (update :mapcat-fns-on-inline-ast conj common/remove-emphasis) + + (get-in *state* [:export-options :remove-page-ref-brackets?]) + (update :map-fns-on-inline-ast conj common/remove-page-ref-brackets) + + (get-in *state* [:export-options :remove-tags?]) + (update :mapcat-fns-on-inline-ast conj common/remove-tags)) + ast*** (if-not (empty? config-for-walk-block-ast) + (mapv (partial common/walk-block-ast config-for-walk-block-ast) ast**) + ast**) + hiccup (z/root (reduce block-ast->hiccup init-opml-body-hiccup ast***))] + (zip-loc->opml hiccup title))))) + +(defn export-blocks-as-opml + "options: see also `export-blocks-as-markdown`" + [repo root-block-uuids-or-page-name options] + {:pre [(or (coll? root-block-uuids-or-page-name) + (string? root-block-uuids-or-page-name))]} + (util/profile + :export-blocks-as-opml + (let [content + (if (string? root-block-uuids-or-page-name) + ;; page + (common/get-page-content root-block-uuids-or-page-name) + (common/root-block-uuids->content repo root-block-uuids-or-page-name)) + title (if (string? root-block-uuids-or-page-name) + root-block-uuids-or-page-name + "untitled") + first-block (db/entity [:block/uuid (first root-block-uuids-or-page-name)]) + format (or (:block/format first-block) (state/get-preferred-format))] + (export-helper content format options :title title)))) + +(defn export-files-as-opml + "options see also `export-blocks-as-opml`" + [files options] + (mapv + (fn [{:keys [path content names format]}] + (when (first names) + (util/profile (print-str :export-files-as-opml path) + [path (export-helper content format options :title (first names))]))) + files)) + +(defn export-repo-as-opml! + [repo] + (when-let [files (common/get-file-contents-with-suffix repo)] + (let [files (export-files-as-opml files nil) + zip-file-name (str repo "_opml_" (quot (util/time-ms) 1000))] + (p/let [zipfile (zip/make-zip zip-file-name files repo)] + (when-let [anchor (gdom/getElement "export-as-opml")] + (.setAttribute anchor "href" (js/window.URL.createObjectURL zipfile)) + (.setAttribute anchor "download" (.-name zipfile)) + (.click anchor)))))) + +;;; export fns (ends) diff --git a/src/main/frontend/handler/export/text.cljs b/src/main/frontend/handler/export/text.cljs index 195571fb16d..9ec56bcc129 100644 --- a/src/main/frontend/handler/export/text.cljs +++ b/src/main/frontend/handler/export/text.cljs @@ -13,7 +13,8 @@ [goog.dom :as gdom] [frontend.format.mldoc :as mldoc] [malli.core :as m] - [promesa.core :as p])) + [promesa.core :as p] + [frontend.config :as config])) ;;; block-ast, inline-ast -> simple-ast @@ -504,9 +505,12 @@ (defn export-repo-as-markdown! "TODO: indent-style and remove-options" [repo] - (p/let [files (util/profile :get-file-content (common/ repo + (string/replace config/db-version-prefix "") + (string/replace config/local-db-prefix "")) zip-file-name (str repo "_markdown_" (quot (util/time-ms) 1000))] (p/let [zipfile (zip/make-zip zip-file-name files repo)] (when-let [anchor (gdom/getElement "export-as-markdown")]