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
let parse ~loc text =
let location = loc.Location.loc_start in
let location =
{ location with
pos_cnum= location.pos_cnum + 3 }
in
let v = Odoc_parser.parse_comment ~location ~text in
match Odoc_parser.warnings v with
| [] -> Ok (Odoc_parser.ast v)
| warnings -> Error warnings
let parse_file location text =
Odoc_parser.ast (Odoc_parser.parse_comment ~location ~text)
let warn fmt warning =
Format.fprintf fmt "Warning: Invalid documentation comment:@,%s\n%!"
(Odoc_parser.Warning.to_string warning)
type error =
| Moved of Location.t * Location.t * string
| Unstable of Location.t * string * string
| Added of Location.t * string
| Removed of Location.t * string
let is_tag_only =
List.for_all ~f:(function
| {Odoc_parser.Loc.value= `Tag _; _} -> true
| _ -> false )
type norm_conf = {normalize_code: string -> string}
let normalize_text s =
String.concat ~sep:" "
(List.filter ~f:(Fn.non String.is_empty)
(String.split_on_chars s ~on:['\t'; '\n'; '\011'; '\012'; '\r'; ' ']) )
let list f fmt l =
let pp_sep fmt () = Format.fprintf fmt "" in
Format.pp_print_list ~pp_sep f fmt l
let str fmt s = Format.fprintf fmt "%s" (normalize_text s)
let ign_loc f fmt with_loc = f fmt with_loc.Odoc_parser.Loc.value
let fpf = Format.fprintf
let odoc_reference = ign_loc str
let option f fmt = function Some v -> f fmt v | None -> ()
let pair fmt_a fmt_b fmt (a, b) = fpf fmt "(%a,%a)" fmt_a a fmt_b b
let odoc_style fmt = function
| `Bold -> fpf fmt "Bold"
| `Italic -> fpf fmt "Italic"
| `Emphasis -> fpf fmt "Emphasis"
| `Superscript -> fpf fmt "Superscript"
| `Subscript -> fpf fmt "Subscript"
let rec odoc_inline_element fmt = function
| `Space _ -> ()
| `Word txt ->
let txt =
String.filter txt ~f:(function '\\' -> false | _ -> true)
in
fpf fmt "Word(%a)" str txt
| `Code_span txt -> fpf fmt "Code_span(%a)" str txt
| `Math_span txt -> fpf fmt "Math_span(%a)" str txt
| `Raw_markup (Some lang, txt) -> fpf fmt "Raw_markup(%s,%a)" lang str txt
| `Raw_markup (None, txt) -> fpf fmt "Raw_markup(%a)" str txt
| `Styled (style, elems) ->
fpf fmt "Styled(%a,%a)" odoc_style style odoc_inline_elements elems
| `Reference (_kind, ref, content) ->
fpf fmt "Reference(%a,%a)" odoc_reference ref odoc_inline_elements
content
| `Link (txt, content) ->
fpf fmt "Link(%a,%a)" str txt odoc_inline_elements content
and odoc_inline_elements fmt elems =
list (ign_loc odoc_inline_element) fmt elems
let rec odoc_nestable_block_element c fmt = function
| `Paragraph elms -> fpf fmt "Paragraph(%a)" odoc_inline_elements elms
| `Code_block (metadata, txt) ->
let txt = Odoc_parser.Loc.value txt in
let txt = c.normalize_code txt in
let fmt_metadata =
option (pair (ign_loc str) (option (ign_loc str)))
in
fpf fmt "Code_block(%a, %a)" fmt_metadata metadata str txt
| `Math_block txt -> fpf fmt "Math_block(%a)" str txt
| `Verbatim txt -> fpf fmt "Verbatim(%a)" str txt
| `Modules mods -> fpf fmt "Modules(%a)" (list odoc_reference) mods
| `List (ord, _syntax, items) ->
let ord = match ord with `Unordered -> "U" | `Ordered -> "O" in
let list_item fmt elems =
fpf fmt "Item(%a)" (odoc_nestable_block_elements c) elems
in
fpf fmt "List(%s,%a)" ord (list list_item) items
and odoc_nestable_block_elements c fmt elems =
list (ign_loc (odoc_nestable_block_element c)) fmt elems
let odoc_tag c fmt = function
| `Author txt -> fpf fmt "Author(%a)" str txt
| `Deprecated elems ->
fpf fmt "Deprecated(%a)" (odoc_nestable_block_elements c) elems
| `Param (p, elems) ->
fpf fmt "Param(%a,%a)" str p (odoc_nestable_block_elements c) elems
| `Raise (p, elems) ->
fpf fmt "Raise(%a,%a)" str p (odoc_nestable_block_elements c) elems
| `Return elems ->
fpf fmt "Return(%a)" (odoc_nestable_block_elements c) elems
| `See (kind, txt, elems) ->
let kind =
match kind with `Url -> "U" | `File -> "F" | `Document -> "D"
in
fpf fmt "See(%s,%a,%a)" kind str txt
(odoc_nestable_block_elements c)
elems
| `Since txt -> fpf fmt "Since(%a)" str txt
| `Before (p, elems) ->
fpf fmt "Before(%a,%a)" str p (odoc_nestable_block_elements c) elems
| `Version txt -> fpf fmt "Version(%a)" str txt
| `Canonical ref -> fpf fmt "Canonical(%a)" odoc_reference ref
| `Inline -> fpf fmt "Inline"
| `Open -> fpf fmt "Open"
| `Closed -> fpf fmt "Closed"
let odoc_block_element c fmt = function
| `Heading (lvl, lbl, content) ->
let lvl = Int.to_string lvl in
let lbl = match lbl with Some lbl -> lbl | None -> "" in
fpf fmt "Heading(%s,%a,%a)" lvl str lbl odoc_inline_elements content
| `Tag tag -> fpf fmt "Tag(%a)" (odoc_tag c) tag
| #Odoc_parser.Ast.nestable_block_element as elm ->
odoc_nestable_block_element c fmt elm
let odoc_docs c fmt elems = list (ign_loc (odoc_block_element c)) fmt elems
let normalize ~parse_docstrings ~normalize_code text =
if not parse_docstrings then normalize_text text
else
let location = Lexing.dummy_pos in
let parsed = Odoc_parser.parse_comment ~location ~text in
let c = {normalize_code} in
Format.asprintf "Docstring(%a)%!" (odoc_docs c) (Odoc_parser.ast parsed)
let dump fmt x =
let c = {normalize_code= Fn.id} in
Format.fprintf fmt "Docstring(%a)%!" (odoc_docs c) x