@@ -41,7 +41,7 @@ type doc_entry = Paragraph | Heading | CodeBlock | MathBlock | Verbatim
41
41
42
42
type value_entry = { value : Value .value ; type_ : TypeExpr .t }
43
43
44
- type extra =
44
+ type kind =
45
45
| TypeDecl of type_decl_entry
46
46
| Module
47
47
| Value of value_entry
@@ -61,13 +61,14 @@ module Html = Tyxml.Html
61
61
type t = {
62
62
id : Odoc_model.Paths.Identifier.Any .t ;
63
63
doc : Odoc_model.Comment .docs ;
64
- extra : extra ;
65
- html : Html_types .div Html .elt ;
64
+ kind : kind ;
66
65
}
67
66
68
- let entry ~id ~doc ~extra ~html =
67
+ type with_html = { entry : t ; html : [ `Code | `Div ] Tyxml.Html .elt list }
68
+
69
+ let entry ~id ~doc ~kind =
69
70
let id = (id :> Odoc_model.Paths.Identifier.Any.t ) in
70
- { id; extra ; doc; html }
71
+ { id; kind ; doc }
71
72
72
73
let varify_params =
73
74
List. mapi (fun i param ->
@@ -77,15 +78,6 @@ let varify_params =
77
78
78
79
let entry_of_constructor id_parent params (constructor : TypeDecl.Constructor.t )
79
80
=
80
- let html =
81
- Tyxml.Html. div ~a: []
82
- [
83
- Tyxml.Html. txt
84
- @@ Generator. constructor
85
- (constructor.id :> Identifier.t )
86
- constructor.args constructor.res;
87
- ]
88
- in
89
81
let args = constructor.args in
90
82
let res =
91
83
match constructor.res with
@@ -97,20 +89,11 @@ let entry_of_constructor id_parent params (constructor : TypeDecl.Constructor.t)
97
89
((id_parent :> Odoc_model.Paths.Identifier.Path.Type.t ), false ),
98
90
params )
99
91
in
100
- let extra = Constructor { args; res } in
101
- entry ~id: constructor.id ~doc: constructor.doc ~extra ~html
92
+ let kind = Constructor { args; res } in
93
+ entry ~id: constructor.id ~doc: constructor.doc ~kind
102
94
103
95
let entry_of_extension_constructor id_parent params
104
96
(constructor : Extension.Constructor.t ) =
105
- let html =
106
- Tyxml.Html. div ~a: []
107
- [
108
- Tyxml.Html. txt
109
- @@ Generator. constructor
110
- (constructor.id :> Identifier.t )
111
- constructor.args constructor.res;
112
- ]
113
- in
114
97
let args = constructor.args in
115
98
let res =
116
99
match constructor.res with
@@ -119,8 +102,8 @@ let entry_of_extension_constructor id_parent params
119
102
let params = varify_params params in
120
103
TypeExpr. Constr (id_parent, params)
121
104
in
122
- let extra = ExtensionConstructor { args; res } in
123
- entry ~id: constructor.id ~doc: constructor.doc ~extra ~html
105
+ let kind = ExtensionConstructor { args; res } in
106
+ entry ~id: constructor.id ~doc: constructor.doc ~kind
124
107
125
108
let entry_of_field id_parent params (field : TypeDecl.Field.t ) =
126
109
let params = varify_params params in
@@ -130,46 +113,42 @@ let entry_of_field id_parent params (field : TypeDecl.Field.t) =
130
113
((id_parent :> Odoc_model.Paths.Identifier.Path.Type.t ), false ),
131
114
params )
132
115
in
133
- let extra =
116
+ let kind =
134
117
Field { mutable_ = field.mutable_; type_ = field.type_; parent_type }
135
118
in
136
- let html = Html. div ~a: [] [] in
137
- entry ~id: field.id ~doc: field.doc ~extra ~html
119
+ entry ~id: field.id ~doc: field.doc ~kind
138
120
139
121
let rec entries_of_docs id (d : Odoc_model.Comment.docs ) =
140
122
List. concat_map (entries_of_doc id) d
141
123
142
124
and entries_of_doc id d =
143
- let html = Html. div ~a: [] [] in
144
125
match d.value with
145
- | `Paragraph _ -> [ entry ~id ~doc: [ d ] ~extra : (Doc Paragraph ) ~html ]
126
+ | `Paragraph _ -> [ entry ~id ~doc: [ d ] ~kind : (Doc Paragraph ) ]
146
127
| `Tag _ -> []
147
128
| `List (_ , ds ) ->
148
129
List. concat_map (entries_of_docs id) (ds :> Odoc_model.Comment.docs list )
149
- | `Heading (_ , lbl , _ ) ->
150
- [ entry ~id: lbl ~doc: [ d ] ~extra: (Doc Heading ) ~html ]
130
+ | `Heading (_ , lbl , _ ) -> [ entry ~id: lbl ~doc: [ d ] ~kind: (Doc Heading ) ]
151
131
| `Modules _ -> []
152
132
| `Code_block (_ , _ , o ) ->
153
133
let o =
154
134
match o with
155
135
| None -> []
156
136
| Some o -> entries_of_docs id (o :> Odoc_model.Comment.docs )
157
137
in
158
- entry ~id ~doc: [ d ] ~extra : (Doc CodeBlock ) ~html :: o
159
- | `Verbatim _ -> [ entry ~id ~doc: [ d ] ~extra : (Doc Verbatim ) ~html ]
160
- | `Math_block _ -> [ entry ~id ~doc: [ d ] ~extra : (Doc MathBlock ) ~html ]
138
+ entry ~id ~doc: [ d ] ~kind : (Doc CodeBlock ) :: o
139
+ | `Verbatim _ -> [ entry ~id ~doc: [ d ] ~kind : (Doc Verbatim ) ]
140
+ | `Math_block _ -> [ entry ~id ~doc: [ d ] ~kind : (Doc MathBlock ) ]
161
141
| `Table _ -> []
162
142
163
143
let entries_of_item id (x : Odoc_model.Fold.item ) =
164
- let html = Generator. html_of_entry x in
165
144
match x with
166
145
| CompilationUnit u -> (
167
146
match u.content with
168
- | Module m -> [ entry ~id: u.id ~doc: m.doc ~extra : Module ~html ]
147
+ | Module m -> [ entry ~id: u.id ~doc: m.doc ~kind : Module ]
169
148
| Pack _ -> [] )
170
149
| TypeDecl td ->
171
150
let txt = Render. text_of_typedecl td in
172
- let extra =
151
+ let kind =
173
152
TypeDecl
174
153
{
175
154
txt;
@@ -178,7 +157,7 @@ let entries_of_item id (x : Odoc_model.Fold.item) =
178
157
representation = td.representation;
179
158
}
180
159
in
181
- let td_entry = entry ~id: td.id ~doc: td.doc ~extra ~html in
160
+ let td_entry = entry ~id: td.id ~doc: td.doc ~kind in
182
161
let subtype_entries =
183
162
match td.representation with
184
163
| None -> []
@@ -189,28 +168,28 @@ let entries_of_item id (x : Odoc_model.Fold.item) =
189
168
| Some Extensible -> []
190
169
in
191
170
td_entry :: subtype_entries
192
- | Module m -> [ entry ~id: m.id ~doc: m.doc ~extra : Module ~html ]
171
+ | Module m -> [ entry ~id: m.id ~doc: m.doc ~kind : Module ]
193
172
| Value v ->
194
- let extra = Value { value = v.value; type_ = v.type_ } in
195
- [ entry ~id: v.id ~doc: v.doc ~extra ~html ]
173
+ let kind = Value { value = v.value; type_ = v.type_ } in
174
+ [ entry ~id: v.id ~doc: v.doc ~kind ]
196
175
| Exception exc ->
197
176
let res =
198
177
Option. value exc.res
199
178
~default: (TypeExpr. Constr (Odoc_model.Predefined. exn_path, [] ))
200
179
in
201
- let extra = Exception { args = exc.args; res } in
202
- [ entry ~id: exc.id ~doc: exc.doc ~extra ~html ]
180
+ let kind = Exception { args = exc.args; res } in
181
+ [ entry ~id: exc.id ~doc: exc.doc ~kind ]
203
182
| ClassType ct ->
204
- let extra = Class_type { virtual_ = ct.virtual_; params = ct.params } in
205
- [ entry ~id: ct.id ~doc: ct.doc ~extra ~html ]
183
+ let kind = Class_type { virtual_ = ct.virtual_; params = ct.params } in
184
+ [ entry ~id: ct.id ~doc: ct.doc ~kind ]
206
185
| Method m ->
207
- let extra =
186
+ let kind =
208
187
Method { virtual_ = m.virtual_; private_ = m.private_; type_ = m.type_ }
209
188
in
210
- [ entry ~id: m.id ~doc: m.doc ~extra ~html ]
189
+ [ entry ~id: m.id ~doc: m.doc ~kind ]
211
190
| Class cl ->
212
- let extra = Class { virtual_ = cl.virtual_; params = cl.params } in
213
- [ entry ~id: cl.id ~doc: cl.doc ~extra ~html ]
191
+ let kind = Class { virtual_ = cl.virtual_; params = cl.params } in
192
+ [ entry ~id: cl.id ~doc: cl.doc ~kind ]
214
193
| Extension te -> (
215
194
match te.constructors with
216
195
| [] -> []
@@ -219,21 +198,21 @@ let entries_of_item id (x : Odoc_model.Fold.item) =
219
198
constructor for the url. Unfortunately, this breaks the uniqueness
220
199
of the ID in the search index... *)
221
200
let type_entry =
222
- let extra =
201
+ let kind =
223
202
TypeExtension
224
203
{
225
204
type_path = te.type_path;
226
205
type_params = te.type_params;
227
206
private_ = te.private_;
228
207
}
229
208
in
230
- entry ~id: c.id ~doc: te.doc ~extra ~html
209
+ entry ~id: c.id ~doc: te.doc ~kind
231
210
in
232
211
233
212
type_entry
234
213
:: List. map
235
214
(entry_of_extension_constructor te.type_path te.type_params)
236
215
te.constructors)
237
- | ModuleType mt -> [ entry ~id: mt.id ~doc: mt.doc ~extra : ModuleType ~html ]
216
+ | ModuleType mt -> [ entry ~id: mt.id ~doc: mt.doc ~kind : ModuleType ]
238
217
| Doc `Stop -> []
239
218
| Doc (`Docs d ) -> entries_of_docs id d
0 commit comments