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

(ns frontend.modules.file.core
  (:require [clojure.string :as string]
            [frontend.config :as config]
            [frontend.date :as date]
            [frontend.db :as db]
            [frontend.db.utils :as db-utils]
            [frontend.state :as state]
            [frontend.util :as util]
            [frontend.util.property :as property]
            [frontend.handler.file :as file-handler]))

(defn- indented-block-content
  [content spaces-tabs]
  (let [lines (string/split-lines content)]
    (string/join (str "\n" spaces-tabs) lines)))

(defn- content-with-collapsed-state
  "Only accept nake content (without any indentation)"
  [format content collapsed? properties]
  (cond
    collapsed?
    (property/insert-property format content :collapsed true)

    (and (:collapsed properties) (false? collapsed?))
    (property/remove-property format :collapsed content)

    :else
    content))

(defn transform-content
  [{:block/keys [collapsed? format pre-block? unordered content heading-level left page parent properties]} level {:keys [heading-to-list?]}]
  (let [content (or content "")
        pre-block? (or pre-block?
                       (and (= page parent left) ; first block
                            (= :markdown format)
                            (string/includes? (first (string/split-lines content)) ":: ")))
        markdown? (= format :markdown)
        content (cond
                  pre-block?
                  (let [content (string/trim content)]
                    (str content "\n"))

                  :else
                  (let [markdown-top-heading? (and markdown?
                                                   (= parent page)
                                                   (not unordered)
                                                   heading-level)
                        [prefix spaces-tabs]
                        (cond
                          (= format :org)
                          [(->>
                            (repeat level "*")
                            (apply str)) ""]

                          markdown-top-heading?
                          ["" ""]

                          :else
                          (let [level (if (and heading-to-list? heading-level)
                                        (if (> heading-level 1)
                                          (dec heading-level)
                                          heading-level)
                                        level)
                                spaces-tabs (->>
                                             (repeat (dec level) (state/get-export-bullet-indentation))
                                             (apply str))]
                            [(str spaces-tabs "-") (str spaces-tabs "  ")]))
                        content (if heading-to-list?
                                  (-> (string/replace content #"^\s?#+\s+" "")
                                      (string/replace #"^\s?#+\s?$" ""))
                                  content)
                        content (content-with-collapsed-state format content collapsed? properties)
                        new-content (indented-block-content (string/trim content) spaces-tabs)
                        sep (if (or markdown-top-heading?
                                    (string/blank? new-content))
                              ""
                              " ")]
                    (str prefix sep new-content)))]
    content))


(defn- tree->file-content-aux
  [tree {:keys [init-level] :as opts}]
  (let [block-contents (transient [])]
    (loop [[f & r] tree level init-level]
      (if (nil? f)
        (->> block-contents persistent! flatten (remove nil?))
        (let [page? (nil? (:block/page f))
              content (if page? nil (transform-content f level opts))
              new-content
              (if-let [children (seq (:block/children f))]
                     (cons content (tree->file-content-aux children {:init-level (inc level)}))
                     [content])]
          (conj! block-contents new-content)
          (recur r level))))))

(defn tree->file-content
  [tree opts]
  (->> (tree->file-content-aux tree opts) (string/join "\n")))


(def init-level 1)

(defn- transact-file-tx-if-not-exists!
  [page ok-handler]
  (when-let [repo (state/get-current-repo)]
    (when (:block/name page)
      (let [format (name (get page :block/format
                              (state/get-preferred-format)))
            title (string/capitalize (:block/name page))
            whiteboard-page? (:block/whiteboard? page)
            format (if whiteboard-page? "edn" format)
            journal-page? (date/valid-journal-title? title)
            filename (if journal-page?
                       (date/date->file-name journal-page?)
                       (-> (or (:block/original-name page) (:block/name page))
                           (util/file-name-sanity)))
            sub-dir (cond
                      journal-page?    (config/get-journals-directory)
                      whiteboard-page? (config/get-whiteboards-directory)
                      :else            (config/get-pages-directory))
            ext (if (= format "markdown") "md" format)
            file-path (config/get-page-file-path repo sub-dir filename ext)
            file {:file/path file-path}
            tx [{:file/path file-path}
                {:block/name (:block/name page)
                 :block/file file}]]
        (db/transact! tx)
        (when ok-handler (ok-handler))))))

(defn- remove-transit-ids [block] (dissoc block :db/id :block/file))

(defn save-tree-aux!
  [page-block tree]
  (let [page-block (db/pull '[* {:block/file [:file/path]}] (:db/id page-block))
        file-path (get-in page-block [:block/file :file/path])
        whiteboard? (:block/whiteboard? page-block)
        new-content (if whiteboard?
                      (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
        files [[file-path new-content]]
        repo (state/get-current-repo)]
    (file-handler/alter-files-handler! repo files {} {})))

(defn save-tree!
  [page-block tree]
  {:pre [(map? page-block)]}
  (let [ok-handler #(save-tree-aux! page-block tree)
        file (or (:block/file page-block)
                 (when-let [page (:db/id (:block/page page-block))]
                   (:block/file (db-utils/entity page))))]
    (if file
      (ok-handler)
      (transact-file-tx-if-not-exists! page-block ok-handler))))