Skip to content

Commit

Permalink
Refactor code for LSP folding-range requests
Browse files Browse the repository at this point in the history
  • Loading branch information
@nberth
nberth committed Sep 26, 2023
1 parent dc60805 commit d502765
Show file tree
Hide file tree
Showing 2 changed files with 108 additions and 102 deletions.
203 changes: 106 additions & 97 deletions src/lsp/cobol_lsp/lsp_folding.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -8,113 +8,126 @@
(* *)
(******************************************************************************)

open Cobol_common
open Lsp.Types

open Cobol_common (* Visitor *)
open Cobol_common.Srcloc.INFIX

type folding_range = {
startLine:int;
endLine:int;
startCharacter:int; (*not really used *)
endCharacter:int; (*not really used *)
(* kind:Lsp.Types.FoldingRangeKind.t option *)
(* collapsedText:string option*)
}

let folding_range_of_loc loc =
match Srcloc.as_lexloc loc with
| (* None -> None *)
(* | Some *) (p1, p2) ->
Some {
startLine = p1.pos_lnum - 1;
startCharacter = p1.pos_cnum - p1.pos_bol;
endLine = p2.pos_lnum - 1;
endCharacter = p2.pos_cnum - p2.pos_bol
type range = FoldingRange.t

let range_of_loc_in ~filename ?kind loc =
try
let p1, p2 = Srcloc.lexloc_in ~filename loc in
Option.some @@ FoldingRange.create ()
~startLine:(p1.pos_lnum - 1)
~startCharacter:(p1.pos_cnum - p1.pos_bol)
~endLine:(p2.pos_lnum - 1)
~endCharacter:(p2.pos_cnum - p2.pos_bol)
?kind
with Invalid_argument _ ->
(* Filename did not take part in the construction of loc. This may happen
on dummy locations inserted during recovery. *)
Option.none

let acc_range = function
| None -> Fun.id
| Some r -> List.cons r

let extend_range (range: range option as 's) (new_range: 's) =
match range, new_range with
| None, _ | _, None ->
None
| Some range, Some new_range ->
Some { range with
endLine = new_range.endLine;
endCharacter = new_range.endCharacter }

let acc_ranges_in ~filename ptree acc =
let open struct
type acc =
{
section_range: range option;
ranges: range list;
}
end in

let add_folding_range r l =
match r with
| None -> l
| Some r -> r :: l

let add_folding_range_of_loc loc l =
add_folding_range (folding_range_of_loc loc) l

(*Define the folding_range of program/division/statement...
We do not need to do any analyze here.
However, we need to refine the code of parser/visitor first.*)
let folding_range_simple ast =
let add_node n acc =
Visitor.do_children @@ add_folding_range_of_loc ~@n acc
let register_range ?kind { loc; _ } acc =
let range = range_of_loc_in ~filename ?kind loc in
{ acc with ranges = acc_range range acc.ranges }
in
let visitor = Cobol_parser.PTree_visitor.fold_compilation_group (object
inherit [folding_range list] Cobol_parser.PTree_visitor.folder

method! fold_program_unit' = add_node
method! fold_data_division' = add_node
method! fold_procedure_division' = add_node
method! fold_statement' = add_node

(*TODO:
- add location for some nodes in the ast
so that we can define folding_range for
environment division, file section... (predefined section)
let with_subranges ?kind n acc =
Visitor.do_children @@ register_range ?kind n acc
and leaf_range ?kind n acc =
Visitor.skip_children @@ register_range ?kind n acc
in

- it is possible to add folding_range for
let wide_region n = with_subranges ~kind:FoldingRangeKind.Region n
and leaf_region n = leaf_range ~kind:FoldingRangeKind.Region n in

let { section_range; ranges } =
Cobol_parser.PTree_visitor.fold_compilation_group (object
inherit [acc] Cobol_parser.PTree_visitor.folder

method! fold_compilation_unit' = wide_region
method! fold_options_paragraph' = leaf_region

method! fold_data_division' = wide_region
method! fold_file_section' = wide_region
method! fold_working_storage_section' = wide_region
method! fold_linkage_section' = wide_region
method! fold_communication_section' = wide_region
method! fold_local_storage_section' = wide_region
method! fold_report_section' = wide_region
method! fold_screen_section' = wide_region

method! fold_environment_division' = wide_region
method! fold_configuration_section' = wide_region
(* method! fold_source_computer_paragraph' = region *)
(* method! fold_object_computer_paragraph' = region *)
(* method! fold_special_names_paragraph' = region *)
method! fold_repository_paragraph' = leaf_region
method! fold_input_output_section' = leaf_region
method! fold_file_control_paragraph' = leaf_region
method! fold_io_control_paragraph' = leaf_region

method! fold_procedure_division' = wide_region
method! fold_statement' = wide_region

(*TODO:
- add location for some nodes in the ast
so that we can define folding_range for
environment division, file section... (predefined section)
- it is possible to add folding_range for
- branch of statement(else_branch, evaluate_branch...)
- handler(on_size_error)
- inline_call
- add folding_range for other type of compilation_unit (not program) *)

end) in
visitor ast []
- add folding_range for other type of compilation_unit (not program) *)

method! fold_paragraph' {payload = { paragraph_is_section; _ }; loc} acc =
let range = range_of_loc_in ~filename loc in
Visitor.skip_children @@
if paragraph_is_section
then { section_range = range;
ranges = acc_range acc.section_range acc.ranges }
else { section_range = extend_range acc.section_range range;
ranges = acc_range range acc.ranges }

let folding_range_paragraph ast =
let update_section_range loc (section_range, l) =
match folding_range_of_loc loc with
| None -> section_range, l
| Some ({endLine; endCharacter; _} as r) ->
Option.map (
fun folding_range->
{folding_range with endLine; endCharacter}
) section_range, r :: l
end) ptree { section_range = None; ranges = acc }
in

let add_section (r, l) = add_folding_range r l in

let visitor = Cobol_parser.PTree_visitor.fold_compilation_group (object
inherit [folding_range option *
folding_range list] Cobol_parser.PTree_visitor.folder

method! fold_paragraph' {payload = {paragraph_is_section; _}; loc} acc =
Visitor.skip_children @@
if not paragraph_is_section then
update_section_range loc acc
else
folding_range_of_loc loc,
add_section acc

end) in
add_section @@ visitor ast (None, [])
acc_range section_range ranges


(*TODO:
Now we use the type Group.t (need to be rewritten),
which does not work for renames-item, condition-item ... *)
let folding_range_data ({ cu_wss; _ }:Cobol_data.Types.compilation_unit) =
let update r group_range =
match r with
| None -> group_range
| Some {endLine; endCharacter; _} ->
Option.map (
fun folding_range ->
{folding_range with endLine; endCharacter}
) group_range
in
let folding_range_data_in ~filename ({ cu_wss; _ }: Cobol_data.Types.compilation_unit) =
(*add the folding_range of grouped item *)
let rec add group l =
let r = folding_range_of_loc ~@group in
let r = range_of_loc_in ~filename ~@group in
match ~&group with
| Cobol_data.Group.Elementary _
| Constant _ | Renames _ | ConditionName _ -> None, l
Expand All @@ -132,22 +145,18 @@ let folding_range_data ({ cu_wss; _ }:Cobol_data.Types.compilation_unit) =
match ~&group with
| Cobol_data.Group.Elementary _
| Constant _ | Renames _ | ConditionName _ ->
update (folding_range_of_loc ~@group) r, l
extend_range r (range_of_loc_in ~filename ~@group), l
| Group _ ->
let r', l = add group l in
update r' r, l
extend_range r r', l
in
List.fold_left
(fun acc group -> snd @@ add group acc) [] cu_wss


let folding_range ptree cus =
let folding_range_cus =
Cobol_data.Compilation_unit.SET.to_seq cus
|> Seq.map (fun cu -> folding_range_data cu)
|> List.of_seq
|> List.flatten
in
folding_range_paragraph ptree @
folding_range_simple ptree @
folding_range_cus
let ranges_in ~filename ptree cus =
Cobol_data.Compilation_unit.SET.to_seq cus
|> Seq.map (fun cu -> folding_range_data_in ~filename cu)
|> List.of_seq
|> List.flatten
|> acc_ranges_in ~filename ptree
7 changes: 2 additions & 5 deletions src/lsp/cobol_lsp/lsp_request.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -284,11 +284,8 @@ let handle_completion registry (params: CompletionParams.t) =
let handle_folding_range registry (params: FoldingRangeParams.t) =
try_with_document_data registry params.textDocument
~f:begin fun ~doc:_ { ast; cus; _ } ->
Some (List.map
(fun Lsp_folding.{startLine; endLine; _} ->
FoldingRange.create ~startLine ~endLine ())
(Lsp_folding.folding_range ast cus)
)
let filename = Lsp.Uri.to_path params.textDocument.uri in
Some (Lsp_folding.ranges_in ~filename ast cus)
end

let handle_shutdown registry =
Expand Down

0 comments on commit d502765

Please sign in to comment.