chore: remove bak file

src/main/frontend/handler/export/opml.cljs.~3f773ed876c3d1b88bdcae855dbed02d3f2d4c62~

@@ -1,470 +0,0 @@
-(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
-     "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\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)