common.cljs 29 KB

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