jon.recoil.org
this repo has no description
Markdown support for standalone pages
Co-authored-by: Daniel Bünzli <daniel.buenzli@erratique.ch>
Co-authored-by: Paul-Elliot Anglès d'Auriac <paul-elliot@tarides.com>
+600
-13
+1
-8
README.md
+1
-8
README.md
+47
odoc-md.opam
+47
odoc-md.opam
···
1
+
opam-version: "2.0"
2
+
3
+
version: "dev"
4
+
homepage: "https://github.com/ocaml/odoc"
5
+
doc: "https://ocaml.github.io/odoc/"
6
+
bug-reports: "https://github.com/ocaml/odoc/issues"
7
+
license: "ISC"
8
+
9
+
maintainer: [
10
+
"Jon Ludlam <jon@recoil.org>"
11
+
"Jules Aguillon <juloo.dsi@gmail.com>"
12
+
"Paul-Elliot Anglès d'Auriac <paul-elliot@tarides.com>"
13
+
]
14
+
authors: [
15
+
"Daniel Bünzli <daniel.buenzli@erratique.ch>"
16
+
"Paul-Elliot Anglès d'Auriac <paul-elliot@tarides.com>"
17
+
"Jon Ludlam <jon@recoil.org>"
18
+
]
19
+
dev-repo: "git+https://github.com/ocaml/odoc.git"
20
+
21
+
synopsis: "OCaml Documentation Generator - Markdown support"
22
+
description: """
23
+
Odoc-md is part of the odoc suite of tools for generating documentation for OCaml packages.
24
+
25
+
This package provides support for generating documentation from Markdown files.
26
+
"""
27
+
28
+
depends: [
29
+
"ocaml" {>= "4.14.0"}
30
+
"odoc" {= version}
31
+
"cmarkit"
32
+
]
33
+
34
+
build: [
35
+
["dune" "subst"] {dev}
36
+
[
37
+
"dune"
38
+
"build"
39
+
"-p"
40
+
name
41
+
"-j"
42
+
jobs
43
+
"@install"
44
+
"@runtest" {with-test}
45
+
"@doc" {with-doc}
46
+
]
47
+
]
+454
src/markdown/doc_of_md.ml
+454
src/markdown/doc_of_md.ml
···
1
+
let strf = Printf.sprintf
2
+
3
+
(* ocamlmark parsing *)
4
+
5
+
open Odoc_parser
6
+
open 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
+
24
+
let comment_col ~location = location.Lexing.pos_cnum - location.Lexing.pos_bol
25
+
26
+
let 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
+
61
+
let 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
+
let column = line_trim_counts.(line_num - 1) + (pos - line_pos) in
68
+
let column =
69
+
match line_num with 1 -> comment_col ~location + column | _ -> column
70
+
in
71
+
{ Loc.line; column }
72
+
in
73
+
let file = Textloc.file textloc in
74
+
let first_line = Textloc.first_line textloc in
75
+
let first_byte = Textloc.first_byte textloc in
76
+
let last_line = Textloc.last_line textloc in
77
+
let last_byte = Textloc.last_byte textloc + 1 in
78
+
let start = point_of_line_and_byte_pos ~locator first_line first_byte in
79
+
let end_ = point_of_line_and_byte_pos ~locator last_line last_byte in
80
+
{ Loc.file; start; end_ }
81
+
82
+
let meta_to_loc ~locator meta = textloc_to_loc ~locator (Meta.textloc meta)
83
+
84
+
(* Sometimes we need to munge a bit the cmarkit metas and textlocs.
85
+
These function do that. They are not general and make assumptions
86
+
about the nature of data they apply to. E.g. most assume the
87
+
textloc is on the same line. *)
88
+
89
+
let split_info_string_locs ~left_count ~right_count m =
90
+
if right_count = 0 then (Meta.textloc m, Textloc.none)
91
+
else
92
+
let textloc = Meta.textloc m in
93
+
let line = Textloc.first_line textloc in
94
+
let last_byte = Textloc.first_byte textloc + left_count - 1 in
95
+
let first_byte = Textloc.last_byte textloc - right_count + 1 in
96
+
( Textloc.set_last textloc ~last_byte ~last_line:line,
97
+
Textloc.set_first textloc ~first_byte ~first_line:line )
98
+
99
+
let textloc_of_sub textloc ~first ~last (* in textloc relative space *) =
100
+
let file = Textloc.file textloc in
101
+
let line = Textloc.first_line textloc in
102
+
let first_byte = Textloc.first_byte textloc + first in
103
+
let last_byte = Textloc.first_byte textloc + last in
104
+
Textloc.v ~file ~first_byte ~last_byte ~first_line:line ~last_line:line
105
+
106
+
(* Warnings *)
107
+
108
+
let warn_unsupported_hard_break =
109
+
"Hard breaks are unsupported in ocamlmark, using a soft break."
110
+
111
+
let warn_unsupported_header_nesting =
112
+
"Headers in list items are unsupported in ocamlmark, dropped."
113
+
114
+
let warn_heading_level_6 =
115
+
"Heading level 6 is unsupported in ocamlmark, using 5."
116
+
117
+
let warn_unsupported_list_start_number start =
118
+
strf "List start numbers are unsupported in ocamlmark, replacing %d with 1."
119
+
start
120
+
121
+
let warn_unsupported_cmark kind =
122
+
strf "%s are unsupported in ocamlmark, dropped." kind
123
+
124
+
let warn_unsupported_link_title =
125
+
"Link titles are unsupported in ocamlmark, dropped."
126
+
127
+
let warn ~loc:location message warns = { Warning.location; message } :: warns
128
+
129
+
let warn_unsupported_cmark ~locator kind meta (acc, warns) =
130
+
let msg = warn_unsupported_cmark kind in
131
+
(acc, warn ~loc:(meta_to_loc ~locator meta) msg warns)
132
+
133
+
let warn_unsupported_header_nesting ~locator meta (acc, warns) =
134
+
let msg = warn_unsupported_header_nesting in
135
+
(acc, warn ~loc:(meta_to_loc ~locator meta) msg warns)
136
+
137
+
let is_blank = function ' ' | '\t' -> true | _ -> false
138
+
let rec next_blank s ~max i =
139
+
if i > max || is_blank s.[i] then i else next_blank s ~max (i + 1)
140
+
141
+
let rec next_nonblank s ~max i =
142
+
if i > max || not (is_blank s.[i]) then i else next_nonblank s ~max (i + 1)
143
+
144
+
(* Translating blocks and inlines. *)
145
+
146
+
(* A few type definitions for better variant typing. *)
147
+
148
+
type inlines_acc = Ast.inline_element Ast.with_location list * Warning.t list
149
+
type ast_acc = Ast.t * Warning.t list
150
+
type nestable_ast_acc =
151
+
Ast.nestable_block_element Ast.with_location list * Warning.t list
152
+
153
+
(* Inline translations *)
154
+
155
+
let link_definition defs l =
156
+
match Inline.Link.reference_definition defs l with
157
+
| Some (Link_definition.Def (ld, _)) -> ld
158
+
| Some _ -> assert false (* if we parse without cmarkit extensions *)
159
+
| None -> assert false (* assert [l]'s referenced label is not synthetic *)
160
+
161
+
let autolink_to_inline_element ~locator a m (is, warns) =
162
+
let loc = meta_to_loc ~locator m in
163
+
let link, link_loc = Inline.Autolink.link a in
164
+
let link_loc = meta_to_loc ~locator link_loc in
165
+
let text = [ Loc.at link_loc (`Word link) ] in
166
+
(Loc.at loc (`Link (link, text)) :: is, warns)
167
+
168
+
let break_to_inline_element ~locator br m (is, warns) =
169
+
let loc = meta_to_loc ~locator m in
170
+
let warns =
171
+
match Inline.Break.type' br with
172
+
| `Soft -> warns
173
+
| `Hard -> warn ~loc warn_unsupported_hard_break warns
174
+
in
175
+
(Loc.at loc (`Space "\n") :: is, warns)
176
+
177
+
let code_span_to_inline_element ~locator cs m (is, warns) =
178
+
let loc = meta_to_loc ~locator m in
179
+
let code = Inline.Code_span.code cs in
180
+
(Loc.at loc (`Code_span code) :: is, warns)
181
+
182
+
let raw_html_to_inline_element ~locator html m (is, warns) =
183
+
let loc = meta_to_loc ~locator m in
184
+
let html = String.concat "\n" (List.map Block_line.tight_to_string html) in
185
+
(Loc.at loc (`Raw_markup (Some "html", html)) :: is, warns)
186
+
187
+
let image_to_inline_element ~locator defs i m (is, warns) =
188
+
(* We map to raw html, ocamldoc's ast should have a case for that. *)
189
+
let escape esc b s =
190
+
Buffer.clear b;
191
+
esc b s;
192
+
Buffer.contents b
193
+
in
194
+
let pct_esc = escape Cmarkit_html.buffer_add_pct_encoded_string in
195
+
let html_esc = escape Cmarkit_html.buffer_add_html_escaped_string in
196
+
let loc = meta_to_loc ~locator m in
197
+
let b = Buffer.create 255 in
198
+
let ld = link_definition defs i in
199
+
let link =
200
+
match Link_definition.dest ld with
201
+
| None -> ""
202
+
| Some (link, _) -> pct_esc b link
203
+
in
204
+
let title =
205
+
match Link_definition.title ld with
206
+
| None -> ""
207
+
| Some title ->
208
+
let title = List.map Block_line.tight_to_string title in
209
+
html_esc b (String.concat "\n" title)
210
+
in
211
+
let alt =
212
+
let ls = Inline.to_plain_text ~break_on_soft:false (Inline.Link.text i) in
213
+
html_esc b (String.concat "\n" (List.map (String.concat "") ls))
214
+
in
215
+
let img =
216
+
String.concat ""
217
+
[ {|<img src="|}; link; {|" alt="|}; alt; {|" title="|}; title; {|" >"|} ]
218
+
in
219
+
(Loc.at loc (`Raw_markup (Some "html", img)) :: is, warns)
220
+
221
+
let text_to_inline_elements ~locator s meta ((is, warns) as acc) =
222
+
(* [s] is on a single source line (but may have newlines because of
223
+
character references) we need to tokenize it for ocamldoc's ast. *)
224
+
let flush_tok s meta acc is_space first last =
225
+
let textloc = textloc_of_sub (Meta.textloc meta) ~first ~last in
226
+
let loc = textloc_to_loc ~locator textloc in
227
+
let s = String.sub s first (last - first + 1) in
228
+
Loc.at loc (if is_space then `Space s else `Word s) :: acc
229
+
in
230
+
let rec tokenize s meta acc max start is_space =
231
+
if start > max then (List.rev_append acc is, warns)
232
+
else
233
+
let next_start =
234
+
if is_space then next_nonblank s ~max start else next_blank s ~max start
235
+
in
236
+
let acc = flush_tok s meta acc is_space start (next_start - 1) in
237
+
tokenize s meta acc max next_start (not is_space)
238
+
in
239
+
let max = String.length s - 1 in
240
+
if max < 0 then acc else tokenize s meta [] max 0 (is_blank s.[0])
241
+
242
+
let rec link_reference_to_inline_element ~locator defs l m (is, warns) =
243
+
let loc = meta_to_loc ~locator m in
244
+
let ld = link_definition defs l in
245
+
let link =
246
+
match Link_definition.dest ld with None -> "" | Some (l, _) -> l
247
+
in
248
+
let warns =
249
+
match Link_definition.title ld with
250
+
| None -> warns
251
+
| Some title ->
252
+
let textloc = Block_line.tight_list_textloc title in
253
+
let loc = textloc_to_loc ~locator textloc in
254
+
warn ~loc warn_unsupported_link_title warns
255
+
in
256
+
let text, warns =
257
+
inline_to_inline_elements ~locator defs ([], warns) (Inline.Link.text l)
258
+
in
259
+
(Loc.at loc (`Link (link, text)) :: is, warns)
260
+
261
+
and link_to_inline_element ~locator defs l m acc =
262
+
link_reference_to_inline_element ~locator defs l m acc
263
+
264
+
and emphasis_to_inline_element ~locator defs style e m (is, warns) =
265
+
let loc = meta_to_loc ~locator m in
266
+
let i = Inline.Emphasis.inline e in
267
+
let inlines, warns = inline_to_inline_elements ~locator defs ([], warns) i in
268
+
(Loc.at loc (`Styled (style, inlines)) :: is, warns)
269
+
270
+
and inline_to_inline_elements ~locator defs acc i : inlines_acc =
271
+
match i with
272
+
| Inline.Autolink (a, m) -> autolink_to_inline_element ~locator a m acc
273
+
| Inline.Break (b, m) -> break_to_inline_element ~locator b m acc
274
+
| Inline.Code_span (cs, m) -> code_span_to_inline_element ~locator cs m acc
275
+
| Inline.Emphasis (e, m) ->
276
+
emphasis_to_inline_element ~locator defs `Emphasis e m acc
277
+
| Inline.Image (i, m) -> image_to_inline_element ~locator defs i m acc
278
+
| Inline.Inlines (is, _m) ->
279
+
let inline = inline_to_inline_elements ~locator defs in
280
+
List.fold_left inline acc (List.rev is)
281
+
| Inline.Link (l, m) -> link_to_inline_element ~locator defs l m acc
282
+
| Inline.Raw_html (html, m) -> raw_html_to_inline_element ~locator html m acc
283
+
| Inline.Strong_emphasis (e, m) ->
284
+
emphasis_to_inline_element ~locator defs `Bold e m acc
285
+
| Inline.Text (t, m) -> text_to_inline_elements ~locator t m acc
286
+
| _ -> assert false
287
+
288
+
(* Block translations *)
289
+
290
+
let raw_paragraph ~loc ~raw_loc backend raw =
291
+
Loc.at loc (`Paragraph [ Loc.at raw_loc (`Raw_markup (Some backend, raw)) ])
292
+
293
+
let code_block_to_nestable_block_element ~locator cb m (bs, warns) =
294
+
let loc = meta_to_loc ~locator m in
295
+
let code = Block.Code_block.code cb in
296
+
let code_loc = textloc_to_loc ~locator (Block_line.list_textloc code) in
297
+
let code = String.concat "\n" (List.map Block_line.to_string code) in
298
+
match Block.Code_block.info_string cb with
299
+
| None ->
300
+
let code_block =
301
+
{
302
+
Ast.meta = None;
303
+
delimiter = None;
304
+
content = Loc.at code_loc code;
305
+
output = None;
306
+
}
307
+
(* (None, Loc.at code_loc code) *)
308
+
in
309
+
(Loc.at loc (`Code_block code_block) :: bs, warns)
310
+
| Some (info, im) -> (
311
+
match Block.Code_block.language_of_info_string info with
312
+
| None ->
313
+
let code_block =
314
+
{
315
+
Ast.meta = None;
316
+
delimiter = None;
317
+
content = Loc.at code_loc code;
318
+
output = None;
319
+
}
320
+
in
321
+
(* (None, Loc.at code_loc code) *)
322
+
(Loc.at loc (`Code_block code_block) :: bs, warns)
323
+
| Some ("verb", _) -> (Loc.at loc (`Verbatim code) :: bs, warns)
324
+
| Some ("=html", _) ->
325
+
(raw_paragraph ~loc ~raw_loc:code_loc "html" code :: bs, warns)
326
+
| Some ("=latex", _) ->
327
+
(raw_paragraph ~loc ~raw_loc:code_loc "latex" code :: bs, warns)
328
+
| Some ("=texi", _) ->
329
+
(raw_paragraph ~loc ~raw_loc:code_loc "texi" code :: bs, warns)
330
+
| Some ("=man", _) ->
331
+
(raw_paragraph ~loc ~raw_loc:code_loc "man" code :: bs, warns)
332
+
| Some (lang, env) ->
333
+
let left_count = String.length lang in
334
+
let right_count = String.length env in
335
+
let lang_loc, env_loc =
336
+
split_info_string_locs ~left_count ~right_count im
337
+
in
338
+
let env =
339
+
if env = "" then None
340
+
else Some (Loc.at (textloc_to_loc ~locator env_loc) env)
341
+
in
342
+
let lang = Loc.at (textloc_to_loc ~locator lang_loc) lang in
343
+
let metadata = Some { Ast.language = lang; tags = env } in
344
+
let code_block =
345
+
{
346
+
Ast.meta = metadata;
347
+
delimiter = None;
348
+
content = Loc.at code_loc code;
349
+
output = None;
350
+
}
351
+
(* (metadata, Loc.at code_loc code) *)
352
+
in
353
+
(Loc.at loc (`Code_block code_block) :: bs, warns))
354
+
355
+
let html_block_to_nestable_block_element ~locator html m (bs, warns) =
356
+
let loc = meta_to_loc ~locator m in
357
+
let html = String.concat "\n" (List.map fst html) in
358
+
(raw_paragraph ~loc ~raw_loc:loc "html" html :: bs, warns)
359
+
360
+
let heading_to_block_element ~locator defs h m (bs, warns) =
361
+
let loc = meta_to_loc ~locator m in
362
+
let level, warns =
363
+
match Block.Heading.level h with
364
+
| 6 -> (5, warn ~loc warn_heading_level_6 warns)
365
+
| level -> (level, warns)
366
+
in
367
+
let inline =
368
+
(* cmarkit claims it's already normalized but let's be defensive :-) *)
369
+
Inline.normalize (Block.Heading.inline h)
370
+
in
371
+
let inlines, warns =
372
+
inline_to_inline_elements ~locator defs ([], warns) inline
373
+
in
374
+
(Loc.at loc (`Heading (level, None, inlines)) :: bs, warns)
375
+
376
+
let paragraph_to_nestable_block_element ~locator defs p m (bs, warns) =
377
+
(* TODO Parse inlines for @tags support. *)
378
+
let loc = meta_to_loc ~locator m in
379
+
let i = Block.Paragraph.inline p in
380
+
let is, warns = inline_to_inline_elements ~locator defs ([], warns) i in
381
+
(Loc.at loc (`Paragraph is) :: bs, warns)
382
+
383
+
let thematic_break_to_nestable_block_element ~locator m (bs, warns) =
384
+
let loc = meta_to_loc ~locator m in
385
+
(raw_paragraph ~loc ~raw_loc:loc "html" "<hr>" :: bs, warns)
386
+
387
+
let rec list_to_nestable_block_element ~locator defs l m (bs, warns) =
388
+
let loc = meta_to_loc ~locator m in
389
+
let style = `Heavy (* Note this is a layout property of ocamldoc *) in
390
+
let kind, warns =
391
+
match Block.List'.type' l with
392
+
| `Unordered _ -> (`Unordered, warns)
393
+
| `Ordered (start, _) ->
394
+
( `Ordered,
395
+
if start = 1 then warns
396
+
else warn ~loc (warn_unsupported_list_start_number start) warns )
397
+
in
398
+
let add_item ~locator (acc, warns) (i, _meta) =
399
+
let b = Block.List_item.block i in
400
+
let bs, warns =
401
+
block_to_nestable_block_elements ~locator defs ([], warns) b
402
+
in
403
+
(bs :: acc, warns)
404
+
in
405
+
let ritems = List.rev (Block.List'.items l) in
406
+
let items, warns = List.fold_left (add_item ~locator) ([], warns) ritems in
407
+
(Loc.at loc (`List (kind, style, items)) :: bs, warns)
408
+
409
+
and block_to_nestable_block_elements ~locator defs acc b : nestable_ast_acc =
410
+
match b with
411
+
| Block.Blocks (bs, _) ->
412
+
let block = block_to_nestable_block_elements ~locator defs in
413
+
List.fold_left block acc (List.rev bs)
414
+
| Block.Code_block (c, m) ->
415
+
code_block_to_nestable_block_element ~locator c m acc
416
+
| Block.Heading (_, m) -> warn_unsupported_header_nesting ~locator m acc
417
+
| Block.Html_block (html, m) ->
418
+
html_block_to_nestable_block_element ~locator html m acc
419
+
| Block.List (l, m) -> list_to_nestable_block_element ~locator defs l m acc
420
+
| Block.Paragraph (p, m) ->
421
+
paragraph_to_nestable_block_element ~locator defs p m acc
422
+
| Block.Block_quote (_, m) ->
423
+
warn_unsupported_cmark ~locator "Block quotes" m acc
424
+
| Block.Thematic_break (_, m) ->
425
+
thematic_break_to_nestable_block_element ~locator m acc
426
+
| Block.Blank_line _ | Block.Link_reference_definition _ ->
427
+
(* layout cases *) acc
428
+
| _ -> assert false
429
+
430
+
let rec block_to_ast ~locator defs acc b : ast_acc =
431
+
match b with
432
+
| Block.Heading (h, m) -> heading_to_block_element ~locator defs h m acc
433
+
| Block.Blocks (bs, _) ->
434
+
List.fold_left (block_to_ast ~locator defs) acc (List.rev bs)
435
+
| b ->
436
+
(* We can't go directy with acc because of nestable typing. *)
437
+
let bs, ws = acc in
438
+
let bs', ws = block_to_nestable_block_elements ~locator defs ([], ws) b in
439
+
(List.rev_append (List.rev (bs' :> Ast.t)) bs, ws)
440
+
441
+
(* Parsing comments *)
442
+
443
+
let parse_comment ?buffer:b ~location ~text:s () : Ast.t * Warning.t list =
444
+
let b =
445
+
match b with
446
+
| None -> Buffer.create (String.length s)
447
+
| Some b ->
448
+
Buffer.reset b;
449
+
b
450
+
in
451
+
let locator, text = massage_comment ~location b s in
452
+
let warns = ref [] and file = location.Lexing.pos_fname in
453
+
let doc = Doc.of_string ~file ~locs:true ~strict:true text in
454
+
block_to_ast ~locator (Doc.defs doc) ([], !warns) (Doc.block doc)
+12
src/markdown/doc_of_md.mli
+12
src/markdown/doc_of_md.mli
···
1
+
(** [ocamlmark] support. *)
2
+
3
+
(** {1:parsing ocamlmark parsing} *)
4
+
5
+
val parse_comment :
6
+
?buffer:Buffer.t ->
7
+
location:Lexing.position ->
8
+
text:string ->
9
+
unit ->
10
+
Odoc_parser.Ast.t * Odoc_parser.Warning.t list
11
+
(** [parse_comment ~location ~text] parses the ocamlmark [text] assuming it
12
+
corresponds to [location]. [buffer] is used as a scratch buffer. *)
+6
src/markdown/dune
+6
src/markdown/dune
+74
src/markdown/odoc_md.ml
+74
src/markdown/odoc_md.ml
···
1
+
(* This exe will compile a markdown file, outputting a compiled `page-x.odoc` file.
2
+
This is tightly coupled with the internal representation of odoc files and thus needs
3
+
to be run with the exact same version of odoc that it is compiled with. *)
4
+
5
+
open Odoc_model
6
+
7
+
let parse id input_s =
8
+
let location =
9
+
Lexing.{ pos_fname = input_s; pos_lnum = 1; pos_cnum = 0; pos_bol = 0 }
10
+
in
11
+
let str = In_channel.(with_open_bin input_s input_all) in
12
+
let content, _warnings = Doc_of_md.parse_comment ~location ~text:str () in
13
+
let (content, ()) = Semantics.ast_to_comment ~internal_tags:Expect_none
14
+
~sections_allowed:`All ~tags_allowed:true
15
+
~parent_of_sections:(id :> Paths.Identifier.LabelParent.t) content []
16
+
|> Error.raise_warnings in
17
+
content
18
+
19
+
let mk_page input_s id content =
20
+
(* Construct the output file representation *)
21
+
let zero_heading = Comment.find_zero_heading content in
22
+
let frontmatter, content = Comment.extract_frontmatter content in
23
+
let digest = Digest.file input_s in
24
+
let root =
25
+
let file =
26
+
Root.Odoc_file.create_page input_s zero_heading frontmatter
27
+
in
28
+
{ Root.id = (id :> Paths.Identifier.OdocId.t); file; digest }
29
+
in
30
+
let children=[] in
31
+
{ Lang.Page.name=id; root; children; content; digest; linked = false; frontmatter }
32
+
33
+
let run input_s parent_id_str odoc_dir =
34
+
(* Construct the id of this page *)
35
+
let page_name =
36
+
Filename.basename input_s |> Filename.chop_extension
37
+
in
38
+
let parent_id = Odoc_odoc.Compile.mk_id parent_id_str in
39
+
let id = Odoc_model.Paths.Identifier.Mk.leaf_page (parent_id, Odoc_model.Names.PageName.make_std page_name) in
40
+
41
+
let content = parse id input_s in
42
+
let page = mk_page input_s id content in
43
+
44
+
let output = Fpath.(v odoc_dir // v parent_id_str / ("page-" ^ page_name ^ ".odoc")) in
45
+
Odoc_odoc.Odoc_file.save_page output ~warnings:[] page
46
+
47
+
open Cmdliner
48
+
49
+
let input =
50
+
let doc = "Input markdown file." in
51
+
Arg.(required & pos 0 (some file) None & info ~doc ~docv:"FILE" [])
52
+
53
+
let parent_id =
54
+
let doc = "Parent id. This defines both the location of the resulting odoc file as well as the \
55
+
location of the eventual html or other file." in
56
+
Arg.(
57
+
required
58
+
& opt (some string) None
59
+
& info ~docv:"PARENT" ~doc [ "parent-id" ])
60
+
61
+
let output_dir =
62
+
let doc = "Output file directory. The output file will be put in the parent-id path below this." in
63
+
Arg.(
64
+
required
65
+
& opt (some string) None
66
+
& info ~docv:"PATH" ~doc [ "output-dir" ])
67
+
68
+
let cmd =
69
+
let doc = "Compile a markdown file to an odoc page-*.odoc file." in
70
+
let info = Cmd.info "odoc-md" ~doc in
71
+
Cmd.v info
72
+
Term.(const run $ input $ parent_id $ output_dir)
73
+
74
+
let () = Cmdliner.(exit @@ Cmd.eval cmd)
+6
-5
src/odoc/compile.ml
+6
-5
src/odoc/compile.ml
···
244
244
Ok (Paths.Identifier.Mk.page (parent_id, page_name))
245
245
| None -> Ok (Paths.Identifier.Mk.page (parent_id, page_name)))
246
246
>>= fun id -> Ok (id :> Paths.Identifier.Page.t))
247
-
>>= fun name ->
247
+
>>= fun id ->
248
248
let resolve content =
249
249
let zero_heading = Comment.find_zero_heading content in
250
250
let frontmatter, content = Comment.extract_frontmatter content in
251
-
if (not (is_index_page name)) && has_children_order frontmatter then
251
+
if (not (is_index_page id)) && has_children_order frontmatter then
252
252
Error.raise_warning
253
253
(Error.filename_only
254
254
"Non-index page cannot specify (children _) in the frontmatter."
···
257
257
let file =
258
258
Root.Odoc_file.create_page root_name zero_heading frontmatter
259
259
in
260
-
{ Root.id = (name :> Paths.Identifier.OdocId.t); file; digest }
260
+
{ Root.id = (id :> Paths.Identifier.OdocId.t); file; digest }
261
261
in
262
262
let page =
263
263
Lang.Page.
264
-
{ name; root; children; content; digest; linked = false; frontmatter }
264
+
{ name=id; root; children; content; digest; linked = false; frontmatter }
265
265
in
266
266
Odoc_file.save_page output ~warnings:[] page;
267
267
()
···
270
270
Error.handle_errors_and_warnings ~warnings_options
271
271
@@ Error.catch_errors_and_warnings
272
272
@@ fun () ->
273
-
Odoc_loader.read_string (name :> Paths.Identifier.LabelParent.t) input_s str
273
+
Odoc_loader.read_string (id :> Paths.Identifier.LabelParent.t) input_s str
274
274
|> Error.raise_errors_and_warnings
275
275
|> function
276
276
| `Stop -> resolve [] (* TODO: Error? *)
277
277
| `Docs content -> resolve content
278
+
278
279
279
280
let handle_file_ext ext =
280
281
match ext with