blob: 3f0934a2d0296e6af6bb6dce4ffd87af7a10cd22 (
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
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
|
module Js = Js_of_ocaml.Js
module PM = Prosemirror
module App = Editor_app
type buffer = Jstr.t Js.js_array Js.t
type f = buffer -> PM.Model.node Js.t -> unit
let render_mark_type =
object%js
method code (mark : PM.Model.mark Js.t) (buffer : buffer) =
ignore mark;
(* There may be a bug here, if the code itself contains `` .
The encoder should search inside the node if the patern is present,
and adjust the number of backticks accordingly
https://spec.commonmark.org/0.29/#code-span *)
ignore @@ buffer##push (Jstr.v "``");
fun (buffer : buffer) -> ignore @@ buffer##push (Jstr.v "``")
method strong (mark : PM.Model.mark Js.t) (buffer : buffer) =
ignore mark;
ignore @@ buffer##push (Jstr.v "**");
fun (buffer : buffer) -> ignore @@ buffer##push (Jstr.v "**")
method em (mark : PM.Model.mark Js.t) (buffer : buffer) =
ignore mark;
ignore @@ buffer##push (Jstr.v "*");
fun (buffer : buffer) -> ignore @@ buffer##push (Jstr.v "*")
(**
https://spec.commonmark.org/0.29/#links
*)
method link (mark : PM.Model.mark Js.t) (buffer : buffer) =
ignore @@ buffer##push (Jstr.v "[");
fun (buffer : buffer) ->
ignore @@ buffer##push (Jstr.v "](");
let href_opt = PM.O.get mark##.attrs "href" in
Option.iter (fun href -> ignore @@ buffer##push href) href_opt;
ignore @@ buffer##push (Jstr.v ")")
end
type render_state =
{ level : int
; apply_indent : bool
}
(* Check if a property exists in the object with the name of
node type, and if so, call the appropriate method.
*)
let process_node obj (state : render_state) buffer node =
let name = node##._type##.name in
match Jv.find' (Jv.Id.to_jv obj) name with
| None -> Brr.Console.(log [ Jstr.v "Unknow type"; name; node ])
| Some _ ->
Jv.call'
(Jv.Id.to_jv obj)
name
[| Jv.Id.to_jv state; Jv.Id.to_jv buffer; Jv.Id.to_jv node |]
(** Create a js object with a function for each node type. Each function may
call [process_node] recursively for each nested nodes *)
let render_node_type =
object%js (_this)
(* https://spec.commonmark.org/0.29/#thematic-breaks *)
method horizontal_rule_
(state : render_state) (buffer : buffer) (node : PM.Model.node Js.t) =
ignore state;
ignore node;
if state.level <> 0
then (
ignore @@ buffer##push (Jstr.v "\n");
ignore @@ buffer##push Jstr.(repeat state.level (v " "));
ignore @@ buffer##push (Jstr.v "---\n") )
else ignore @@ buffer##push (Jstr.v "\n---\n")
method text
(state : render_state) (buffer : buffer) (node : PM.Model.node Js.t) =
ignore state;
(* Execute each mark as an environment like
\begin{environement}
…
\end{environment}
this way, nested marks are working correctly
*)
let post_render =
node##.marks##reduce_init
( Js.wrap_callback
@@ fun (acc : (buffer -> unit) Js.js_array Js.t)
(mark : PM.Model.mark Js.t)
(_ : int)
_ ->
let name = mark##._type##.name in
match Jv.find' (Jv.Id.to_jv render_mark_type) name with
| None ->
Brr.Console.(log [ Jstr.v "Unknown mark type"; name ]);
acc
| Some _ ->
(* Add the element as first (lifo) *)
ignore
@@ acc##unshift
(Jv.call'
(Jv.Id.to_jv render_mark_type)
name
[| Jv.Id.to_jv mark; Jv.Id.to_jv buffer |] );
acc )
(new%js Js.array_empty)
in
let () =
if node##.isText == Js._true
then
Js.Opt.iter node##.text (fun content ->
ignore @@ buffer##push content )
in
post_render##forEach
( Js.wrap_callback
@@ fun (call : buffer -> unit) (_ : int) _ -> call buffer )
method heading
(state : render_state) (buffer : buffer) (node : PM.Model.node Js.t) =
let h_level : int = node##.attrs##.level in
ignore @@ buffer##push Jstr.(repeat h_level (v "#"));
ignore @@ buffer##push (Jstr.v " ");
node##.content##forEach
( Js.wrap_meth_callback
@@ fun _ node ~offset ~index ->
let _ = offset
and _ = index in
process_node _this state buffer node );
ignore @@ buffer##push Jstr.(v "\n\n")
method paragraph
(state : render_state) (buffer : buffer) (node : PM.Model.node Js.t) =
node##.content##forEach
( Js.wrap_meth_callback
@@ fun _ node ~offset ~index ->
ignore offset;
ignore index;
if state.apply_indent
then ignore @@ buffer##push Jstr.(repeat state.level (v " "));
process_node _this state buffer node );
ignore @@ buffer##push Jstr.(v "\n")
method list_item_
(state : render_state) (buffer : buffer) (node : PM.Model.node Js.t) =
node##.content##forEach
( Js.wrap_meth_callback
@@ fun _ node ~offset ~index ->
ignore offset;
(* The first element in the list should be correctly indented, but if
there is many elements inside the list (paragraph) we have to
apply the indentation again.
*)
let new_state = { state with apply_indent = index <> 0 } in
process_node _this new_state buffer node )
method bullet_list_
(state : render_state) (buffer : buffer) (node : PM.Model.node Js.t) =
node##.content##forEach
( Js.wrap_meth_callback
@@ fun _ node ~offset ~index ->
ignore offset;
if state.level <> 0 && (index <> 0 || state.apply_indent)
then ignore @@ buffer##push Jstr.(repeat state.level (v " "));
ignore @@ buffer##push (Jstr.v "- ");
let new_state = { level = state.level + 2; apply_indent = false } in
process_node _this new_state buffer node );
if state.level == 0 then ignore @@ buffer##push Jstr.(v "\n")
method ordered_list_
(state : render_state) (buffer : buffer) (node : PM.Model.node Js.t) =
node##.content##forEach
( Js.wrap_meth_callback
@@ fun _ node ~offset ~index ->
ignore offset;
if state.level <> 0 && (index <> 0 || state.apply_indent)
then ignore @@ buffer##push Jstr.(repeat state.level (v " "));
let num = Jstr.of_int (1 + index) in
let prefix = Jstr.(num + v ". ") in
ignore @@ buffer##push prefix;
let new_state =
{ level = state.level + Jstr.length prefix; apply_indent = false }
in
process_node _this new_state buffer node );
if state.level == 0 then ignore @@ buffer##push Jstr.(v "\n")
(* https://spec.commonmark.org/0.29/#fenced-code-blocks *)
method code_block_
(state : render_state) (buffer : buffer) (node : PM.Model.node Js.t) =
ignore @@ buffer##push (Jstr.v "```\n");
node##.content##forEach
( Js.wrap_meth_callback
@@ fun _ node ~offset ~index ->
ignore index;
ignore offset;
let new_state = { state with apply_indent = true } in
process_node _this new_state buffer node );
if state.apply_indent
then ignore @@ buffer##push Jstr.(repeat state.level (v " "));
ignore @@ buffer##push (Jstr.v "\n```\n")
(** https://spec.commonmark.org/0.29/#block-quotes *)
method blockquote
(state : render_state) (buffer : buffer) (node : PM.Model.node Js.t) =
node##.content##forEach
( Js.wrap_meth_callback
@@ fun _ node ~offset ~index ->
ignore index;
ignore offset;
ignore @@ buffer##push (Jstr.v "> ");
let new_state = { level = state.level + 2; apply_indent = false } in
process_node _this new_state buffer node );
ignore @@ buffer##push (Jstr.v "\n")
end
module ToMarkdown = struct
type t = PM.t
let process : t -> State.t -> State.t =
fun pm state ->
let view = state.State.view in
let root_node = view##.state##.doc in
let buffer = new%js Js.array_empty in
Brr.Console.(log [ Obj.magic root_node ]);
let () =
root_node##forEach
( Js.wrap_meth_callback
@@ fun _ node ~offset ~index ->
let _ = offset
and _ = index in
let init = { level = 0; apply_indent = false } in
process_node render_node_type init buffer node )
in
(* Concatenate the array into a single string *)
let js_markdown = buffer##join (Js.string "") in
let markdown = Js.to_string js_markdown in
Brr.Console.(log [ js_markdown ]);
let doc = Omd.of_string markdown in
let new_doc = Of_markdown.FromMarkdown.parse view pm doc in
Brr.Console.(
log
[ Jstr.v "Are the same ?"
; Obj.magic @@ Js_of_ocaml.Js.bool (root_node = new_doc)
]);
(* The function does not actually update the state, and return it
unchanged *)
state
end
(** Create a new element *)
let create : PM.t -> App.event = fun pm -> App.dispatch (module ToMarkdown) pm
|
