logseq/src/main/frontend/format/block.cljs

(ns frontend.format.block
  (:require [clojure.string :as string]
            [clojure.walk :as walk]
            [cljs.core.match :as match]
            [frontend.config :as config]
            [frontend.date :as date]
            [frontend.db :as db]
            [frontend.format :as format]
            [frontend.state :as state]
            [frontend.text :as text]
            [frontend.utf8 :as utf8]
            [frontend.util :as util]
            [frontend.util.property :as property]
            [lambdaisland.glogi :as log]
            [medley.core :as medley]
            [frontend.format.mldoc :as mldoc]))

(defn heading-block?
  [block]
  (and
   (vector? block)
   (= "Heading" (first block))))

(defn get-tag
  [block]
  (when-let [tag-value (and (vector? block)
                            (= "Tag" (first block))
                            (second block))]
    (->
     (map (fn [e]
            (match/match e
              ["Plain" s]
              s
              ["Link" t]
              (let [{full_text :full_text} t]
                full_text)
              ["Nested_link" t]
              (let [ {content :content} t]
                content)
              :else
              ""
              )) tag-value)
     (string/join))))

(defn get-page-reference
  [block]
  (let [page (cond
               (and (vector? block) (= "Link" (first block)))
               (let [typ (first (:url (second block)))]
                 ;; {:url ["File" "file:../pages/hello_world.org"], :label [["Plain" "hello world"]], :title nil}
                 (or
                  (and
                   (= typ "Page_ref")
                   (string? (second (:url (second block))))
                   (second (:url (second block))))

                  (and
                   (= typ "Search")
                   (text/page-ref? (second (:url (second block))))
                   (text/page-ref-un-brackets! (second (:url (second block)))))

                  (and
                   (= typ "Search")
                   (not (contains? #{\# \* \/ \[} (first (second (:url (second block))))))
                   (let [page (second (:url (second block)))
                         ext (some-> (util/get-file-ext page) keyword)]
                     (when (and (not (util/starts-with? page "http:"))
                                (not (util/starts-with? page "https:"))
                                (not (util/starts-with? page "file:"))
                                (or (= ext :excalidraw)
                                    (not (contains? (config/supported-formats) ext))))
                       page)))

                  (and
                   (= typ "Complex")
                   (= (:protocol (second (:url (second block)))) "file")
                   (:link (second (:url (second block)))))

                  (and
                   (= typ "File")
                   (second (first (:label (second block)))))))

               (and (vector? block) (= "Nested_link" (first block)))
               (let [content (:content (last block))]
                 (subs content 2 (- (count content) 2)))

               (and (vector? block)
                    (= "Macro" (first block)))
               (let [{:keys [name arguments]} (second block)
                     argument (string/join ", " arguments)]
                   (when (= name "embed")
                     (text/page-ref-un-brackets! argument)))

               (and (vector? block)
                    (= "Tag" (first block)))
               (let [text (get-tag block)]
                 (text/page-ref-un-brackets! text))

               :else
               nil)]
    (text/block-ref-un-brackets! page)))

(defn get-block-reference
  [block]
  (when-let [block-id (cond
                        (and (vector? block)
                             (= "Block_reference" (first block)))
                        (last block)

                        (and (vector? block)
                             (= "Link" (first block))
                             (map? (second block))
                             (= "Block_ref" (first (:url (second block)))))
                        (second (:url (second block)))

                        (and (vector? block)
                             (= "Macro" (first block)))
                        (let [{:keys [name arguments]} (second block)]
                          (when (and (= name "embed")
                                     (string? (first arguments))
                                     (string/starts-with? (first arguments) "((")
                                     (string/ends-with? (first arguments) "))"))
                            (subs (first arguments) 2 (- (count (first arguments)) 2))))

                        (and (vector? block)
                             (= "Link" (first block))
                             (map? (second block)))
                        (if (= "id" (:protocol (second (:url (second block)))))
                          (:link (second (:url (second block))))
                          (let [id (second (:url (second block)))]
                            (text/block-ref-un-brackets! id)))

                        :else
                        nil)]
    (when (and block-id
               (util/uuid-string? block-id))
      block-id)))

(defn paragraph-block?
  [block]
  (and
   (vector? block)
   (= "Paragraph" (first block))))

(defn timestamp-block?
  [block]
  (and
   (vector? block)
   (= "Timestamp" (first block))))

;; TODO: we should move this to mldoc
(defn extract-properties
  [properties]
  (when (seq properties)
    (let [properties (seq properties)
          page-refs (->>
                     properties
                     (remove (fn [[k _]]
                               (contains? #{:background-color :background_color} (keyword k))))
                     (map last)
                     (map (fn [v]
                            (when (string? v)
                              (let [v (string/trim v)
                                    result (text/split-page-refs-without-brackets v {:un-brackets? false})]
                                (if (coll? result)
                                  (map text/page-ref-un-brackets! result)
                                  [])))))
                     (apply concat)
                     (remove string/blank?))
          properties (->> properties
                          (map (fn [[k v]]
                                 (let [k (-> (string/lower-case (name k))
                                             (string/replace " " "-")
                                             (string/replace "_" "-"))
                                       k (if (contains? #{"custom_id" "custom-id"} k)
                                           "id"
                                           k)
                                       v (if (coll? v)
                                           (remove string/blank? v)
                                           (if (string/blank? v)
                                             nil
                                             (text/parse-property k v)))
                                       k (keyword k)
                                       v (if (and
                                              (string? v)
                                              (contains? #{:alias :aliases :tags} k))
                                           (set [v])
                                           v)
                                       v (if (coll? v) (set v) v)]
                                   [k v])))
                          (remove #(nil? (second %))))]
      {:properties (into {} properties)
       :properties-order (map first properties)
       :page-refs page-refs})))

(defn- paragraph-timestamp-block?
  [block]
  (and (paragraph-block? block)
       (or (timestamp-block? (first (second block)))
           (timestamp-block? (second (second block))))))

(defn extract-timestamps
  [block]
  (some->>
   (second block)
   (filter timestamp-block?)
   (map last)
   (into {})))

;; {"Deadline" {:date {:year 2020, :month 10, :day 20}, :wday "Tue", :time {:hour 8, :min 0}, :repetition [["DoublePlus"] ["Day"] 1], :active true}}
(defn timestamps->scheduled-and-deadline
  [timestamps]
  (let [timestamps (medley/map-keys (comp keyword string/lower-case) timestamps)
        m (some->> (select-keys timestamps [:scheduled :deadline])
                   (map (fn [[k v]]
                          (let [{:keys [date repetition]} v
                                {:keys [year month day]} date
                                day (js/parseInt (str year (util/zero-pad month) (util/zero-pad day)))]
                            (cond->
                             (case k
                               :scheduled
                               {:scheduled day}
                               :deadline
                               {:deadline day})
                              repetition
                              (assoc :repeated? true))))))]
    (apply merge m)))

(defn convert-page-if-journal
  "Convert journal file name to user' custom date format"
  [original-page-name]
  (when original-page-name
    (let [page-name (util/page-name-sanity-lc original-page-name)
          day (date/journal-title->int page-name)]
     (if day
       (let [original-page-name (date/int->journal-title day)]
         [original-page-name (util/page-name-sanity-lc original-page-name) day])
       [original-page-name page-name day]))))

(defn page-name->map
  [original-page-name with-id?]
  (cond
    (and original-page-name (string? original-page-name))
    (let [original-page-name (util/remove-boundary-slashes original-page-name)
          [original-page-name page-name journal-day] (convert-page-if-journal original-page-name)
          namespace? (and (not (boolean (text/get-nested-page-name original-page-name)))
                          (text/namespace-page? original-page-name))
          m (merge
             {:block/name page-name
              :block/original-name original-page-name}
             (when with-id?
               (if (db/entity [:block/name page-name])
                 {}
                 {:block/uuid (db/new-block-id)}))
             (when namespace?
               (let [namespace (first (util/split-last "/" original-page-name))]
                 (when-not (string/blank? namespace)
                   {:block/namespace {:block/name (util/page-name-sanity-lc namespace)}}))))]
      (if journal-day
        (merge m
               {:block/journal? true
                :block/journal-day journal-day})
        (assoc m :block/journal? false)))

    (and (map? original-page-name) (:block/uuid original-page-name))
    original-page-name

    (and (map? original-page-name) with-id?)
    (assoc original-page-name :block/uuid (db/new-block-id))

    :else
    nil))

(defn with-page-refs
  [{:keys [title body tags refs marker priority] :as block} with-id?]
  (let [refs (->> (concat tags refs [marker priority])
                  (remove string/blank?)
                  (distinct))
        refs (atom refs)]
    (walk/prewalk
     (fn [form]
       ;; skip custom queries
       (when-not (and (vector? form)
                      (= (first form) "Custom")
                      (= (second form) "query"))
         (when-let [page (get-page-reference form)]
           (swap! refs conj page))
         (when-let [tag (get-tag form)]
           (let [tag (text/page-ref-un-brackets! tag)]
             (when (util/tag-valid? tag)
               (swap! refs conj tag))))
         form))
     (concat title body))
    (let [refs (remove string/blank? @refs)
          children-pages (->> (mapcat (fn [p]
                                        (let [p (if (map? p)
                                                  (:block/original-name p)
                                                  p)]
                                          (when (string? p)
                                            (let [p (or (text/get-nested-page-name p) p)]
                                              (when (text/namespace-page? p)
                                                (util/split-namespace-pages p))))))
                                      refs)
                              (remove string/blank?)
                              (distinct))
          refs (->> (distinct (concat refs children-pages))
                    (remove nil?))
          refs (map (fn [ref] (page-name->map ref with-id?)) refs)]
      (assoc block :refs refs))))

(defn with-block-refs
  [{:keys [title body] :as block}]
  (let [ref-blocks (atom nil)]
    (walk/postwalk
     (fn [form]
       (when-let [block (get-block-reference form)]
         (swap! ref-blocks conj block))
       form)
     (concat title body))
    (let [ref-blocks (->> @ref-blocks
                          (filter util/uuid-string?))
          ref-blocks (map
                       (fn [id]
                         [:block/uuid (medley/uuid id)])
                       ref-blocks)
          refs (distinct (concat (:refs block) ref-blocks))]
      (assoc block :refs refs))))

(defn block-keywordize
  [block]
  (medley/map-keys
   (fn [k]
     (if (namespace k)
       k
       (keyword "block" k)))
   block))

(defn safe-blocks
  [blocks]
  (map (fn [block]
         (if (map? block)
           (block-keywordize (util/remove-nils block))
           block))
       blocks))

(defn with-path-refs
  [blocks]
  (loop [blocks blocks
         acc []
         parents []]
    (if (empty? blocks)
      acc
      (let [block (first blocks)
            cur-level (:block/level block)
            level-diff (- cur-level
                          (get (last parents) :block/level 0))
            [path-refs parents]
            (cond
              (zero? level-diff)            ; sibling
              (let [path-refs (mapcat :block/refs (drop-last parents))
                    parents (conj (vec (butlast parents)) block)]
                [path-refs parents])

              (> level-diff 0)              ; child
              (let [path-refs (mapcat :block/refs parents)]
                [path-refs (conj parents block)])

              (< level-diff 0)              ; new parent
              (let [parents (vec (take-while (fn [p] (< (:block/level p) cur-level)) parents))
                    path-refs (mapcat :block/refs parents)]
                [path-refs (conj parents block)]))
            path-ref-pages (->> path-refs
                                (concat (:block/refs block))
                                (map (fn [ref]
                                       (cond
                                         (map? ref)
                                         (:block/name ref)

                                         :else
                                         ref)))
                                (remove string/blank?)
                                (map (fn [ref]
                                       (if (string? ref)
                                         {:block/name (util/page-name-sanity-lc ref)}
                                         ref)))
                                (remove vector?)
                                (remove nil?)
                                (distinct))]
        (recur (rest blocks)
               (conj acc (assoc block :block/path-refs path-ref-pages))
               parents)))))

(defn block-tags->pages
  [{:keys [tags] :as block}]
  (if (seq tags)
    (assoc block :tags (map (fn [tag]
                              (let [tag (text/page-ref-un-brackets! tag)]
                                [:block/name (util/page-name-sanity-lc tag)])) tags))
    block))

(defn- get-block-content
  [utf8-content block format block-content]
  (let [meta (:meta block)
        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 (when content
                  (let [content (text/remove-level-spaces content format)]
                    (if (or (:pre-block? block)
                            (= (:format block) :org))
                      content
                      (text/remove-indentation-spaces content (inc (:level block)) false))))]
    (if (= format :org)
      content
      (property/->new-properties content))))

(defn get-custom-id-or-new-id
  [properties]
  (or (when-let [custom-id (or (get-in properties [:properties :custom-id])
                               (get-in properties [:properties :custom_id])
                               (get-in properties [:properties :id]))]
        (let [custom-id (and (string? custom-id) (string/trim custom-id))]
          (when (and custom-id (util/uuid-string? custom-id))
            (uuid custom-id))))
      (db/new-block-id)))

(defn get-page-refs-from-properties
  [properties]
  (let [page-refs (mapcat (fn [v] (cond
                                   (coll? v)
                                   v

                                   (text/page-ref? v)
                                   [(text/page-ref-un-brackets! v)]

                                   :else
                                   nil)) (vals properties))
        page-refs (remove string/blank? page-refs)]
    (map (fn [page] (page-name->map page true)) page-refs)))

(defn with-page-block-refs
  [block with-id?]
  (some-> block
          (with-page-refs with-id?)
          with-block-refs
          block-tags->pages
          (update :refs (fn [col] (remove nil? col)))))

(defn extract-blocks*
  [blocks pre-block-properties encoded-content]
  (let [first-block (first blocks)
        first-block-start-pos (get-in first-block [:block/meta :start-pos])
        blocks (if (or (> first-block-start-pos 0)
                       (empty? blocks))
                 (cons
                  (merge
                   (let [content (utf8/substring encoded-content 0 first-block-start-pos)
                         id (get-custom-id-or-new-id {:properties @pre-block-properties})
                         block {:uuid id
                                :content content
                                :level 1
                                :meta {:start-pos 0
                                       :end-pos (or first-block-start-pos
                                                    (utf8/length encoded-content))}
                                :properties @pre-block-properties
                                :properties-order (keys @pre-block-properties)
                                :refs (->> (get-page-refs-from-properties @pre-block-properties)
                                           (map :block/original-name))
                                :pre-block? true
                                :unordered true}
                         block (with-page-block-refs block false)]
                     (block-keywordize block))
                   (select-keys first-block [:block/format :block/page]))
                  blocks)
                 blocks)
        blocks (map (fn [block] (dissoc block :block/anchor)) blocks)]
    (with-path-refs blocks)))

(defn extract-blocks
  [blocks content with-id? format]
  (try
    (let [encoded-content (utf8/encode content)
          last-pos (utf8/length encoded-content)
          pre-block-properties (atom nil)
          blocks
          (loop [headings []
                 blocks (reverse blocks)
                 timestamps {}
                 properties {}
                 last-pos last-pos
                 last-level 1000
                 children []
                 block-all-content []]
            (if (seq 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 (:size (second block)) (= :markdown format))]
                (cond
                  (paragraph-timestamp-block? block)
                  (let [timestamps (extract-timestamps block)
                        timestamps' (merge timestamps timestamps)]
                    (recur headings (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 (rest blocks) timestamps properties last-pos last-level children (conj block-all-content block-content)))

                  (heading-block? block)
                  (let [id (get-custom-id-or-new-id properties)
                        ref-pages-in-properties (->> (:page-refs properties)
                                                     (remove string/blank?))
                        block (second block)
                        block (if markdown-heading?
                                (assoc block
                                       :type :heading
                                       :level (if unordered? (:level block) 1)
                                       :heading-level (or (:size block) 6))
                                block)
                        level (:level block)
                        [children current-block-children]
                        (cond
                          (< level last-level)
                          (let [current-block-children (set (->> (filter #(< level (second %)) children)
                                                                 (map first)
                                                                 (map (fn [id]
                                                                        [:block/uuid id]))))
                                others (vec (remove #(< level (second %)) children))]
                            [(conj others [id level])
                             current-block-children])

                          (>= level last-level)
                          [(conj children [id level])
                           #{}])
                        block (cond->
                                (assoc block
                                      :uuid id
                                      :refs ref-pages-in-properties
                                      :children (or current-block-children [])
                                      :format format)
                                (seq (:properties properties))
                                (assoc :properties (:properties properties))

                                (seq (:properties-order properties))
                                (assoc :properties-order (:properties-order properties)))
                        block (if (get-in block [:properties :collapsed])
                                (assoc block :collapsed? true)
                                block)
                        block (-> block
                                  (assoc-in [:meta :start-pos] start_pos)
                                  (assoc-in [:meta :end-pos] last-pos)
                                  ((fn [block]
                                     (assoc block
                                            :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)
                        block (with-page-block-refs block with-id?)
                        last-pos' (get-in block [:meta :start-pos])
                        {:keys [created-at updated-at]} (:properties properties)
                        block (cond-> block
                                (and created-at (integer? created-at))
                                (assoc :block/created-at created-at)

                                (and updated-at (integer? updated-at))
                                (assoc :block/updated-at updated-at))]
                    (recur (conj headings block) (rest blocks) {} {} last-pos' (:level block) children []))

                  :else
                  (recur headings (rest blocks) timestamps properties last-pos last-level children (conj block-all-content block-content))))
              (do
                (when (seq properties)
                  (let [properties (:properties properties)]
                    (reset! pre-block-properties properties)))
                (-> (reverse headings)
                    safe-blocks))))]
      (extract-blocks* blocks pre-block-properties encoded-content))
    (catch js/Error e
      (js/console.error "extract-blocks-failed")
      (log/error :exception e))))

(defn with-parent-and-left
  [page-id blocks]
  (loop [blocks (map (fn [block] (assoc block :block/level-spaces (:block/level block))) blocks)
         parents [{:page/id page-id     ; db id or a map {:block/name "xxx"}
                   :block/level 0
                   :block/level-spaces 0}]
         _sibling nil
         result []]
    (if (empty? blocks)
      (map #(dissoc % :block/level-spaces) result)
      (let [[block & others] blocks
            level-spaces (:block/level-spaces block)
            {:block/keys [uuid level parent] :as last-parent} (last parents)
            parent-spaces (:block/level-spaces last-parent)
            [blocks parents sibling result]
            (cond
              (= level-spaces parent-spaces)        ; sibling
              (let [block (assoc block
                                 :block/parent parent
                                 :block/left [:block/uuid uuid]
                                 :block/level level)
                    parents' (conj (vec (butlast parents)) block)
                    result' (conj result block)]
                [others parents' block result'])

              (> level-spaces parent-spaces)         ; child
              (let [parent (if uuid [:block/uuid uuid] (:page/id last-parent))
                    block (cond->
                            (assoc block
                                  :block/parent parent
                                  :block/left parent)
                            ;; fix block levels with wrong order
                            ;; For example:
                            ;;   - a
                            ;; - b
                            ;; What if the input indentation is two spaces instead of 4 spaces
                            (>= (- level-spaces parent-spaces) 1)
                            (assoc :block/level (inc level)))
                    parents' (conj parents block)
                    result' (conj result block)]
                [others parents' block result'])

              (< level-spaces parent-spaces)
              (cond
                (some #(= (:block/level-spaces %) (:block/level-spaces block)) parents) ; outdent
                (let [parents' (vec (filter (fn [p] (<= (:block/level-spaces p) level-spaces)) parents))
                      left (last parents')
                      blocks (cons (assoc (first blocks)
                                          :block/level (dec level)
                                          :block/left [:block/uuid (:block/uuid left)])
                                   (rest blocks))]
                  [blocks parents' left result])

                :else
                (let [[f r] (split-with (fn [p] (<= (:block/level-spaces p) level-spaces)) parents)
                      left (first r)
                      parent-id (if-let [block-id (:block/uuid (last f))]
                                  [:block/uuid block-id]
                                  page-id)
                      block (cond->
                              (assoc block
                                     :block/parent parent-id
                                     :block/left [:block/uuid (:block/uuid left)]
                                     :block/level (:block/level left)
                                     :block/level-spaces (:block/level-spaces left)))

                      parents' (->> (concat f [block]) vec)
                      result' (conj result block)]
                  [others parents' block result'])))]
        (recur blocks parents sibling result)))))

(defn parse-block
  ([block]
   (parse-block block nil))
  ([{:block/keys [uuid content page format] :as block} {:keys [with-id?]
                                                        :or {with-id? true}}]
   (when-not (string/blank? content)
     (let [block (dissoc block :block/pre-block?)
           ast (format/to-edn content format nil)
           blocks (extract-blocks ast content with-id? format)
           new-block (first blocks)
           parent-refs (->> (db/get-block-parent (state/get-current-repo) uuid)
                            :block/path-refs
                            (map :db/id))
           {:block/keys [refs]} new-block
           ref-pages (filter :block/name refs)
           path-ref-pages (->> (concat ref-pages parent-refs [(:db/id page)])
                               (remove nil?))
           block (cond->
                   (merge
                    block
                    new-block
                    {:block/path-refs path-ref-pages})
                   (> (count blocks) 1)
                   (assoc :block/warning :multiple-blocks))
           block (dissoc block :block/title :block/body :block/level)]
       (if uuid (assoc block :block/uuid uuid) block)))))

(defn parse-title-and-body
  ([block]
   (when (map? block)
     (merge block
            (parse-title-and-body (:block/uuid block)
                                  (:block/format block)
                                  (:block/pre-block? block)
                                  (:block/content block)))))
  ([block-uuid format pre-block? content]
   (when-not (string/blank? content)
     (let [content (if pre-block? content
                       (str (config/get-block-pattern format) " " (string/triml content)))]
       (if-let [result (state/get-block-ast block-uuid content)]
         result
         (let [ast (->> (format/to-edn content format (mldoc/default-config format))
                        (map first))
               title (when (heading-block? (first ast))
                       (:title (second (first ast))))
               body (vec (if title (rest ast) ast))
               body (drop-while property/properties-ast? body)
               result (cond->
                        (if (seq body) {:block/body body} {})
                        title
                        (assoc :block/title title))]
           (state/add-block-ast-cache! block-uuid content result)
           result))))))

(defn macro-subs
  [macro-content arguments]
  (loop [s macro-content
         args arguments
         n 1]
    (if (seq args)
      (recur
       (string/replace s (str "$" n) (first args))
       (rest args)
       (inc n))
      s)))

(defn break-line-paragraph?
  [[typ break-lines]]
  (and (= typ "Paragraph")
       (every? #(= % ["Break_Line"]) break-lines)))

(defn trim-paragraph-special-break-lines
  [ast]
  (let [[typ paras] ast]
    (if (= typ "Paragraph")
      (let [indexed-paras (map-indexed vector paras)]
        [typ (->> (filter
                            #(let [[index value] %]
                               (not (and (> index 0)
                                         (= value ["Break_Line"])
                                         (contains? #{"Timestamp" "Macro"}
                                                    (first (nth paras (dec index)))))))
                            indexed-paras)
                           (map #(last %)))])
      ast)))

(defn trim-break-lines!
  [ast]
  (drop-while break-line-paragraph?
              (map trim-paragraph-special-break-lines ast)))