@@ -175,22 +175,25 @@ and get_class_elements node =
175
175
match node.t_node with
176
176
| Class_expr _ ->
177
177
List. concat_map (Lazy. force node.t_children) ~f: get_class_elements
178
+ | Class_field cf ->
179
+ let children =
180
+ List. concat_map (Lazy. force node.t_children) ~f: get_class_elements
181
+ in
182
+ cf.cf_desc |> get_class_field_desc_infos
183
+ |> Option. map ~f: (fun (str_loc , outline_kind ) ->
184
+ let deprecated = Type_utils. is_deprecated cf.cf_attributes in
185
+ { Query_protocol. outline_name = str_loc.Location. txt;
186
+ outline_kind;
187
+ outline_type = None ;
188
+ location = str_loc.Location. loc;
189
+ children;
190
+ deprecated
191
+ })
192
+ |> Option. to_list
193
+ | Class_field_kind _ ->
194
+ List. concat_map (Lazy. force node.t_children) ~f: get_val_elements
178
195
| Class_structure _ ->
179
- List. filter_map (Lazy. force node.t_children) ~f: (fun child ->
180
- match child.t_node with
181
- | Class_field cf -> begin
182
- cf.cf_desc |> get_class_field_desc_infos
183
- |> Option. map ~f: (fun (str_loc , outline_kind , children ) ->
184
- let deprecated = Type_utils. is_deprecated cf.cf_attributes in
185
- { Query_protocol. outline_name = str_loc.Location. txt;
186
- outline_kind;
187
- outline_type = None ;
188
- location = str_loc.Location. loc;
189
- children;
190
- deprecated
191
- })
192
- end
193
- | _ -> None )
196
+ List. concat_map (Lazy. force node.t_children) ~f: get_class_elements
194
197
| Class_type { cltyp_desc = Tcty_signature { csig_fields; _ } ; _ } ->
195
198
List. filter_map csig_fields ~f: (fun field ->
196
199
get_class_signature_field_desc_infos field.ctf_desc
@@ -207,42 +210,10 @@ and get_class_elements node =
207
210
| _ -> []
208
211
209
212
and get_class_field_desc_infos = function
210
- | Typedtree. Tcf_val (str_loc , _ , _ , field_kind , _ ) ->
211
- Some (str_loc, `Value , get_class_field_kind_elements field_kind)
212
- | Typedtree. Tcf_method (str_loc , _ , field_kind ) ->
213
- Some (str_loc, `Method , get_class_field_kind_elements field_kind)
213
+ | Typedtree. Tcf_val (str_loc , _ , _ , _field_kind , _ ) -> Some (str_loc, `Value )
214
+ | Typedtree. Tcf_method (str_loc , _ , _field_kind ) -> Some (str_loc, `Method )
214
215
| _ -> None
215
216
216
- and get_class_field_kind_elements = function
217
- | Tcfk_virtual _ -> []
218
- | Tcfk_concrete (_ , expr ) -> get_expr_elements expr
219
-
220
- and get_expr_elements expr =
221
- match expr.exp_desc with
222
- | Texp_let (_ , vbs , expr ) ->
223
- List. filter_map vbs ~f: (fun vb ->
224
- id_of_patt vb.vb_pat
225
- |> Option. map ~f: (fun ident ->
226
- let children = get_expr_elements vb.vb_expr in
227
- let deprecated = Type_utils. is_deprecated vb.vb_attributes in
228
-
229
- mk ~children ~location: vb.vb_loc ~deprecated `Value None ident))
230
- @ get_expr_elements expr
231
- | Texp_object ({ cstr_fields; _ } , _ ) ->
232
- List. filter_map cstr_fields ~f: (fun field ->
233
- field.cf_desc |> get_class_field_desc_infos
234
- |> Option. map ~f: (fun (str_loc , outline_kind , children ) ->
235
- let deprecated = Type_utils. is_deprecated field.cf_attributes in
236
- { Query_protocol. outline_name = str_loc.Location. txt;
237
- outline_kind;
238
- outline_type = None ;
239
- location = str_loc.Location. loc;
240
- children;
241
- deprecated
242
- }))
243
- | Texp_function (_ , Tfunction_body expr ) -> get_expr_elements expr
244
- | _ -> []
245
-
246
217
and get_mod_children node =
247
218
List. concat_map (Lazy. force node.t_children) ~f: remove_mod_indir
248
219
0 commit comments