jon.recoil.org
this repo has no description
1let strf = Printf.sprintf
2
3(* ocamlmark parsing *)
4
5open Odoc_parser
6open Cmarkit
7
8(* Text location and comment massaging.
9
10 One slight annoyance is that CommonMark is sensitive to leading
11 blanks on lines and ocamldoc comments are usually indented by [n]
12 spaces up the … of (** … *). So we can't just feed it the comment
13 text: we would mostly get CommonMark indented code blocks.
14
15 So we massage the comment to trim up to [n] initial spaces after
16 newlines. [n] being the number of columns until … in (** … *). We
17 need to remember how much we trimmed on each line in order to patch
18 the locations reported by cmarkit. Below we keep pass that info
19 around using the [~locator] argument.
20
21 This is not needed in [md] files, but the code is kept in case we
22 add support for markdown in docstrings. *)
23
24let comment_col ~location = location.Lexing.pos_cnum - location.Lexing.pos_bol
25
26let massage_comment ~location b s =
27 let rec next_non_space s ~max i =
28 if i > max || not (s.[i] = ' ') then i else next_non_space s ~max (i + 1)
29 in
30 let rec find_after_trim ~max_trim s max ~start i =
31 if i - start + 1 > max_trim || i > max || s.[i] <> ' ' then i
32 else find_after_trim ~max_trim s max ~start (i + 1)
33 in
34 let flush b s start last =
35 Buffer.add_substring b s start (last - start + 1)
36 in
37 let rec loop b s acc ~max_trim max start k =
38 if k > max then (
39 flush b s start max;
40 ((location, Array.of_list (List.rev acc)), Buffer.contents b))
41 else if not (s.[k] = '\n' || s.[k] = '\r') then
42 loop b s acc ~max_trim max start (k + 1)
43 else
44 let next = k + 1 in
45 let next =
46 if s.[k] = '\r' && next <= max && s.[next] = '\n' then next + 1
47 else next
48 in
49 let after_trim = find_after_trim ~max_trim s max ~start:next next in
50 let trim = after_trim - next in
51 flush b s start (next - 1);
52 loop b s (trim :: acc) ~max_trim max after_trim after_trim
53 in
54 if s = "" then ((location, [| 0 |]), s)
55 else
56 let max = String.length s - 1 in
57 let nsp = next_non_space s ~max 0 in
58 let max_trim = comment_col ~location + nsp in
59 loop b s [ nsp (* trim *) ] ~max_trim max nsp nsp
60
61let textloc_to_loc ~locator textloc =
62 (* Note: if you get an [Invalid_argument] from this function suspect a bug
63 in cmarkit's location computation. *)
64 let point_of_line_and_byte_pos ~locator:(location, line_trim_counts) l pos =
65 let line_num, line_pos = l in
66 let line = location.Lexing.pos_lnum + line_num - 1 in
67 try
68 let column = line_trim_counts.(line_num - 1) + (pos - line_pos) in
69 let column =
70 match line_num with 1 -> comment_col ~location + column | _ -> column
71 in
72 { Loc.line; column }
73 with _ ->
74 (* Presumably this is the above-mentioned bug that's being hit. *)
75 { Loc.line = -1; column = -1 }
76 in
77 let file = Textloc.file textloc in
78 let first_line = Textloc.first_line textloc in
79 let first_byte = Textloc.first_byte textloc in
80 let last_line = Textloc.last_line textloc in
81 let last_byte = Textloc.last_byte textloc + 1 in
82 let start = point_of_line_and_byte_pos ~locator first_line first_byte in
83 let end_ = point_of_line_and_byte_pos ~locator last_line last_byte in
84 { Loc.file; start; end_ }
85
86let meta_to_loc ~locator meta = textloc_to_loc ~locator (Meta.textloc meta)
87
88(* Sometimes we need to munge a bit the cmarkit metas and textlocs.
89 These function do that. They are not general and make assumptions
90 about the nature of data they apply to. E.g. most assume the
91 textloc is on the same line. *)
92
93let chop_end_of_meta_textloc ~count meta =
94 let textloc = Meta.textloc meta in
95 let last_line = Textloc.last_line textloc in
96 let last_byte = Textloc.last_byte textloc - count in
97 let textloc = Textloc.set_last textloc ~last_byte ~last_line in
98 Meta.with_textloc ~keep_id:true meta textloc
99
100let split_info_string_locs ~left_count ~right_count m =
101 if right_count = 0 then (Meta.textloc m, Textloc.none)
102 else
103 let textloc = Meta.textloc m in
104 let line = Textloc.first_line textloc in
105 let last_byte = Textloc.first_byte textloc + left_count - 1 in
106 let first_byte = Textloc.last_byte textloc - right_count + 1 in
107 ( Textloc.set_last textloc ~last_byte ~last_line:line,
108 Textloc.set_first textloc ~first_byte ~first_line:line )
109
110let textloc_of_sub textloc ~first ~last (* in textloc relative space *) =
111 let file = Textloc.file textloc in
112 let line = Textloc.first_line textloc in
113 let first_byte = Textloc.first_byte textloc + first in
114 let last_byte = Textloc.first_byte textloc + last in
115 Textloc.v ~file ~first_byte ~last_byte ~first_line:line ~last_line:line
116
117(* Warnings *)
118
119let warn_unsupported_hard_break =
120 "Hard breaks are unsupported in ocamlmark, using a soft break."
121
122let warn_unsupported_header_nesting =
123 "Headers in list items are unsupported in ocamlmark, dropped."
124
125let warn_heading_level_6 =
126 "Heading level 6 is unsupported in ocamlmark, using 5."
127
128let warn_unsupported_list_start_number start =
129 strf "List start numbers are unsupported in ocamlmark, replacing %d with 1."
130 start
131
132let warn_unsupported_cmark kind =
133 strf "%s are unsupported in ocamlmark, dropped." kind
134
135let warn_unsupported_link_title =
136 "Link titles are unsupported in ocamlmark, dropped."
137
138let warn ~loc:location message warns = { Warning.location; message } :: warns
139
140let warn_unsupported_cmark ~locator kind meta (acc, warns) =
141 let msg = warn_unsupported_cmark kind in
142 (acc, warn ~loc:(meta_to_loc ~locator meta) msg warns)
143
144let warn_unsupported_header_nesting ~locator meta (acc, warns) =
145 let msg = warn_unsupported_header_nesting in
146 (acc, warn ~loc:(meta_to_loc ~locator meta) msg warns)
147
148let is_blank = function ' ' | '\t' -> true | _ -> false
149let rec next_blank s ~max i =
150 if i > max || is_blank s.[i] then i else next_blank s ~max (i + 1)
151
152let rec next_nonblank s ~max i =
153 if i > max || not (is_blank s.[i]) then i else next_nonblank s ~max (i + 1)
154
155(* Translating blocks and inlines. *)
156
157(* A few type definitions for better variant typing. *)
158
159type inlines_acc = Ast.inline_element Ast.with_location list * Warning.t list
160type ast_acc = Ast.t * Warning.t list
161type nestable_ast_acc =
162 Ast.nestable_block_element Ast.with_location list * Warning.t list
163
164(* Inline translations *)
165
166let link_definition defs l =
167 match Inline.Link.reference_definition defs l with
168 | Some (Link_definition.Def (ld, _)) -> Some ld
169 | Some (Block.Footnote.Def (_, _)) -> None
170 | Some _ -> assert false
171 | None -> assert false (* assert [l]'s referenced label is not synthetic *)
172
173let autolink_to_inline_element ~locator a m (is, warns) =
174 let loc = meta_to_loc ~locator m in
175 let link, link_loc = Inline.Autolink.link a in
176 let link_loc = meta_to_loc ~locator link_loc in
177 let text = [ Loc.at link_loc (`Word link) ] in
178 (Loc.at loc (`Link (link, text)) :: is, warns)
179
180let break_to_inline_element ~locator br m (is, warns) =
181 let loc = meta_to_loc ~locator m in
182 let warns =
183 match Inline.Break.type' br with
184 | `Soft -> warns
185 | `Hard -> warn ~loc warn_unsupported_hard_break warns
186 in
187 (Loc.at loc (`Space "\n") :: is, warns)
188
189let code_span_to_inline_element ~locator cs m (is, warns) =
190 let loc = meta_to_loc ~locator m in
191 let code = Inline.Code_span.code cs in
192 (Loc.at loc (`Code_span code) :: is, warns)
193
194let math_span_to_inline_element ~locator ms m (is, warns) =
195 let loc = meta_to_loc ~locator m in
196 let tex = Inline.Math_span.tex ms in
197 (Loc.at loc (`Math_span tex) :: is, warns)
198
199let raw_html_to_inline_element ~locator html m (is, warns) =
200 let loc = meta_to_loc ~locator m in
201 let html = String.concat "\n" (List.map Block_line.tight_to_string html) in
202 (Loc.at loc (`Raw_markup (Some "html", html)) :: is, warns)
203
204let image_to_inline_element ~locator defs i m (is, warns) =
205 (* We map to raw html, ocamldoc's ast should have a case for that. *)
206 let escape esc b s =
207 Buffer.clear b;
208 esc b s;
209 Buffer.contents b
210 in
211 let pct_esc = escape Cmarkit_html.buffer_add_pct_encoded_string in
212 let html_esc = escape Cmarkit_html.buffer_add_html_escaped_string in
213 let loc = meta_to_loc ~locator m in
214 let b = Buffer.create 255 in
215 let ld = link_definition defs i in
216 match ld with
217 | None -> (is, warns)
218 | Some ld ->
219 let link =
220 match Link_definition.dest ld with
221 | None -> ""
222 | Some (link, _) -> pct_esc b link
223 in
224 let title =
225 match Link_definition.title ld with
226 | None -> ""
227 | Some title ->
228 let title = List.map Block_line.tight_to_string title in
229 html_esc b (String.concat "\n" title)
230 in
231 let alt =
232 let ls =
233 Inline.to_plain_text ~break_on_soft:false (Inline.Link.text i)
234 in
235 html_esc b (String.concat "\n" (List.map (String.concat "") ls))
236 in
237 let img =
238 String.concat ""
239 [
240 {|<img src="|};
241 link;
242 {|" alt="|};
243 alt;
244 {|" title="|};
245 title;
246 {|" >|};
247 ]
248 in
249 (Loc.at loc (`Raw_markup (Some "html", img)) :: is, warns)
250
251let text_to_inline_elements ~locator s meta ((is, warns) as acc) =
252 (* [s] is on a single source line (but may have newlines because of
253 character references) we need to tokenize it for ocamldoc's ast. *)
254 let flush_tok s meta acc is_space first last =
255 let textloc = textloc_of_sub (Meta.textloc meta) ~first ~last in
256 let loc = textloc_to_loc ~locator textloc in
257 let s = String.sub s first (last - first + 1) in
258 Loc.at loc (if is_space then `Space s else `Word s) :: acc
259 in
260 let rec tokenize s meta acc max start is_space =
261 if start > max then (List.rev_append acc is, warns)
262 else
263 let next_start =
264 if is_space then next_nonblank s ~max start else next_blank s ~max start
265 in
266 let acc = flush_tok s meta acc is_space start (next_start - 1) in
267 tokenize s meta acc max next_start (not is_space)
268 in
269 let max = String.length s - 1 in
270 if max < 0 then acc else tokenize s meta [] max 0 (is_blank s.[0])
271
272let rec link_reference_to_inline_element ~locator defs l m (is, warns) =
273 let loc = meta_to_loc ~locator m in
274 let ld = link_definition defs l in
275 match ld with
276 | None ->
277 let text, warns =
278 inline_to_inline_elements ~locator defs ([], warns) (Inline.Link.text l)
279 in
280 (text @ is, warns)
281 | Some ld ->
282 let replace_md_mdx s =
283 let add_html x = x ^ ".html" in
284 if String.ends_with ~suffix:".md" s then
285 String.sub s 0 (String.length s - 3) |> add_html
286 else if String.ends_with ~suffix:".mdx" s then
287 String.sub s 0 (String.length s - 4) |> add_html
288 else s
289 in
290 let link =
291 match Link_definition.dest ld with
292 | None -> ""
293 | Some (l, _) ->
294 if String.contains l ':' then (* Assume it's a URL *) l
295 else
296 (* If it ends with `.md` or `.mdx`, drop the extension and add `.html` *)
297 replace_md_mdx l
298 in
299 let warns =
300 match Link_definition.title ld with
301 | None -> warns
302 | Some title ->
303 let textloc = Block_line.tight_list_textloc title in
304 let loc = textloc_to_loc ~locator textloc in
305 warn ~loc warn_unsupported_link_title warns
306 in
307 let text, warns =
308 inline_to_inline_elements ~locator defs ([], warns) (Inline.Link.text l)
309 in
310 (Loc.at loc (`Link (link, text)) :: is, warns)
311
312and link_to_inline_element ~locator defs l m acc =
313 link_reference_to_inline_element ~locator defs l m acc
314
315and emphasis_to_inline_element ~locator defs style e m (is, warns) =
316 let loc = meta_to_loc ~locator m in
317 let i = Inline.Emphasis.inline e in
318 let inlines, warns = inline_to_inline_elements ~locator defs ([], warns) i in
319 (Loc.at loc (`Styled (style, inlines)) :: is, warns)
320
321and inline_to_inline_elements ~locator defs acc i : inlines_acc =
322 match i with
323 | Inline.Autolink (a, m) -> autolink_to_inline_element ~locator a m acc
324 | Inline.Break (b, m) -> break_to_inline_element ~locator b m acc
325 | Inline.Code_span (cs, m) -> code_span_to_inline_element ~locator cs m acc
326 | Inline.Emphasis (e, m) ->
327 emphasis_to_inline_element ~locator defs `Emphasis e m acc
328 | Inline.Image (i, m) -> image_to_inline_element ~locator defs i m acc
329 | Inline.Inlines (is, _m) ->
330 let inline = inline_to_inline_elements ~locator defs in
331 List.fold_left inline acc (List.rev is)
332 | Inline.Link (l, m) -> link_to_inline_element ~locator defs l m acc
333 | Inline.Raw_html (html, m) -> raw_html_to_inline_element ~locator html m acc
334 | Inline.Strong_emphasis (e, m) ->
335 emphasis_to_inline_element ~locator defs `Bold e m acc
336 | Inline.Text (t, m) -> text_to_inline_elements ~locator t m acc
337 | Inline.Ext_math_span (ms, m) ->
338 math_span_to_inline_element ~locator ms m acc
339 | Inline.Ext_strikethrough (s, meta) ->
340 let i = Inline.Strikethrough.inline s in
341 let acc = warn_unsupported_cmark ~locator "strikethrough" meta acc in
342 inline_to_inline_elements ~locator defs acc i
343 | _ -> assert false
344
345(* Heading label support - CommonMark extension. Parses a potential
346 final {#id} in heading inlines. In [id] braces must be escaped
347 otherwise parsing fails; if the rightmost brace is escaped it's
348 not a heading label. The parse runs from right to left *)
349
350let parse_heading_label s =
351 let rec loop s max prev i =
352 if i < 0 then None
353 else
354 match s.[i] with
355 | '{' as c ->
356 if i > 0 && s.[i - 1] = '\\' then loop s max c (i - 1)
357 else if prev = '#' then Some i
358 else None
359 | '}' as c ->
360 if i > 0 && s.[i - 1] = '\\' then loop s max c (i - 1) else None
361 | c -> loop s max c (i - 1)
362 in
363 let max = String.length s - 1 in
364 let last =
365 (* [last] is rightmost non blank, if any. *)
366 let k = ref max in
367 while (not (!k < 0)) && is_blank s.[!k] do
368 decr k
369 done;
370 !k
371 in
372 if last < 1 || s.[last] <> '}' || s.[last - 1] = '\\' then None
373 else
374 match loop s max s.[last] (last - 1) with
375 | None -> None
376 | Some first ->
377 let chop = max - first + 1 in
378 let text = String.sub s 0 first in
379 let first = first + 2 and last = last - 1 in
380 (* remove delims *)
381 let label = String.sub s first (last - first + 1) in
382 Some (text, chop, label)
383
384let heading_inline_and_label h =
385 (* cmarkit claims it's already normalized but let's be defensive :-) *)
386 match Inline.normalize (Block.Heading.inline h) with
387 | Inline.Text (t, m) as inline -> (
388 match parse_heading_label t with
389 | None -> (inline, None)
390 | Some (t, chop, label) ->
391 let m = chop_end_of_meta_textloc ~count:chop m in
392 (Inline.Text (t, m), Some label))
393 | Inline.Inlines (is, m0) as inline -> (
394 match List.rev is with
395 | Inline.Text (t, m1) :: ris -> (
396 match parse_heading_label t with
397 | None -> (inline, None)
398 | Some (t, chop, label) ->
399 let m0 = chop_end_of_meta_textloc ~count:chop m0 in
400 let m1 = chop_end_of_meta_textloc ~count:chop m1 in
401 ( Inline.Inlines (List.rev (Inline.Text (t, m1) :: ris), m0),
402 Some label ))
403 | _ -> (inline, None))
404 | inline -> (inline, None)
405
406(* Block translations *)
407
408let raw_paragraph ~loc ~raw_loc backend raw =
409 Loc.at loc (`Paragraph [ Loc.at raw_loc (`Raw_markup (Some backend, raw)) ])
410
411let code_block_to_nestable_block_element ~locator cb m (bs, warns) =
412 let loc = meta_to_loc ~locator m in
413 let code = Block.Code_block.code cb in
414 let code_loc = textloc_to_loc ~locator (Block_line.list_textloc code) in
415 let code = String.concat "\n" (List.map Block_line.to_string code) in
416 match Block.Code_block.info_string cb with
417 | None ->
418 let code_block =
419 {
420 Ast.meta = None;
421 delimiter = None;
422 content = Loc.at code_loc code;
423 output = None;
424 }
425 (* (None, Loc.at code_loc code) *)
426 in
427 (Loc.at loc (`Code_block code_block) :: bs, warns)
428 | Some (info, im) -> (
429 match Block.Code_block.language_of_info_string info with
430 | None ->
431 let code_block =
432 {
433 Ast.meta = None;
434 delimiter = None;
435 content = Loc.at code_loc code;
436 output = None;
437 }
438 in
439 (* (None, Loc.at code_loc code) *)
440 (Loc.at loc (`Code_block code_block) :: bs, warns)
441 | Some ("verb", _) -> (Loc.at loc (`Verbatim code) :: bs, warns)
442 | Some ("=html", _) ->
443 (raw_paragraph ~loc ~raw_loc:code_loc "html" code :: bs, warns)
444 | Some ("=latex", _) ->
445 (raw_paragraph ~loc ~raw_loc:code_loc "latex" code :: bs, warns)
446 | Some ("=texi", _) ->
447 (raw_paragraph ~loc ~raw_loc:code_loc "texi" code :: bs, warns)
448 | Some ("=man", _) ->
449 (raw_paragraph ~loc ~raw_loc:code_loc "man" code :: bs, warns)
450 | Some (lang, env) ->
451 let left_count = String.length lang in
452 let right_count = String.length env in
453 let lang_loc, env_loc =
454 split_info_string_locs ~left_count ~right_count im
455 in
456 let env =
457 if env = "" then []
458 else [ `Tag (Loc.at (textloc_to_loc ~locator env_loc) env) ]
459 in
460 let lang = Loc.at (textloc_to_loc ~locator lang_loc) lang in
461 let metadata = Some { Ast.language = lang; tags = env } in
462 let code_block =
463 {
464 Ast.meta = metadata;
465 delimiter = None;
466 content = Loc.at code_loc code;
467 output = None;
468 }
469 (* (metadata, Loc.at code_loc code) *)
470 in
471 (Loc.at loc (`Code_block code_block) :: bs, warns))
472
473let math_block_to_nestable_block_element ~locator mb m (bs, warns) =
474 let loc = meta_to_loc ~locator m in
475 let math = Block.Code_block.code mb in
476 let math = String.concat "\n" (List.map Block_line.to_string math) in
477 (Loc.at loc (`Math_block math) :: bs, warns)
478
479let html_block_to_nestable_block_element ~locator html m (bs, warns) =
480 let loc = meta_to_loc ~locator m in
481 let html = String.concat "\n" (List.map fst html) in
482 (raw_paragraph ~loc ~raw_loc:loc "html" html :: bs, warns)
483
484let heading_to_block_element ~locator defs h m (bs, warns) =
485 let loc = meta_to_loc ~locator m in
486 let level, warns =
487 match Block.Heading.level h with
488 | 6 -> (5, warn ~loc warn_heading_level_6 warns)
489 | level -> (level, warns)
490 in
491 let inline, label = heading_inline_and_label h in
492 let inlines, warns =
493 inline_to_inline_elements ~locator defs ([], warns) inline
494 in
495 (Loc.at loc (`Heading (level, label, inlines)) :: bs, warns)
496
497let paragraph_to_nestable_block_element ~locator defs p m (bs, warns) =
498 (* TODO Parse inlines for @tags support. *)
499 let loc = meta_to_loc ~locator m in
500 let i = Block.Paragraph.inline p in
501 let is, warns = inline_to_inline_elements ~locator defs ([], warns) i in
502 (Loc.at loc (`Paragraph is) :: bs, warns)
503
504let thematic_break_to_nestable_block_element ~locator m (bs, warns) =
505 let loc = meta_to_loc ~locator m in
506 (raw_paragraph ~loc ~raw_loc:loc "html" "<hr>" :: bs, warns)
507
508let rec list_to_nestable_block_element ~locator defs l m (bs, warns) =
509 let loc = meta_to_loc ~locator m in
510 let style =
511 `Heavy
512 (* Note this is a layout property of ocamldoc *)
513 in
514 let kind, warns =
515 match Block.List'.type' l with
516 | `Unordered _ -> (`Unordered, warns)
517 | `Ordered (start, _) ->
518 ( `Ordered,
519 if start = 1 then warns
520 else warn ~loc (warn_unsupported_list_start_number start) warns )
521 in
522 let add_item ~locator (acc, warns) (i, _meta) =
523 let b = Block.List_item.block i in
524 let bs, warns =
525 block_to_nestable_block_elements ~locator defs ([], warns) b
526 in
527 (bs :: acc, warns)
528 in
529 let ritems = List.rev (Block.List'.items l) in
530 let items, warns = List.fold_left (add_item ~locator) ([], warns) ritems in
531 (Loc.at loc (`List (kind, style, items)) :: bs, warns)
532
533and table_to_nestable_block_element ~locator defs tbl m (bs, warns) =
534 let loc = meta_to_loc ~locator m in
535 let style =
536 `Light
537 (* Note this is a layout property of ocamldoc *)
538 in
539 let col_count = Block.Table.col_count tbl in
540 let add_cell typ (n_cell, acc, warns) (cell, _) =
541 let content, warns =
542 inline_to_inline_elements ~locator defs ([], warns) cell
543 in
544 let loc = Loc.span (List.map Loc.location content) in
545 let cell = Loc.at loc (`Paragraph content) in
546 (n_cell + 1, ([ cell ], typ) :: acc, warns)
547 in
548 let add_cells (acc, warns) typ cells =
549 let n_cell, res, warns =
550 List.fold_left (add_cell typ) (0, [], warns) cells
551 in
552 let res =
553 (* Pad with empty entries to reach the number of columns *)
554 List.init (col_count - n_cell) (fun _ -> ([], `Data)) @ res |> List.rev
555 in
556 (res :: acc, warns)
557 in
558 let add_row ~locator:_ (acc, warns) (row, _meta) =
559 match row with
560 | `Header cells, _layout -> add_cells (acc, warns) `Header cells
561 | `Data cells, _ -> add_cells (acc, warns) `Data cells
562 | `Sep _, _ -> (acc, warns)
563 in
564 let rows = List.rev (Block.Table.rows tbl) in
565 let items, warns = List.fold_left (add_row ~locator) ([], warns) rows in
566 let alignment =
567 let rec find_sep rows =
568 match rows with
569 | [] -> None
570 | ((`Sep s, _layout), _meta) :: _ -> Some s
571 | _ :: q -> find_sep q
572 in
573 match find_sep rows with
574 | None -> None
575 | Some sep -> Some (List.map (function (align, _layout), _ -> align) sep)
576 in
577 let table = `Table ((items, alignment), style) in
578 let res = (Loc.at loc table :: bs, warns) in
579 res
580
581and block_to_nestable_block_elements ~locator defs acc b : nestable_ast_acc =
582 match b with
583 | Block.Blocks (bs, _) ->
584 let block = block_to_nestable_block_elements ~locator defs in
585 List.fold_left block acc (List.rev bs)
586 | Block.Code_block (c, m) ->
587 code_block_to_nestable_block_element ~locator c m acc
588 | Block.Heading (_, m) -> warn_unsupported_header_nesting ~locator m acc
589 | Block.Html_block (html, m) ->
590 html_block_to_nestable_block_element ~locator html m acc
591 | Block.List (l, m) -> list_to_nestable_block_element ~locator defs l m acc
592 | Block.Paragraph (p, m) ->
593 paragraph_to_nestable_block_element ~locator defs p m acc
594 | Block.Block_quote (_, m) ->
595 warn_unsupported_cmark ~locator "Block quotes" m acc
596 | Block.Thematic_break (_, m) ->
597 thematic_break_to_nestable_block_element ~locator m acc
598 | Block.Blank_line _ | Block.Link_reference_definition _ ->
599 (* layout cases *) acc
600 | Block.Ext_table (tbl, m) ->
601 table_to_nestable_block_element ~locator defs tbl m acc
602 | Block.Ext_math_block (math, m) ->
603 math_block_to_nestable_block_element ~locator math m acc
604 | Block.Ext_footnote_definition (_, meta) ->
605 warn_unsupported_cmark ~locator "Footnotes" meta acc
606 | _ -> assert false
607
608let rec block_to_ast ~locator defs acc b : ast_acc =
609 match b with
610 | Block.Heading (h, m) -> heading_to_block_element ~locator defs h m acc
611 | Block.Blocks (bs, _) ->
612 List.fold_left (block_to_ast ~locator defs) acc (List.rev bs)
613 | b ->
614 (* We can't go directy with acc because of nestable typing. *)
615 let bs, ws = acc in
616 let bs', ws = block_to_nestable_block_elements ~locator defs ([], ws) b in
617 (List.rev_append (List.rev (bs' :> Ast.t)) bs, ws)
618
619(* Parsing comments *)
620
621let parse_comment ?buffer:b ~location ~text:s () : Ast.t * Warning.t list =
622 let b =
623 match b with
624 | None -> Buffer.create (String.length s)
625 | Some b ->
626 Buffer.reset b;
627 b
628 in
629 let locator, text = massage_comment ~location b s in
630 let warns = ref [] and file = location.Lexing.pos_fname in
631 let doc = Doc.of_string ~file ~locs:true ~strict:false text in
632 block_to_ast ~locator (Doc.defs doc) ([], !warns) (Doc.block doc)