common.cljs 31 KB

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