common.cljs 31 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836
  1. (ns frontend.handler.export.common
  2. "common fns for exporting.
  3. exclude some fns which produce lazy-seq, which can cause strange behaviors
  4. when use together with dynamic var."
  5. (:refer-clojure :exclude [map filter mapcat concat remove])
  6. (:require [cljs.core.match :refer [match]]
  7. [clojure.string :as string]
  8. [frontend.common.file.core :as common-file]
  9. [frontend.db :as db]
  10. [frontend.format.mldoc :as mldoc]
  11. [frontend.modules.file.core :as outliner-file]
  12. [frontend.modules.outliner.tree :as outliner-tree]
  13. [frontend.persist-db.browser :as db-browser]
  14. [frontend.state :as state]
  15. [frontend.util :as util :refer [concatv mapcatv removev]]
  16. [malli.core :as m]
  17. [malli.util :as mu]
  18. [promesa.core :as p]))
  19. ;;; TODO: split frontend.handler.export.text related states
  20. (def ^:dynamic *state*
  21. "dynamic var, state used for exporting"
  22. {;; current level of Heading, start from 1(same as mldoc), use when `block-ast->simple-ast`
  23. :current-level 1
  24. ;; emphasis symbol (use when `block-ast->simple-ast`)
  25. :outside-em-symbol nil
  26. ;; (use when `block-ast->simple-ast`)
  27. :indent-after-break-line? false
  28. ;; TODO: :last-empty-heading? false
  29. ;; current: | want:
  30. ;; - | - xxx
  31. ;; xxx | yyy
  32. ;; yyy |
  33. ;; this submap is used when replace block-reference, block-embed, page-embed
  34. :replace-ref-embed
  35. {;; start from 1
  36. :current-level 1
  37. :block-ref-replaced? false
  38. :block&page-embed-replaced? false}
  39. ;; submap for :newline-after-block internal state
  40. :newline-after-block
  41. {:current-block-is-first-heading-block? true}
  42. ;; export-options submap
  43. :export-options
  44. {;; dashes, spaces, no-indent
  45. :indent-style "dashes"
  46. :remove-page-ref-brackets? false
  47. :remove-emphasis? false
  48. :remove-tags? false
  49. :remove-properties? true
  50. :keep-only-level<=N :all
  51. :newline-after-block false}})
  52. ;;; internal utils
  53. (defn- get-blocks-contents
  54. [repo root-block-uuid & {:keys [init-level]
  55. :or {init-level 1}}]
  56. (-> (db/pull-many (keep :db/id (db/get-block-and-children repo root-block-uuid)))
  57. (outliner-tree/blocks->vec-tree (str root-block-uuid))
  58. (outliner-file/tree->file-content {:init-level init-level})))
  59. (defn root-block-uuids->content
  60. [repo root-block-uuids & {:keys [page-title-only?]}]
  61. (let [contents (mapv (fn [id]
  62. (if-let [page (and page-title-only?
  63. (let [e (db/entity [:block/uuid id])]
  64. (when (:block/name e)
  65. e)))]
  66. (:block/title page)
  67. (get-blocks-contents repo id))) root-block-uuids)]
  68. (string/join "\n" (mapv string/trim-newline contents))))
  69. (declare remove-block-ast-pos Properties-block-ast?)
  70. (defn- block-uuid->ast
  71. [block-uuid]
  72. (let [block (into {} (db/get-block-by-uuid block-uuid))
  73. content (outliner-file/tree->file-content [block] {:init-level 1})
  74. format :markdown]
  75. (when content
  76. (removev Properties-block-ast?
  77. (mapv remove-block-ast-pos
  78. (mldoc/->edn content format))))))
  79. (defn- block-uuid->ast-with-children
  80. [block-uuid]
  81. (let [content (get-blocks-contents (state/get-current-repo) block-uuid)
  82. format :markdown]
  83. (when content
  84. (removev Properties-block-ast?
  85. (mapv remove-block-ast-pos
  86. (mldoc/->edn content format))))))
  87. (defn get-page-content
  88. [page-uuid]
  89. (let [repo (state/get-current-repo)
  90. db (db/get-db repo)]
  91. (common-file/block->content repo db page-uuid
  92. nil
  93. {:export-bullet-indentation (state/get-export-bullet-indentation)})))
  94. (defn- page-name->ast
  95. [page-name]
  96. (let [page (db/get-page page-name)]
  97. (when-let [content (get-page-content (:block/uuid page))]
  98. (when content
  99. (let [format :markdown]
  100. (removev Properties-block-ast?
  101. (mapv remove-block-ast-pos
  102. (mldoc/->edn content format))))))))
  103. (defn- update-level-in-block-ast-coll
  104. [block-ast-coll origin-level]
  105. (mapv
  106. (fn [block-ast]
  107. (let [[ast-type ast-content] block-ast]
  108. (if (= ast-type "Heading")
  109. [ast-type (update ast-content :level #(+ (dec %) origin-level))]
  110. block-ast)))
  111. block-ast-coll))
  112. (defn- plain-indent-inline-ast
  113. [level & {:keys [spaces] :or {spaces " "}}]
  114. ["Plain" (str (reduce str (repeat (dec level) "\t")) spaces)])
  115. (defn- mk-paragraph-ast
  116. [inline-coll meta]
  117. (with-meta ["Paragraph" inline-coll] meta))
  118. ;;; internal utils (ends)
  119. ;;; utils
  120. (defn priority->string
  121. [priority]
  122. (str "[#" priority "]"))
  123. (defn- repetition-to-string
  124. [[[kind] [duration] n]]
  125. (let [kind (case kind
  126. "Dotted" "."
  127. "Plus" "+"
  128. "DoublePlus" "++")]
  129. (str kind n (string/lower-case (str (first duration))))))
  130. (defn timestamp-to-string
  131. [{:keys [date time repetition wday active]}]
  132. (let [{:keys [year month day]} date
  133. {:keys [hour min]} time
  134. [open close] (if active ["<" ">"] ["[" "]"])
  135. repetition (if repetition
  136. (str " " (repetition-to-string repetition))
  137. "")
  138. hour (when hour (util/zero-pad hour))
  139. min (when min (util/zero-pad min))
  140. time (cond
  141. (and hour min)
  142. (util/format " %s:%s" hour min)
  143. hour
  144. (util/format " %s" hour)
  145. :else
  146. "")]
  147. (util/format "%s%s-%s-%s %s%s%s%s"
  148. open
  149. (str year)
  150. (util/zero-pad month)
  151. (util/zero-pad day)
  152. wday
  153. time
  154. repetition
  155. close)))
  156. (defn hashtag-value->string
  157. [inline-coll]
  158. (reduce str
  159. (mapv
  160. (fn [inline]
  161. (let [[ast-type ast-content] inline]
  162. (case ast-type
  163. "Nested_link"
  164. (:content ast-content)
  165. "Link"
  166. (:full_text ast-content)
  167. "Plain"
  168. ast-content)))
  169. inline-coll)))
  170. (defn <get-all-pages
  171. [repo]
  172. (when-let [worker @db-browser/*worker]
  173. (worker :thread-api/export-get-all-pages repo)))
  174. (defn <get-debug-datoms
  175. [repo]
  176. (when-let [worker @db-browser/*worker]
  177. (worker :thread-api/export-get-debug-datoms repo)))
  178. (defn <get-all-page->content
  179. [repo]
  180. (when-let [worker @db-browser/*worker]
  181. (worker :thread-api/export-get-all-page->content repo)))
  182. (defn <get-file-contents
  183. [repo suffix]
  184. (p/let [page->content (<get-all-page->content repo)]
  185. (clojure.core/map (fn [[page-title content]]
  186. {:path (str page-title "." suffix)
  187. :content content
  188. :title page-title
  189. :format :markdown})
  190. page->content)))
  191. ;;; utils (ends)
  192. ;;; replace block-ref, block-embed, page-embed
  193. (defn- replace-block-reference-in-heading
  194. [{:keys [title] :as ast-content}]
  195. (let [inline-coll title
  196. inline-coll*
  197. (mapcatv
  198. #(match [%]
  199. [["Link" {:url ["Block_ref" block-uuid]}]]
  200. (let [[[_ {title-inline-coll :title}]]
  201. (block-uuid->ast (uuid block-uuid))]
  202. (set! *state* (assoc-in *state* [:replace-ref-embed :block-ref-replaced?] true))
  203. title-inline-coll)
  204. :else [%])
  205. inline-coll)]
  206. (assoc ast-content :title inline-coll*)))
  207. (defn- replace-block-reference-in-paragraph
  208. [inline-coll]
  209. (mapcatv
  210. #(match [%]
  211. [["Link" {:url ["Block_ref" block-uuid]}]]
  212. (let [[[_ {title-inline-coll :title}]]
  213. (block-uuid->ast (uuid block-uuid))]
  214. (set! *state* (assoc-in *state* [:replace-ref-embed :block-ref-replaced?] true))
  215. title-inline-coll)
  216. :else [%])
  217. inline-coll))
  218. (declare replace-block-references)
  219. (defn- replace-block-reference-in-list
  220. [list-items]
  221. (mapv
  222. (fn [{block-ast-coll :content sub-items :items :as item}]
  223. (assoc item
  224. :content (mapv replace-block-references block-ast-coll)
  225. :items (replace-block-reference-in-list sub-items)))
  226. list-items))
  227. (defn- replace-block-reference-in-quote
  228. [block-ast-coll]
  229. (mapv replace-block-references block-ast-coll))
  230. (defn- replace-block-reference-in-table
  231. [{:keys [header groups] :as table}]
  232. (let [header*
  233. (mapv
  234. (fn [col]
  235. (mapcatv
  236. #(match [%]
  237. [["Link" {:url ["Block_ref" block-uuid]}]]
  238. (let [[[_ {title-inline-coll :title}]]
  239. (block-uuid->ast (uuid block-uuid))]
  240. (set! *state* (assoc-in *state* [:replace-ref-embed :block-ref-replaced?] true))
  241. title-inline-coll)
  242. :else [%])
  243. col))
  244. header)
  245. groups*
  246. (mapv
  247. (fn [group]
  248. (mapv
  249. (fn [row]
  250. (mapv
  251. (fn [col]
  252. (mapcatv
  253. #(match [%]
  254. [["Link" {:url ["Block_ref" block-uuid]}]]
  255. (let [[[_ {title-inline-coll :title}]]
  256. (block-uuid->ast (uuid block-uuid))]
  257. (set! *state* (assoc-in *state* [:replace-ref-embed :block-ref-replaced?] true))
  258. title-inline-coll)
  259. :else [%])
  260. col))
  261. row))
  262. group))
  263. groups)]
  264. (assoc table :header header* :groups groups*)))
  265. (defn- replace-block-references
  266. [block-ast]
  267. (let [[ast-type ast-content] block-ast]
  268. (case ast-type
  269. "Heading"
  270. [ast-type (replace-block-reference-in-heading ast-content)]
  271. "Paragraph"
  272. (mk-paragraph-ast (replace-block-reference-in-paragraph ast-content) (meta block-ast))
  273. "List"
  274. [ast-type (replace-block-reference-in-list ast-content)]
  275. "Quote"
  276. [ast-type (replace-block-reference-in-quote ast-content)]
  277. "Table"
  278. [ast-type (replace-block-reference-in-table ast-content)]
  279. ;; else
  280. block-ast)))
  281. (defn- replace-block-references-until-stable
  282. [block-ast]
  283. (binding [*state* *state*]
  284. (loop [block-ast block-ast]
  285. (let [block-ast* (replace-block-references block-ast)]
  286. (if (get-in *state* [:replace-ref-embed :block-ref-replaced?])
  287. (do (set! *state* (assoc-in *state* [:replace-ref-embed :block-ref-replaced?] false))
  288. (recur block-ast*))
  289. block-ast*)))))
  290. (defn- replace-block-embeds-helper
  291. [current-paragraph-inlines block-uuid blocks-tcoll level]
  292. (let [block-uuid* (subs block-uuid 2 (- (count block-uuid) 2))
  293. ast-coll (update-level-in-block-ast-coll
  294. (block-uuid->ast-with-children (uuid block-uuid*))
  295. level)]
  296. (cond-> blocks-tcoll
  297. (seq current-paragraph-inlines)
  298. (conj! ["Paragraph" current-paragraph-inlines])
  299. true
  300. (#(reduce conj! % ast-coll)))))
  301. (defn- replace-page-embeds-helper
  302. [current-paragraph-inlines page-name blocks-tcoll level]
  303. (let [page-name* (subs page-name 2 (- (count page-name) 2))
  304. ast-coll (update-level-in-block-ast-coll
  305. (page-name->ast page-name*)
  306. level)]
  307. (cond-> blocks-tcoll
  308. (seq current-paragraph-inlines)
  309. (conj! ["Paragraph" current-paragraph-inlines])
  310. true
  311. (#(reduce conj! % ast-coll)))))
  312. (defn- replace-block&page-embeds-in-heading
  313. [{inline-coll :title origin-level :level :as ast-content}]
  314. (set! *state* (assoc-in *state* [:replace-ref-embed :current-level] origin-level))
  315. (if (empty? inline-coll)
  316. ;; it's just a empty Heading, return itself
  317. [["Heading" ast-content]]
  318. (loop [[inline & other-inlines] inline-coll
  319. heading-exist? false
  320. current-paragraph-inlines []
  321. r (transient [])]
  322. (if-not inline
  323. (persistent!
  324. (if (seq current-paragraph-inlines)
  325. (conj! r (if heading-exist?
  326. ["Paragraph" current-paragraph-inlines]
  327. ["Heading" (assoc ast-content :title current-paragraph-inlines)]))
  328. r))
  329. (match [inline]
  330. [["Macro" {:name "embed" :arguments [block-uuid-or-page-name]}]]
  331. (cond
  332. (and (string/starts-with? block-uuid-or-page-name "((")
  333. (string/ends-with? block-uuid-or-page-name "))"))
  334. (do (set! *state* (assoc-in *state* [:replace-ref-embed :block&page-embed-replaced?] true))
  335. (recur other-inlines true []
  336. (replace-block-embeds-helper
  337. current-paragraph-inlines block-uuid-or-page-name r origin-level)))
  338. (and (string/starts-with? block-uuid-or-page-name "[[")
  339. (string/ends-with? block-uuid-or-page-name "]]"))
  340. (do (set! *state* (assoc-in *state* [:replace-ref-embed :block&page-embed-replaced?] true))
  341. (recur other-inlines true []
  342. (replace-page-embeds-helper
  343. current-paragraph-inlines block-uuid-or-page-name r origin-level)))
  344. :else ;; not ((block-uuid)) or [[page-name]], just drop the original ast
  345. (recur other-inlines heading-exist? current-paragraph-inlines r))
  346. :else
  347. (let [current-paragraph-inlines*
  348. (if (and (empty? current-paragraph-inlines)
  349. heading-exist?)
  350. (conj current-paragraph-inlines (plain-indent-inline-ast origin-level))
  351. current-paragraph-inlines)]
  352. (recur other-inlines heading-exist? (conj current-paragraph-inlines* inline) r)))))))
  353. (defn- replace-block&page-embeds-in-paragraph
  354. [inline-coll meta]
  355. (let [current-level (get-in *state* [:replace-ref-embed :current-level])]
  356. (loop [[inline & other-inlines] inline-coll
  357. current-paragraph-inlines []
  358. just-after-embed? false
  359. blocks (transient [])]
  360. (if-not inline
  361. (let [[first-block & other-blocks] (persistent!
  362. (if (seq current-paragraph-inlines)
  363. (conj! blocks ["Paragraph" current-paragraph-inlines])
  364. blocks))]
  365. (if first-block
  366. (apply vector (with-meta first-block meta) other-blocks)
  367. []))
  368. (match [inline]
  369. [["Macro" {:name "embed" :arguments [block-uuid-or-page-name]}]]
  370. (cond
  371. (and (string/starts-with? block-uuid-or-page-name "((")
  372. (string/ends-with? block-uuid-or-page-name "))"))
  373. (do (set! *state* (assoc-in *state* [:replace-ref-embed :block&page-embed-replaced?] true))
  374. (recur other-inlines [] true
  375. (replace-block-embeds-helper
  376. current-paragraph-inlines block-uuid-or-page-name blocks current-level)))
  377. (and (string/starts-with? block-uuid-or-page-name "[[")
  378. (string/ends-with? block-uuid-or-page-name "]]"))
  379. (do (set! *state* (assoc-in *state* [:replace-ref-embed :block&page-embed-replaced?] true))
  380. (recur other-inlines [] true
  381. (replace-page-embeds-helper
  382. current-paragraph-inlines block-uuid-or-page-name blocks current-level)))
  383. :else ;; not ((block-uuid)) or [[page-name]], just drop the original ast
  384. (recur other-inlines current-paragraph-inlines false blocks))
  385. :else
  386. (let [current-paragraph-inlines*
  387. (if just-after-embed?
  388. (conj current-paragraph-inlines (plain-indent-inline-ast current-level))
  389. current-paragraph-inlines)]
  390. (recur other-inlines (conj current-paragraph-inlines* inline) false blocks)))))))
  391. (declare replace-block&page-embeds)
  392. (defn- replace-block&page-embeds-in-list-helper
  393. [list-items]
  394. (binding [*state* (update-in *state* [:replace-ref-embed :current-level] inc)]
  395. (mapv
  396. (fn [{block-ast-coll :content sub-items :items :as item}]
  397. (assoc item
  398. :content (mapcatv replace-block&page-embeds block-ast-coll)
  399. :items (replace-block&page-embeds-in-list-helper sub-items)))
  400. list-items)))
  401. (defn- replace-block&page-embeds-in-list
  402. [list-items]
  403. [["List" (replace-block&page-embeds-in-list-helper list-items)]])
  404. (defn- replace-block&page-embeds-in-quote
  405. [block-ast-coll]
  406. (->> block-ast-coll
  407. (mapcatv replace-block&page-embeds)
  408. (vector "Quote")
  409. vector))
  410. (defn- replace-block&page-embeds
  411. [block-ast]
  412. (let [[ast-type ast-content] block-ast]
  413. (case ast-type
  414. "Heading"
  415. (replace-block&page-embeds-in-heading ast-content)
  416. "Paragraph"
  417. (replace-block&page-embeds-in-paragraph ast-content (meta block-ast))
  418. "List"
  419. (replace-block&page-embeds-in-list ast-content)
  420. "Quote"
  421. (replace-block&page-embeds-in-quote ast-content)
  422. "Table"
  423. ;; TODO: block&page embeds in table are not replaced yet
  424. [block-ast]
  425. ;; else
  426. [block-ast])))
  427. (defn replace-block&page-reference&embed
  428. "add meta :embed-depth to the embed replaced block-ast,
  429. to avoid too deep block-ref&embed (or maybe it's a cycle)"
  430. [block-ast-coll]
  431. (loop [block-ast-coll block-ast-coll
  432. result-block-ast-tcoll (transient [])
  433. block-ast-coll-to-replace-references []
  434. block-ast-coll-to-replace-embeds []]
  435. (cond
  436. (seq block-ast-coll-to-replace-references)
  437. (let [[block-ast-to-replace-ref & other-block-asts-to-replace-ref]
  438. block-ast-coll-to-replace-references
  439. embed-depth (:embed-depth (meta block-ast-to-replace-ref) 0)
  440. block-ast-replaced (-> (replace-block-references-until-stable block-ast-to-replace-ref)
  441. (with-meta {:embed-depth embed-depth}))]
  442. (if (>= embed-depth 5)
  443. ;; if :embed-depth >= 5, dont replace embed for this block anymore
  444. ;; there is too deep, or maybe it just a ref/embed cycle
  445. (recur block-ast-coll (conj! result-block-ast-tcoll block-ast-replaced)
  446. (vec other-block-asts-to-replace-ref) block-ast-coll-to-replace-embeds)
  447. (recur block-ast-coll result-block-ast-tcoll (vec other-block-asts-to-replace-ref)
  448. (conj block-ast-coll-to-replace-embeds block-ast-replaced))))
  449. (seq block-ast-coll-to-replace-embeds)
  450. (let [[block-ast-to-replace-embed & other-block-asts-to-replace-embed]
  451. block-ast-coll-to-replace-embeds
  452. embed-depth (:embed-depth (meta block-ast-to-replace-embed) 0)
  453. block-ast-coll-replaced (->> (replace-block&page-embeds block-ast-to-replace-embed)
  454. (mapv #(with-meta % {:embed-depth (inc embed-depth)})))]
  455. (if (get-in *state* [:replace-ref-embed :block&page-embed-replaced?])
  456. (do (set! *state* (assoc-in *state* [:replace-ref-embed :block&page-embed-replaced?] false))
  457. (recur block-ast-coll result-block-ast-tcoll
  458. (concatv block-ast-coll-to-replace-references block-ast-coll-replaced)
  459. (vec other-block-asts-to-replace-embed)))
  460. (recur block-ast-coll (reduce conj! result-block-ast-tcoll block-ast-coll-replaced)
  461. (vec block-ast-coll-to-replace-references) (vec other-block-asts-to-replace-embed))))
  462. :else
  463. (let [[block-ast & other-block-ast] block-ast-coll]
  464. (if-not block-ast
  465. (persistent! result-block-ast-tcoll)
  466. (recur other-block-ast result-block-ast-tcoll
  467. (conj block-ast-coll-to-replace-references block-ast)
  468. (vec block-ast-coll-to-replace-embeds)))))))
  469. ;;; replace block-ref, block-embed, page-embed (ends)
  470. (def remove-block-ast-pos
  471. "[[ast-type ast-content] _pos] -> [ast-type ast-content]"
  472. first)
  473. (defn Properties-block-ast?
  474. [[tp _]]
  475. (= tp "Properties"))
  476. (defn replace-Heading-with-Paragraph
  477. "works on block-ast
  478. replace all heading with paragraph when indent-style is no-indent"
  479. [heading-ast]
  480. (let [[heading-type {:keys [title marker priority size]}] heading-ast]
  481. (if (= heading-type "Heading")
  482. (let [inline-coll
  483. (cond->> title
  484. priority (cons ["Plain" (str (priority->string priority) " ")])
  485. marker (cons ["Plain" (str marker " ")])
  486. size (cons ["Plain" (str (reduce str (repeat size "#")) " ")])
  487. true vec)]
  488. (mk-paragraph-ast inline-coll {:origin-ast heading-ast}))
  489. heading-ast)))
  490. (defn keep-only-level<=n
  491. [block-ast-coll n]
  492. (-> (reduce
  493. (fn [{:keys [result-ast-tcoll accepted-heading] :as r} ast]
  494. (let [[heading-type {level :level}] ast
  495. is-heading? (= heading-type "Heading")]
  496. (cond
  497. (and (not is-heading?) accepted-heading)
  498. {:result-ast-tcoll (conj! result-ast-tcoll ast) :accepted-heading accepted-heading}
  499. (and (not is-heading?) (not accepted-heading))
  500. r
  501. (and is-heading? (<= level n))
  502. {:result-ast-tcoll (conj! result-ast-tcoll ast) :accepted-heading true}
  503. (and is-heading? (> level n))
  504. {:result-ast-tcoll result-ast-tcoll :accepted-heading false})))
  505. {:result-ast-tcoll (transient []) :accepted-heading false}
  506. block-ast-coll)
  507. :result-ast-tcoll
  508. persistent!))
  509. ;;; inline transformers
  510. (defn remove-emphasis
  511. ":mapcat-fns-on-inline-ast"
  512. [inline-ast]
  513. (let [[ast-type ast-content] inline-ast]
  514. (case ast-type
  515. "Emphasis"
  516. (let [[_ inline-coll] ast-content]
  517. inline-coll)
  518. ;; else
  519. [inline-ast])))
  520. (defn remove-page-ref-brackets
  521. ":map-fns-on-inline-ast"
  522. [inline-ast]
  523. (let [[ast-type ast-content] inline-ast]
  524. (case ast-type
  525. "Link"
  526. (let [{:keys [url label]} ast-content]
  527. (if (and (= "Page_ref" (first url))
  528. (or (empty? label)
  529. (= label [["Plain" ""]])))
  530. ["Plain" (second url)]
  531. inline-ast))
  532. ;; else
  533. inline-ast)))
  534. (defn remove-tags
  535. ":mapcat-fns-on-inline-ast"
  536. [inline-ast]
  537. (let [[ast-type _ast-content] inline-ast]
  538. (case ast-type
  539. "Tag"
  540. []
  541. ;; else
  542. [inline-ast])))
  543. (defn remove-prefix-spaces-in-Plain
  544. [inline-coll]
  545. (:r
  546. (reduce
  547. (fn [{:keys [r after-break-line?]} ast]
  548. (let [[ast-type ast-content] ast]
  549. (case ast-type
  550. "Plain"
  551. (let [trimmed-content (string/triml ast-content)]
  552. (if after-break-line?
  553. (if (empty? trimmed-content)
  554. {:r r :after-break-line? false}
  555. {:r (conj r ["Plain" trimmed-content]) :after-break-line? false})
  556. {:r (conj r ast) :after-break-line? false}))
  557. ("Break_Line" "Hard_Break_Line")
  558. {:r (conj r ast) :after-break-line? true}
  559. ;; else
  560. {:r (conj r ast) :after-break-line? false})))
  561. {:r [] :after-break-line? true}
  562. inline-coll)))
  563. ;;; inline transformers (ends)
  564. ;;; walk on block-ast, apply inline transformers
  565. (defn- walk-block-ast-helper
  566. [inline-coll map-fns-on-inline-ast mapcat-fns-on-inline-ast fns-on-inline-coll]
  567. (->>
  568. (reduce (fn [inline-coll f] (f inline-coll)) inline-coll fns-on-inline-coll)
  569. (mapv #(reduce (fn [inline-ast f] (f inline-ast)) % map-fns-on-inline-ast))
  570. (mapcatv #(reduce
  571. (fn [inline-ast-coll f] (mapcatv f inline-ast-coll)) [%] mapcat-fns-on-inline-ast))))
  572. (declare walk-block-ast)
  573. (defn- walk-block-ast-for-list
  574. [list-items map-fns-on-inline-ast mapcat-fns-on-inline-ast]
  575. (mapv
  576. (fn [{block-ast-coll :content sub-items :items :as item}]
  577. (assoc item
  578. :content
  579. (mapv
  580. (partial walk-block-ast
  581. {:map-fns-on-inline-ast map-fns-on-inline-ast
  582. :mapcat-fns-on-inline-ast mapcat-fns-on-inline-ast})
  583. block-ast-coll)
  584. :items
  585. (walk-block-ast-for-list sub-items map-fns-on-inline-ast mapcat-fns-on-inline-ast)))
  586. list-items))
  587. (defn walk-block-ast
  588. [{:keys [map-fns-on-inline-ast mapcat-fns-on-inline-ast fns-on-inline-coll] :as fns}
  589. block-ast]
  590. (let [[ast-type ast-content] block-ast]
  591. (case ast-type
  592. "Paragraph"
  593. (mk-paragraph-ast
  594. (walk-block-ast-helper ast-content map-fns-on-inline-ast mapcat-fns-on-inline-ast fns-on-inline-coll)
  595. (meta block-ast))
  596. "Heading"
  597. (let [{:keys [title]} ast-content]
  598. ["Heading"
  599. (assoc ast-content
  600. :title
  601. (walk-block-ast-helper title map-fns-on-inline-ast mapcat-fns-on-inline-ast fns-on-inline-coll))])
  602. "List"
  603. ["List" (walk-block-ast-for-list ast-content map-fns-on-inline-ast mapcat-fns-on-inline-ast)]
  604. "Quote"
  605. ["Quote" (mapv (partial walk-block-ast fns) ast-content)]
  606. "Footnote_Definition"
  607. (let [[name contents] (rest block-ast)]
  608. ["Footnote_Definition"
  609. name (walk-block-ast-helper contents map-fns-on-inline-ast mapcat-fns-on-inline-ast fns-on-inline-coll)])
  610. "Table"
  611. (let [{:keys [header groups]} ast-content
  612. header* (mapv
  613. #(walk-block-ast-helper % map-fns-on-inline-ast mapcat-fns-on-inline-ast fns-on-inline-coll)
  614. header)
  615. groups* (mapv
  616. (fn [group]
  617. (mapv
  618. (fn [row]
  619. (mapv
  620. (fn [col]
  621. (walk-block-ast-helper col map-fns-on-inline-ast mapcat-fns-on-inline-ast fns-on-inline-coll))
  622. row))
  623. group))
  624. groups)]
  625. ["Table" (assoc ast-content :header header* :groups groups*)])
  626. ;; else
  627. block-ast)))
  628. ;;; walk on block-ast, apply inline transformers (ends)
  629. ;;; simple ast
  630. (def simple-ast-malli-schema
  631. (mu/closed-schema
  632. [:or
  633. [:map
  634. [:type [:= :raw-text]]
  635. [:content :string]]
  636. [:map
  637. [:type [:= :space]]]
  638. [:map
  639. [:type [:= :newline]]
  640. [:line-count :int]]
  641. [:map
  642. [:type [:= :indent]]
  643. [:level :int]
  644. [:extra-space-count :int]]]))
  645. (defn raw-text [& contents]
  646. {:type :raw-text :content (reduce str contents)})
  647. (def space {:type :space})
  648. (defn newline* [line-count]
  649. {:type :newline :line-count line-count})
  650. (defn indent [level extra-space-count]
  651. {:type :indent :level level :extra-space-count extra-space-count})
  652. (defn- simple-ast->string
  653. [simple-ast]
  654. {:pre [(m/validate simple-ast-malli-schema simple-ast)]}
  655. (case (:type simple-ast)
  656. :raw-text (:content simple-ast)
  657. :space " "
  658. :newline (reduce str (repeat (:line-count simple-ast) "\n"))
  659. :indent (reduce str (concatv (repeat (:level simple-ast) "\t")
  660. (repeat (:extra-space-count simple-ast) " ")))))
  661. (defn- merge-adjacent-spaces&newlines
  662. [simple-ast-coll]
  663. (loop [r (transient [])
  664. last-ast nil
  665. last-raw-text-space-suffix? false
  666. last-raw-text-newline-suffix? false
  667. [simple-ast & other-ast-coll] simple-ast-coll]
  668. (if (nil? simple-ast)
  669. (persistent! (if last-ast (conj! r last-ast) r))
  670. (let [tp (:type simple-ast)
  671. last-ast-type (:type last-ast)]
  672. (case tp
  673. :space
  674. (if (or (contains? #{:space :newline :indent} last-ast-type)
  675. last-raw-text-space-suffix?
  676. last-raw-text-newline-suffix?)
  677. ;; drop this :space
  678. (recur r last-ast last-raw-text-space-suffix? last-raw-text-newline-suffix? other-ast-coll)
  679. (recur (if last-ast (conj! r last-ast) r) simple-ast false false other-ast-coll))
  680. :newline
  681. (case last-ast-type
  682. (:space :indent) ;; drop last-ast
  683. (recur r simple-ast false false other-ast-coll)
  684. :newline
  685. (let [last-newline-count (:line-count last-ast)
  686. current-newline-count (:line-count simple-ast)
  687. kept-ast (if (> last-newline-count current-newline-count) last-ast simple-ast)]
  688. (recur r kept-ast false false other-ast-coll))
  689. :raw-text
  690. (if last-raw-text-newline-suffix?
  691. (recur r last-ast last-raw-text-space-suffix? last-raw-text-newline-suffix? other-ast-coll)
  692. (recur (if last-ast (conj! r last-ast) r) simple-ast false false other-ast-coll))
  693. ;; no-last-ast
  694. (recur r simple-ast false false other-ast-coll))
  695. :indent
  696. (case last-ast-type
  697. (:space :indent) ; drop last-ast
  698. (recur r simple-ast false false other-ast-coll)
  699. :newline
  700. (recur (if last-ast (conj! r last-ast) r) simple-ast false false other-ast-coll)
  701. :raw-text
  702. (if last-raw-text-space-suffix?
  703. ;; drop this :indent
  704. (recur r last-ast last-raw-text-space-suffix? last-raw-text-newline-suffix? other-ast-coll)
  705. (recur (if last-ast (conj! r last-ast) r) simple-ast false false other-ast-coll))
  706. ;; no-last-ast
  707. (recur r simple-ast false false other-ast-coll))
  708. :raw-text
  709. (let [content (:content simple-ast)
  710. empty-content? (empty? content)
  711. first-ch (first content)
  712. last-ch (let [num (count content)]
  713. (when (pos? num)
  714. (nth content (dec num))))
  715. newline-prefix? (some-> first-ch #{"\r" "\n"} boolean)
  716. newline-suffix? (some-> last-ch #{"\n"} boolean)
  717. space-prefix? (some-> first-ch #{" "} boolean)
  718. space-suffix? (some-> last-ch #{" "} boolean)]
  719. (cond
  720. empty-content? ;drop this raw-text
  721. (recur r last-ast last-raw-text-space-suffix? last-raw-text-newline-suffix? other-ast-coll)
  722. newline-prefix?
  723. (case last-ast-type
  724. (:space :indent :newline) ;drop last-ast
  725. (recur r simple-ast space-suffix? newline-suffix? other-ast-coll)
  726. :raw-text
  727. (recur (if last-ast (conj! r last-ast) r) simple-ast space-suffix? newline-suffix? other-ast-coll)
  728. ;; no-last-ast
  729. (recur r simple-ast space-suffix? newline-suffix? other-ast-coll))
  730. space-prefix?
  731. (case last-ast-type
  732. (:space :indent) ;drop last-ast
  733. (recur r simple-ast space-suffix? newline-suffix? other-ast-coll)
  734. (:newline :raw-text)
  735. (recur (if last-ast (conj! r last-ast) r) simple-ast space-suffix? newline-suffix? other-ast-coll)
  736. ;; no-last-ast
  737. (recur r simple-ast space-suffix? newline-suffix? other-ast-coll))
  738. :else
  739. (recur (if last-ast (conj! r last-ast) r) simple-ast space-suffix? newline-suffix? other-ast-coll))))))))
  740. (defn simple-asts->string
  741. [simple-ast-coll]
  742. (->> simple-ast-coll
  743. merge-adjacent-spaces&newlines
  744. merge-adjacent-spaces&newlines
  745. (mapv simple-ast->string)
  746. string/join))
  747. ;;; simple ast (ends)
  748. ;;; TODO: walk the hiccup tree,
  749. ;;; and call escape-html on all its contents
  750. ;;;
  751. ;;; walk the hiccup tree,
  752. ;;; and call escape-html on all its contents (ends)