Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension


Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion .github/workflows/changelog.yml
Original file line number Diff line number Diff line change
Expand Up @@ -8,6 +8,6 @@ on:
jobs:
Changelog-Entry-Check:
name: Check Changelog Action
runs-on: ubuntu-20.04
runs-on: ubuntu-latest
steps:
- uses: tarides/changelog-check-action@v3
2 changes: 2 additions & 0 deletions CHANGES.md
Original file line number Diff line number Diff line change
Expand Up @@ -15,6 +15,8 @@ unreleased
fixes #1913)
- Downstreamed a typer fix from 5.3.X that would trigger assertions linked
to scopes bit masks when backtracking the typer cache (#1935)
- Add a new selection field to outline results that contains the location of
the symbol itself. (#1942)
+ ocaml-index
- Improve the granularity of index reading by segmenting the marshalization
of the involved data-structures. (#1889)
Expand Down
52 changes: 28 additions & 24 deletions src/analysis/outline.ml
Original file line number Diff line number Diff line change
Expand Up @@ -35,16 +35,18 @@ open Typedtree
open Browse_raw
open Browse_tree

let id_of_patt = function
| { pat_desc = Tpat_var (id, _, _); _ } -> Some id
let name_of_patt = function
| { pat_desc = Tpat_var (_, name, _); _ } -> Some name
| _ -> None

let mk ?(children = []) ~location ~deprecated outline_kind outline_type id =
let mk ?(children = []) ~location ~deprecated outline_kind outline_type
(name : string Location.loc) =
{ Query_protocol.outline_kind;
outline_type;
location;
selection = name.loc;
children;
outline_name = Ident.name id;
outline_name = name.txt;
deprecated
}

Expand All @@ -69,38 +71,38 @@ let rec summarize node =
in
let deprecated = Type_utils.is_deprecated vb.vb_attributes in
begin
match id_of_patt vb.vb_pat with
match name_of_patt vb.vb_pat with
| None -> None
| Some ident ->
| Some name ->
let typ = outline_type ~env:node.t_env vb.vb_pat.pat_type in
Some (mk ~children ~location ~deprecated `Value typ ident)
Some (mk ~children ~location ~deprecated `Value typ name)
end
| Value_description vd ->
let deprecated = Type_utils.is_deprecated vd.val_attributes in
let typ = outline_type ~env:node.t_env vd.val_val.val_type in
Some (mk ~location ~deprecated `Value typ vd.val_id)
Some (mk ~location ~deprecated `Value typ vd.val_name)
| Module_declaration md ->
let children = get_mod_children node in
begin
match md.md_id with
| None -> None
| Some id ->
match md.md_name with
| { txt = None; _ } -> None
| { txt = Some txt; loc } ->
let deprecated = Type_utils.is_deprecated md.md_attributes in
Some (mk ~children ~location ~deprecated `Module None id)
Some (mk ~children ~location ~deprecated `Module None { txt; loc })
end
| Module_binding mb ->
let children = get_mod_children node in
begin
match mb.mb_id with
| None -> None
| Some id ->
match mb.mb_name with
| { txt = None; _ } -> None
| { txt = Some txt; loc } ->
let deprecated = Type_utils.is_deprecated mb.mb_attributes in
Some (mk ~children ~location ~deprecated `Module None id)
Some (mk ~children ~location ~deprecated `Module None { txt; loc })
end
| Module_type_declaration mtd ->
let children = get_mod_children node in
let deprecated = Type_utils.is_deprecated mtd.mtd_attributes in
Some (mk ~deprecated ~children ~location `Modtype None mtd.mtd_id)
Some (mk ~deprecated ~children ~location `Modtype None mtd.mtd_name)
| Type_declaration td ->
let children =
List.concat_map (Lazy.force node.t_children) ~f:(fun child ->
Expand All @@ -110,15 +112,15 @@ let rec summarize node =
match x.t_node with
| Constructor_declaration c ->
let deprecated = Type_utils.is_deprecated c.cd_attributes in
mk `Constructor None c.cd_id ~deprecated ~location:c.cd_loc
mk `Constructor None c.cd_name ~deprecated ~location:c.cd_loc
| Label_declaration ld ->
let deprecated = Type_utils.is_deprecated ld.ld_attributes in
mk `Label None ld.ld_id ~deprecated ~location:ld.ld_loc
mk `Label None ld.ld_name ~deprecated ~location:ld.ld_loc
| _ -> assert false (* ! *))
| _ -> [])
in
let deprecated = Type_utils.is_deprecated td.typ_attributes in
Some (mk ~children ~location ~deprecated `Type None td.typ_id)
Some (mk ~children ~location ~deprecated `Type None td.typ_name)
| Type_extension te ->
let name = Path.name te.tyext_path in
let children =
Expand All @@ -132,25 +134,25 @@ let rec summarize node =
outline_kind = `Type;
outline_type = None;
location;
selection = te.tyext_txt.loc;
children;
deprecated
}
| Extension_constructor ec ->
let deprecated = Type_utils.is_deprecated ec.ext_attributes in
Some (mk ~location `Exn None ec.ext_id ~deprecated)
Some (mk ~location `Exn None ec.ext_name ~deprecated)
| Class_declaration cd ->
let children =
List.concat_map (Lazy.force node.t_children) ~f:get_class_elements
in
let deprecated = Type_utils.is_deprecated cd.ci_attributes in
Some (mk ~children ~location `Class None cd.ci_id_class_type ~deprecated)
Some (mk ~children ~location `Class None cd.ci_id_name ~deprecated)
| Class_type_declaration ctd ->
let children =
List.concat_map (Lazy.force node.t_children) ~f:get_class_elements
in
let deprecated = Type_utils.is_deprecated ctd.ci_attributes in
Some
(mk ~children ~location `ClassType None ctd.ci_id_class_type ~deprecated)
Some (mk ~children ~location `ClassType None ctd.ci_id_name ~deprecated)
| _ -> None

and get_val_elements node =
Expand All @@ -175,6 +177,7 @@ and get_class_elements node =
outline_kind;
outline_type = None;
location = str_loc.Location.loc;
selection = str_loc.loc;
children;
deprecated
})
Expand All @@ -192,6 +195,7 @@ and get_class_elements node =
outline_kind;
outline_type = None;
location = field.ctf_loc;
selection = field.ctf_loc;
(* TODO: could we have more precised location information? *)
children = [];
deprecated
Expand Down
4 changes: 3 additions & 1 deletion src/commands/query_json.ml
Original file line number Diff line number Diff line change
Expand Up @@ -323,6 +323,7 @@ let rec json_of_outline outline =
outline_kind;
outline_type;
location;
selection;
children;
deprecated
} =
Expand All @@ -334,7 +335,8 @@ let rec json_of_outline outline =
| None -> `Null
| Some typ -> `String typ );
("children", `List (json_of_outline children));
("deprecated", `Bool deprecated)
("deprecated", `Bool deprecated);
("selection", with_location selection [])
]
in
List.map ~f:json_of_item outline
Expand Down
3 changes: 2 additions & 1 deletion src/frontend/query_protocol.ml
Original file line number Diff line number Diff line change
Expand Up @@ -92,7 +92,8 @@ and item =
| `Method ];
outline_type : string option;
deprecated : bool;
location : Location_aux.t;
location : Location.t;
selection : Location.t;
children : outline
}

Expand Down
48 changes: 44 additions & 4 deletions tests/test-dirs/outline-recovery.t
Original file line number Diff line number Diff line change
Expand Up @@ -36,7 +36,17 @@
"kind": "Module",
"type": null,
"children": [],
"deprecated": false
"deprecated": false,
"selection": {
"start": {
"line": 4,
"col": 9
},
"end": {
"line": 4,
"col": 10
}
}
},
{
"start": {
Expand All @@ -51,7 +61,17 @@
"kind": "Module",
"type": null,
"children": [],
"deprecated": false
"deprecated": false,
"selection": {
"start": {
"line": 3,
"col": 9
},
"end": {
"line": 3,
"col": 10
}
}
},
{
"start": {
Expand All @@ -66,10 +86,30 @@
"kind": "Module",
"type": null,
"children": [],
"deprecated": false
"deprecated": false,
"selection": {
"start": {
"line": 2,
"col": 9
},
"end": {
"line": 2,
"col": 10
}
}
}
],
"deprecated": false
"deprecated": false,
"selection": {
"start": {
"line": 1,
"col": 7
},
"end": {
"line": 1,
"col": 11
}
}
}
],
"notifications": []
Expand Down
Loading
Loading