blob: 2dc90895db75f1c0f186e7f1f2ec94e42663f7c2 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
|
(ns clarktown.engine
(:require
[clojure.string :as string]))
(defn- stitch-code-blocks
"Since code blocks can span multiple blocks (a block is separated by
two line breaks from another block) , we need to stitch them together
into one block in order for a block parser to be able to do anything
with it."
[blocks]
(loop [stitched-blocks []
code-block-started? false
blocks blocks]
(if (empty? blocks)
stitched-blocks
(let [block (first blocks)]
(if (and (string/starts-with? (string/trim block) "```")
(not (string/ends-with? (string/trim block) "```")))
(recur (conj stitched-blocks block)
true
(drop 1 blocks))
(if code-block-started?
(let [last-block (last stitched-blocks)
last-block-index (- (count stitched-blocks) 1)]
(if (string/ends-with? (string/trim block) "```")
(recur (assoc stitched-blocks last-block-index (str last-block "\n\n" block))
false
(drop 1 blocks))
(recur (assoc stitched-blocks last-block-index (str last-block "\n\n" block))
true
(drop 1 blocks))))
(recur (conj stitched-blocks block)
false
(drop 1 blocks))))))))
(defn- correct-block-separations
"Corrects block separations and adds newlines above or
below a block where needed."
[correctors lines]
(let [above-correctors (:empty-line-above? correctors)
below-correctors (:empty-line-below? correctors)]
(map-indexed
(fn [index line]
(let [add-line-above? (some #(true? (% lines line index)) above-correctors)
add-line-below? (some #(true? (% lines line index)) below-correctors)]
(cond
; If code block starts but there is no empty newline
; above, let's fix that
(and add-line-above?
(not add-line-below?))
(str \newline line)
; If the code block ends, but there is no empty newline
; below, let's fix that.
(and add-line-below?
(not add-line-above?))
(str line \newline)
; If the code block needs a newline both above and below,
; let's fix that.
(and add-line-above?
add-line-below?)
(str \newline line \newline)
; otherwise is what it is
:else line)))
lines)))
(defn- correct-markdown
"Corrects invalid Markdown for the parser."
[markdown given-correctors]
(let [lines (string/split-lines markdown)]
(->> lines
(correct-block-separations (:block-separations given-correctors))
(string/join \newline))))
(defn- find-parser-by-block
"Find a parser from `parsers` that matches the given `block`."
[parsers block]
(->> parsers
(filter
(fn [{:keys [matcher]}]
(when matcher
(matcher block))))
first))
(defn- parse-block-with-known-parser
"Parses a given `block` with a known `parser`."
[parser given-parsers given-correctors block]
(loop [block block
renderers (:renderers parser)]
(if (empty? renderers)
block
(let [renderer (first renderers)]
(recur (renderer block given-parsers given-correctors)
(drop 1 renderers))))))
(defn- parse-block-with-unknown-parsers
"Parses the given `block` with all the parsers that do not have
a matcher function, useful for any fallback parsing one might want
to do."
[given-parsers given-correctors block]
(loop [block block
parsers (filter #(= nil (:matcher %)) given-parsers)]
(if (empty? parsers)
block
(recur (loop [block block
renderers (:renderers (first parsers))]
(if (empty? renderers)
block
(let [renderer (first renderers)]
(recur (renderer block parsers given-correctors)
(drop 1 renderers)))))
(drop 1 parsers)))))
(defn- parse-blocks
"Parses each individual Markdown block, given as `blocks`, with
the list of `parsers`."
[blocks given-parsers given-correctors]
(for [block blocks]
(if-let [parser (find-parser-by-block given-parsers block)]
(->> (string/trim block)
(parse-block-with-known-parser parser given-parsers given-correctors))
(->> (string/trim block)
(parse-block-with-unknown-parsers given-parsers given-correctors)))))
(defn render
"Parses given `markdown` with `parsers`."
[markdown given-parsers given-correctors]
(let [blocks (-> (correct-markdown markdown given-correctors)
(string/split #"\n\n")
stitch-code-blocks)
parsed-blocks (parse-blocks blocks given-parsers given-correctors)]
(string/join "\n\n" parsed-blocks)))
|
