(ns frontend.format.block (:require [frontend.util :as util :refer-macros [profile]] [clojure.walk :as walk] [clojure.string :as string] [frontend.format :as format] [frontend.utf8 :as utf8] [medley.core :as medley] [frontend.config :as config] [datascript.core :as d] [frontend.date :as date] [frontend.text :as text] [medley.core :as medley] [frontend.state :as state] [frontend.db :as db])) (defn heading-block? [block] (and (vector? block) (= "Heading" (first block)))) (defn get-tag [block] (and (vector? block) (= "Tag" (first block)) (second block))) (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 "Search") ;; FIXME: alert error (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)] (let [argument (string/join ", " arguments)] (when (and (= name "embed") (string? argument) (text/page-ref? argument)) (text/page-ref-un-brackets! argument)))) (and (vector? block) (= "Tag" (first block))) (let [text (second block)] (when (and (string? text) (text/page-ref? text)) (text/page-ref-un-brackets! text))) :else nil)] (cond (and (string? page) (text/block-ref? page)) (text/block-ref-un-brackets! page) (and (string? page) (not (string/blank? page))) (string/trim page) :else nil))) (defn get-block-reference [block] (when-let [block-id (cond (and (vector? block) (= "Block_reference" (first block))) (last 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)) (= "id" (:protocol (second (:url (second block)))))) (:link (second (:url (second block)))) :else nil)] (when (and block-id (util/uuid-string? block-id)) block-id))) ;; FIXME: (defn extract-title [block] (-> (:title (second block)) first second)) (defn paragraph-block? [block] (and (vector? block) (= "Paragraph" (first block)))) (defn hiccup-block? [block] (and (vector? block) (= "Hiccup" (first block)))) (defn timestamp-block? [block] (and (vector? block) (= "Timestamp" (first block)))) (defn properties-block? [block] (and (vector? block) (= "Property_Drawer" (first block)))) (defn definition-list-block? [block] (and (vector? block) (= "List" (first block)) (:name (first (second block))))) (defonce non-parsing-properties (atom #{"background-color" "background_color"})) (defn extract-properties [[_ properties] _start-pos _end-pos] (let [properties (into {} properties) page-refs (->> (map (fn [v] (when (string? v) (let [page-refs (->> (re-seq text/page-ref-re v) (map second)) tags (->> (string/split v #",") (filter (fn [s] (= \# (first s)))) (map (fn [s] (subs s 1))))] (concat page-refs tags)))) (vals properties)) (apply concat) (remove string/blank?)) properties (->> properties (medley/map-kv (fn [k v] (let [v (string/trim v) k (string/replace k " " "-") k (string/replace k "_" "-") k (string/lower-case k) v (cond (= v "true") true (= v "false") false (re-find #"^\d+$" v) (util/safe-parse-int v) (and (= "\"" (first v) (last v))) ; wrapped in "" (string/trim (subs v 1 (dec (count v)))) (contains? @non-parsing-properties (string/lower-case k)) v :else (let [v' v ;; built-in collections comma? (contains? #{"tags" "alias"} k)] (if (and k v' (contains? config/markers k) (util/safe-parse-int v')) (util/safe-parse-int v') (text/split-page-refs-without-brackets v' comma?))))] [(keyword k) v]))))] {:properties properties :page-refs page-refs})) (defn- paragraph-timestamp-block? [block] (and (paragraph-block? block) (timestamp-block? (first (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 :scheduled-ast v} :deadline {:deadline day :deadline-ast v}) repetition (assoc :repeated? true))))))] (apply merge m))) (defn convert-page-if-journal "Convert journal file name to user' custom date format" [original-page-name] (let [page-name (string/lower-case original-page-name) day (date/journal-title->int page-name)] (if day (let [original-page-name (date/int->journal-title day)] [original-page-name (string/lower-case original-page-name) day]) [original-page-name page-name day]))) (defn page-name->map [original-page-name with-id?] (when original-page-name (let [[original-page-name page-name journal-day] (convert-page-if-journal original-page-name) m (merge {:block/name page-name :block/original-name original-page-name} (when with-id? (if-let [block (db/entity [:block/name page-name])] {} {:block/uuid (db/new-block-id)})))] (if journal-day (merge m {:block/journal? true :block/journal-day journal-day}) (assoc m :block/journal? false))))) (defn with-page-refs [{:keys [title body tags refs] :as block} with-id?] (let [refs (->> (concat tags refs) (remove string/blank?) (distinct)) refs (atom refs)] (walk/postwalk (fn [form] (when-let [page (get-page-reference form)] (swap! refs conj page)) (when-let [tag (get-tag form)] (when (util/tag-valid? tag) (swap! refs conj tag))) form) (concat title body)) (let [refs (remove string/blank? @refs) children-pages (->> (mapcat (fn [p] (when (and (string/includes? p "/") (not (string/starts-with? p "../")) (not (string/starts-with? p "./")) (not (string/starts-with? p "http"))) ;; Don't create the last page for now (butlast (string/split p #"/")))) refs) (remove string/blank?)) 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 update-src-pos-meta! [{:keys [body] :as block}] (let [body (walk/postwalk (fn [form] (if (and (vector? form) (= (first form) "Src") (map? (:pos_meta (second form)))) (let [{:keys [start_pos end_pos]} (:pos_meta (second form)) new_start_pos (- start_pos (get-in block [:meta :start-pos]))] ["Src" (assoc (second form) :pos_meta {:start_pos new_start_pos :end_pos (+ new_start_pos (- end_pos start_pos))})]) form)) body)] (assoc block :body body))) (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 (string/lower-case ref)} ref))) (remove vector?) (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] [:block/name (string/lower-case tag)]) tags)) block)) (defn extract-blocks [blocks content with-id? format] (let [encoded-content (utf8/encode content) last-pos (utf8/length encoded-content) pre-block-body (atom nil) blocks (loop [headings [] block-body [] blocks (reverse blocks) timestamps {} properties {} last-pos last-pos last-level 1000 children []] (if (seq blocks) (let [[block {:keys [start_pos end_pos]}] (first blocks) unordered? (:unordered (second block)) markdown-heading? (and (false? unordered?) (= :markdown format))] (cond (paragraph-timestamp-block? block) (let [timestamps (extract-timestamps block) 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)) (properties-block? block) (let [properties (extract-properties block start_pos end_pos)] (recur headings block-body (rest blocks) timestamps properties last-pos last-level children)) (heading-block? block) (let [id (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 (string/trim custom-id)] (when (util/uuid-string? custom-id) (uuid custom-id)))) (db/new-block-id)) ref-pages-in-properties (->> (:page-refs properties) (remove string/blank?)) block (second block) block (if markdown-heading? (assoc block :type :heading :level 1 :heading-level (:level block)) 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 (-> (assoc block :uuid id :body (vec (reverse block-body)) :properties (:properties properties) :refs ref-pages-in-properties :children (or current-block-children [])) (assoc-in [:meta :start-pos] start_pos) (assoc-in [:meta :end-pos] last-pos)) block (if (seq timestamps) (merge block (timestamps->scheduled-and-deadline timestamps)) block) block (-> block (with-page-refs with-id?) with-block-refs block-tags->pages update-src-pos-meta!) last-pos' (get-in block [:meta :start-pos])] (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)))) (do (when (seq block-body) (reset! pre-block-body (reverse block-body))) (-> (reverse headings) safe-blocks))))] (let [first-block (first blocks) first-block-start-pos (get-in first-block [:block/meta :start-pos]) blocks (if (seq @pre-block-body) (cons (merge (let [content (utf8/substring encoded-content 0 first-block-start-pos)] (-> {:uuid (db/new-block-id) :content content :level 1 :meta {:start-pos 0 :end-pos (or first-block-start-pos (utf8/length encoded-content))} :body @pre-block-body :pre-block? true} (block-keywordize))) (select-keys first-block [:block/file :block/format :block/page])) blocks) blocks)] (with-path-refs blocks)))) (defn with-parent-and-left [page-id blocks] (loop [blocks blocks parents [{:page/id page-id ; db id or lookup ref [:block/name "xxx"] :block/level 0}] result []] (if (empty? blocks) result (let [[block & others] blocks cur-level (:block/level block) {:block/keys [uuid level parent] :as last-parent} (last parents) [blocks parents result] (cond (= cur-level level) ; sibling (let [block (assoc block :block/parent parent :block/left [:block/uuid uuid]) parents' (conj (vec (butlast parents)) block) result' (conj result block)] [others parents' result']) (> cur-level level) ; child (let [parent (if uuid [:block/uuid uuid] (:page/id last-parent)) block (assoc block :block/parent parent :block/left parent) parents' (conj parents block) result' (conj result block)] [others parents' result']) (< cur-level level) ; outdent (let [parents' (vec (filter (fn [p] (<= (:block/level p) cur-level)) parents))] [blocks parents' result]))] (recur blocks parents result))))) (defn parse-block ([block] (parse-block block nil)) ([{:block/keys [uuid content meta file page parent left 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) new-block (first (extract-blocks ast content with-id? format)) 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) block (merge block new-block {:block/path-refs path-ref-pages})] (if uuid (assoc block :block/uuid uuid) block))))) (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-break-lines! [ast] (drop-while break-line-paragraph? ast))