Skip to content

Commit 88d77e0

Browse files
nberthnberth
committed
Refactor code for LSP folding-range requests
1 parent fe34a8f commit 88d77e0

File tree

2 files changed

+108
-102
lines changed

2 files changed

+108
-102
lines changed

‎src/lsp/cobol_lsp/lsp_folding.ml

Lines changed: 106 additions & 97 deletions
Original file line numberDiff line numberDiff line change
@@ -8,113 +8,126 @@
88
(* *)
99
(******************************************************************************)
1010

11-
open Cobol_common
11+
open Lsp.Types
12+
13+
open Cobol_common (* Visitor *)
1214
open Cobol_common.Srcloc.INFIX
1315

14-
type folding_range = {
15-
startLine:int;
16-
endLine:int;
17-
startCharacter:int; (*not really used *)
18-
endCharacter:int; (*not really used *)
19-
(* kind:Lsp.Types.FoldingRangeKind.t option *)
20-
(* collapsedText:string option*)
21-
}
22-
23-
let folding_range_of_loc loc =
24-
match Srcloc.as_lexloc loc with
25-
| (* None -> None *)
26-
(* | Some *) (p1, p2) ->
27-
Some {
28-
startLine = p1.pos_lnum - 1;
29-
startCharacter = p1.pos_cnum - p1.pos_bol;
30-
endLine = p2.pos_lnum - 1;
31-
endCharacter = p2.pos_cnum - p2.pos_bol
16+
type range = FoldingRange.t
17+
18+
let range_of_loc_in ~filename ?kind loc =
19+
try
20+
let p1, p2 = Srcloc.lexloc_in ~filename loc in
21+
Option.some @@ FoldingRange.create ()
22+
~startLine:(p1.pos_lnum - 1)
23+
~startCharacter:(p1.pos_cnum - p1.pos_bol)
24+
~endLine:(p2.pos_lnum - 1)
25+
~endCharacter:(p2.pos_cnum - p2.pos_bol)
26+
?kind
27+
with Invalid_argument _ ->
28+
(* Filename did not take part in the construction of loc. This may happen
29+
on dummy locations inserted during recovery. *)
30+
Option.none
31+
32+
let acc_range = function
33+
| None -> Fun.id
34+
| Some r -> List.cons r
35+
36+
let extend_range (range: range option as 's) (new_range: 's) =
37+
match range, new_range with
38+
| None, _ | _, None ->
39+
None
40+
| Some range, Some new_range ->
41+
Some { range with
42+
endLine = new_range.endLine;
43+
endCharacter = new_range.endCharacter }
44+
45+
let acc_ranges_in ~filename ptree acc =
46+
let open struct
47+
type acc =
48+
{
49+
section_range: range option;
50+
ranges: range list;
3251
}
52+
end in
3353

34-
let add_folding_range r l =
35-
match r with
36-
| None -> l
37-
| Some r -> r :: l
38-
39-
let add_folding_range_of_loc loc l =
40-
add_folding_range (folding_range_of_loc loc) l
41-
42-
(*Define the folding_range of program/division/statement...
43-
We do not need to do any analyze here.
44-
However, we need to refine the code of parser/visitor first.*)
45-
let folding_range_simple ast =
46-
let add_node n acc =
47-
Visitor.do_children @@ add_folding_range_of_loc ~@n acc
54+
let register_range ?kind { loc; _ } acc =
55+
let range = range_of_loc_in ~filename ?kind loc in
56+
{ acc with ranges = acc_range range acc.ranges }
4857
in
49-
let visitor = Cobol_parser.PTree_visitor.fold_compilation_group (object
50-
inherit [folding_range list] Cobol_parser.PTree_visitor.folder
5158

52-
method! fold_program_unit' = add_node
53-
method! fold_data_division' = add_node
54-
method! fold_procedure_division' = add_node
55-
method! fold_statement' = add_node
56-
57-
(*TODO:
58-
- add location for some nodes in the ast
59-
so that we can define folding_range for
60-
environment division, file section... (predefined section)
59+
let with_subranges ?kind n acc =
60+
Visitor.do_children @@ register_range ?kind n acc
61+
and leaf_range ?kind n acc =
62+
Visitor.skip_children @@ register_range ?kind n acc
63+
in
6164

62-
- it is possible to add folding_range for
65+
let wide_region n = with_subranges ~kind:FoldingRangeKind.Region n
66+
and leaf_region n = leaf_range ~kind:FoldingRangeKind.Region n in
67+
68+
let { section_range; ranges } =
69+
Cobol_parser.PTree_visitor.fold_compilation_group (object
70+
inherit [acc] Cobol_parser.PTree_visitor.folder
71+
72+
method! fold_compilation_unit' = wide_region
73+
method! fold_options_paragraph' = leaf_region
74+
75+
method! fold_data_division' = wide_region
76+
method! fold_file_section' = wide_region
77+
method! fold_working_storage_section' = wide_region
78+
method! fold_linkage_section' = wide_region
79+
method! fold_communication_section' = wide_region
80+
method! fold_local_storage_section' = wide_region
81+
method! fold_report_section' = wide_region
82+
method! fold_screen_section' = wide_region
83+
84+
method! fold_environment_division' = wide_region
85+
method! fold_configuration_section' = wide_region
86+
(* method! fold_source_computer_paragraph' = region *)
87+
(* method! fold_object_computer_paragraph' = region *)
88+
(* method! fold_special_names_paragraph' = region *)
89+
method! fold_repository_paragraph' = leaf_region
90+
method! fold_input_output_section' = leaf_region
91+
method! fold_file_control_paragraph' = leaf_region
92+
method! fold_io_control_paragraph' = leaf_region
93+
94+
method! fold_procedure_division' = wide_region
95+
method! fold_statement' = wide_region
96+
97+
(*TODO:
98+
- add location for some nodes in the ast
99+
so that we can define folding_range for
100+
environment division, file section... (predefined section)
101+
102+
- it is possible to add folding_range for
63103
- branch of statement(else_branch, evaluate_branch...)
64104
- handler(on_size_error)
65105
- inline_call
66106
67-
- add folding_range for other type of compilation_unit (not program) *)
68-
69-
end) in
70-
visitor ast []
107+
- add folding_range for other type of compilation_unit (not program) *)
71108

109+
method! fold_paragraph' {payload = { paragraph_is_section; _ }; loc} acc =
110+
let range = range_of_loc_in ~filename loc in
111+
Visitor.skip_children @@
112+
if paragraph_is_section
113+
then { section_range = range;
114+
ranges = acc_range acc.section_range acc.ranges }
115+
else { section_range = extend_range acc.section_range range;
116+
ranges = acc_range range acc.ranges }
72117

73-
let folding_range_paragraph ast =
74-
let update_section_range loc (section_range, l) =
75-
match folding_range_of_loc loc with
76-
| None -> section_range, l
77-
| Some ({endLine; endCharacter; _} as r) ->
78-
Option.map (
79-
fun folding_range->
80-
{folding_range with endLine; endCharacter}
81-
) section_range, r :: l
118+
end) ptree { section_range = None; ranges = acc }
82119
in
83120

84-
let add_section (r, l) = add_folding_range r l in
85-
86-
let visitor = Cobol_parser.PTree_visitor.fold_compilation_group (object
87-
inherit [folding_range option *
88-
folding_range list] Cobol_parser.PTree_visitor.folder
89-
90-
method! fold_paragraph' {payload = {paragraph_is_section; _}; loc} acc =
91-
Visitor.skip_children @@
92-
if not paragraph_is_section then
93-
update_section_range loc acc
94-
else
95-
folding_range_of_loc loc,
96-
add_section acc
97-
98-
end) in
99-
add_section @@ visitor ast (None, [])
121+
acc_range section_range ranges
100122

101123

102124
(*TODO:
103125
Now we use the type Group.t (need to be rewritten),
104126
which does not work for renames-item, condition-item ... *)
105-
let folding_range_data ({ cu_wss; _ }:Cobol_data.Types.compilation_unit) =
106-
let update r group_range =
107-
match r with
108-
| None -> group_range
109-
| Some {endLine; endCharacter; _} ->
110-
Option.map (
111-
fun folding_range ->
112-
{folding_range with endLine; endCharacter}
113-
) group_range
114-
in
127+
let folding_range_data_in ~filename ({ cu_wss; _ }: Cobol_data.Types.compilation_unit) =
115128
(*add the folding_range of grouped item *)
116129
let rec add group l =
117-
let r = folding_range_of_loc ~@group in
130+
let r = range_of_loc_in ~filename ~@group in
118131
match ~&group with
119132
| Cobol_data.Group.Elementary _
120133
| Constant _ | Renames _ | ConditionName _ -> None, l
@@ -132,22 +145,18 @@ let folding_range_data ({ cu_wss; _ }:Cobol_data.Types.compilation_unit) =
132145
match ~&group with
133146
| Cobol_data.Group.Elementary _
134147
| Constant _ | Renames _ | ConditionName _ ->
135-
update (folding_range_of_loc ~@group) r, l
148+
extend_range r (range_of_loc_in ~filename ~@group), l
136149
| Group _ ->
137150
let r', l = add group l in
138-
update r' r, l
151+
extend_range r r', l
139152
in
140153
List.fold_left
141154
(fun acc group -> snd @@ add group acc) [] cu_wss
142155

143156

144-
let folding_range ptree cus =
145-
let folding_range_cus =
146-
Cobol_data.Compilation_unit.SET.to_seq cus
147-
|> Seq.map (fun cu -> folding_range_data cu)
148-
|> List.of_seq
149-
|> List.flatten
150-
in
151-
folding_range_paragraph ptree @
152-
folding_range_simple ptree @
153-
folding_range_cus
157+
let ranges_in ~filename ptree cus =
158+
Cobol_data.Compilation_unit.SET.to_seq cus
159+
|> Seq.map (fun cu -> folding_range_data_in ~filename cu)
160+
|> List.of_seq
161+
|> List.flatten
162+
|> acc_ranges_in ~filename ptree

‎src/lsp/cobol_lsp/lsp_request.ml

Lines changed: 2 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -284,11 +284,8 @@ let handle_completion registry (params: CompletionParams.t) =
284284
let handle_folding_range registry (params: FoldingRangeParams.t) =
285285
try_with_document_data registry params.textDocument
286286
~f:begin fun ~doc:_ { ast; cus; _ } ->
287-
Some (List.map
288-
(fun Lsp_folding.{startLine; endLine; _} ->
289-
FoldingRange.create ~startLine ~endLine ())
290-
(Lsp_folding.folding_range ast cus)
291-
)
287+
let filename = Lsp.Uri.to_path params.textDocument.uri in
288+
Some (Lsp_folding.ranges_in ~filename ast cus)
292289
end
293290

294291
let handle_shutdown registry =

0 commit comments

Comments
 (0)