Skip to content

Commit 382e2ea

Browse files
EmileTrotignonpanglesd
authored andcommitted
Search : printing update
Signed-off-by: Paul-Elliot <peada@free.fr>
1 parent 4a338a8 commit 382e2ea

File tree

9 files changed

+314
-256
lines changed

9 files changed

+314
-256
lines changed

src/search/entry.ml

Lines changed: 34 additions & 55 deletions
Original file line numberDiff line numberDiff line change
@@ -41,7 +41,7 @@ type doc_entry = Paragraph | Heading | CodeBlock | MathBlock | Verbatim
4141

4242
type value_entry = { value : Value.value; type_ : TypeExpr.t }
4343

44-
type extra =
44+
type kind =
4545
| TypeDecl of type_decl_entry
4646
| Module
4747
| Value of value_entry
@@ -61,13 +61,14 @@ module Html = Tyxml.Html
6161
type t = {
6262
id : Odoc_model.Paths.Identifier.Any.t;
6363
doc : Odoc_model.Comment.docs;
64-
extra : extra;
65-
html : Html_types.div Html.elt;
64+
kind : kind;
6665
}
6766

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 =
6970
let id = (id :> Odoc_model.Paths.Identifier.Any.t) in
70-
{ id; extra; doc; html }
71+
{ id; kind; doc }
7172

7273
let varify_params =
7374
List.mapi (fun i param ->
@@ -77,15 +78,6 @@ let varify_params =
7778

7879
let entry_of_constructor id_parent params (constructor : TypeDecl.Constructor.t)
7980
=
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
8981
let args = constructor.args in
9082
let res =
9183
match constructor.res with
@@ -97,20 +89,11 @@ let entry_of_constructor id_parent params (constructor : TypeDecl.Constructor.t)
9789
((id_parent :> Odoc_model.Paths.Identifier.Path.Type.t), false),
9890
params )
9991
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
10294

10395
let entry_of_extension_constructor id_parent params
10496
(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
11497
let args = constructor.args in
11598
let res =
11699
match constructor.res with
@@ -119,8 +102,8 @@ let entry_of_extension_constructor id_parent params
119102
let params = varify_params params in
120103
TypeExpr.Constr (id_parent, params)
121104
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
124107

125108
let entry_of_field id_parent params (field : TypeDecl.Field.t) =
126109
let params = varify_params params in
@@ -130,46 +113,42 @@ let entry_of_field id_parent params (field : TypeDecl.Field.t) =
130113
((id_parent :> Odoc_model.Paths.Identifier.Path.Type.t), false),
131114
params )
132115
in
133-
let extra =
116+
let kind =
134117
Field { mutable_ = field.mutable_; type_ = field.type_; parent_type }
135118
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
138120

139121
let rec entries_of_docs id (d : Odoc_model.Comment.docs) =
140122
List.concat_map (entries_of_doc id) d
141123

142124
and entries_of_doc id d =
143-
let html = Html.div ~a:[] [] in
144125
match d.value with
145-
| `Paragraph _ -> [ entry ~id ~doc:[ d ] ~extra:(Doc Paragraph) ~html ]
126+
| `Paragraph _ -> [ entry ~id ~doc:[ d ] ~kind:(Doc Paragraph) ]
146127
| `Tag _ -> []
147128
| `List (_, ds) ->
148129
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) ]
151131
| `Modules _ -> []
152132
| `Code_block (_, _, o) ->
153133
let o =
154134
match o with
155135
| None -> []
156136
| Some o -> entries_of_docs id (o :> Odoc_model.Comment.docs)
157137
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) ]
161141
| `Table _ -> []
162142

163143
let entries_of_item id (x : Odoc_model.Fold.item) =
164-
let html = Generator.html_of_entry x in
165144
match x with
166145
| CompilationUnit u -> (
167146
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 ]
169148
| Pack _ -> [])
170149
| TypeDecl td ->
171150
let txt = Render.text_of_typedecl td in
172-
let extra =
151+
let kind =
173152
TypeDecl
174153
{
175154
txt;
@@ -178,7 +157,7 @@ let entries_of_item id (x : Odoc_model.Fold.item) =
178157
representation = td.representation;
179158
}
180159
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
182161
let subtype_entries =
183162
match td.representation with
184163
| None -> []
@@ -189,28 +168,28 @@ let entries_of_item id (x : Odoc_model.Fold.item) =
189168
| Some Extensible -> []
190169
in
191170
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 ]
193172
| 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 ]
196175
| Exception exc ->
197176
let res =
198177
Option.value exc.res
199178
~default:(TypeExpr.Constr (Odoc_model.Predefined.exn_path, []))
200179
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 ]
203182
| 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 ]
206185
| Method m ->
207-
let extra =
186+
let kind =
208187
Method { virtual_ = m.virtual_; private_ = m.private_; type_ = m.type_ }
209188
in
210-
[ entry ~id:m.id ~doc:m.doc ~extra ~html ]
189+
[ entry ~id:m.id ~doc:m.doc ~kind ]
211190
| 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 ]
214193
| Extension te -> (
215194
match te.constructors with
216195
| [] -> []
@@ -219,21 +198,21 @@ let entries_of_item id (x : Odoc_model.Fold.item) =
219198
constructor for the url. Unfortunately, this breaks the uniqueness
220199
of the ID in the search index... *)
221200
let type_entry =
222-
let extra =
201+
let kind =
223202
TypeExtension
224203
{
225204
type_path = te.type_path;
226205
type_params = te.type_params;
227206
private_ = te.private_;
228207
}
229208
in
230-
entry ~id:c.id ~doc:te.doc ~extra ~html
209+
entry ~id:c.id ~doc:te.doc ~kind
231210
in
232211

233212
type_entry
234213
:: List.map
235214
(entry_of_extension_constructor te.type_path te.type_params)
236215
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 ]
238217
| Doc `Stop -> []
239218
| Doc (`Docs d) -> entries_of_docs id d

src/search/entry.mli

Lines changed: 5 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -41,7 +41,7 @@ type doc_entry = Paragraph | Heading | CodeBlock | MathBlock | Verbatim
4141

4242
type value_entry = { value : Value.value; type_ : TypeExpr.t }
4343

44-
type extra =
44+
type kind =
4545
| TypeDecl of type_decl_entry
4646
| Module
4747
| Value of value_entry
@@ -59,9 +59,11 @@ type extra =
5959
type t = {
6060
id : Odoc_model.Paths.Identifier.Any.t;
6161
doc : Odoc_model.Comment.docs;
62-
extra : extra;
63-
html : Html_types.div Tyxml.Html.elt;
62+
kind : kind;
6463
}
6564

65+
type with_html = { entry : t; html : [ `Code | `Div ] Tyxml.Html.elt list }
66+
(** You can use {!Generator.with_html} to get a value of this type. *)
67+
6668
val entries_of_item :
6769
Odoc_model.Paths.Identifier.Any.t -> Odoc_model.Fold.item -> t list

0 commit comments

Comments
 (0)