diff --git a/src/lsp/cobol_lsp/lsp_capabilities.ml b/src/lsp/cobol_lsp/lsp_capabilities.ml index 3c99a190..3d357639 100644 --- a/src/lsp/cobol_lsp/lsp_capabilities.ml +++ b/src/lsp/cobol_lsp/lsp_capabilities.ml @@ -59,3 +59,4 @@ let reply (_: ClientCapabilities.t) = ~completionProvider:completion_option ~workspace ~documentSymbolProvider:(`Bool true) + ~renameProvider:(`Bool true) diff --git a/src/lsp/cobol_lsp/lsp_imports.ml b/src/lsp/cobol_lsp/lsp_imports.ml index 591b4fe2..1eea715c 100644 --- a/src/lsp/cobol_lsp/lsp_imports.ml +++ b/src/lsp/cobol_lsp/lsp_imports.ml @@ -15,4 +15,10 @@ module CUs = Cobol_unit.Collections.SET module CUMap = Cobol_unit.Collections.MAP -module URIMap = Map.Make (Lsp.Uri) +module URIMap = struct + include Map.Make (Lsp.Uri) + + let add_to_list x data m = + let add = function None -> Some [data] | Some l -> Some (data :: l) in + update x add m +end diff --git a/src/lsp/cobol_lsp/lsp_request.ml b/src/lsp/cobol_lsp/lsp_request.ml index f23092e7..17641b57 100644 --- a/src/lsp/cobol_lsp/lsp_request.ml +++ b/src/lsp/cobol_lsp/lsp_request.ml @@ -580,12 +580,41 @@ let handle_folding_range registry (params: FoldingRangeParams.t) = let handle_document_symbol registry (params: DocumentSymbolParams.t) = try_with_main_document_data registry params.textDocument - ~f:begin fun ~doc { ptree; _ }-> + ~f:begin fun ~doc { ptree; _ } -> let uri = Lsp.Text_document.documentUri doc.textdoc in let symbols = Lsp_document_symbol.from_ptree_at ~uri ptree in Some (`DocumentSymbol symbols) end +(** { Rename } *) + +exception CopybookRenameError + +let handle_rename registry (params: RenameParams.t) = + let { textDocument; position; newName = newText; _ }: RenameParams.t = params in + let doc = Lsp_server.find_document params.textDocument registry in + let checked_doc = Lsp_document.checked doc in + let rootdir = Lsp_project.(string_of_rootdir @@ rootdir doc.project) in + let locations = Option.value ~default:[] @@ + let context = ReferenceContext.create ~includeDeclaration:true in + let params = ReferenceParams.create + ~context ~position ~textDocument () in + lookup_references_in_doc ~rootdir params checked_doc in + try + let changes = List.fold_left begin fun acc ({ range; uri }: Location.t) -> + if DocumentUri.compare uri params.textDocument.uri <> 0 + then raise CopybookRenameError + else + let textEdit = TextEdit.create ~newText ~range in + URIMap.add_to_list uri textEdit acc + end URIMap.empty locations + |> URIMap.to_seq + |> List.of_seq + in + Ok(WorkspaceEdit.create ~changes ()) + with CopybookRenameError -> + Error "Reference of variable found in copybook, aborting rename" + (** {3 Generic handling} *) let shutdown: state -> unit = function @@ -631,8 +660,13 @@ let on_request Ok (handle_folding_range registry params, state) | Shutdown -> Ok (handle_shutdown registry, ShuttingDown) - | DocumentSymbol (* DocumentSymbolParams.t.t *) params -> + | DocumentSymbol params -> Ok (handle_document_symbol registry params, state) + | TextDocumentRename params -> + begin match handle_rename registry params with + | Ok workspaceEdit -> Ok (workspaceEdit, state) + | Error _ -> Error (CopybookRenamingForbidden) + end | TextDocumentDeclaration (* TextDocumentPositionParams.t.t *) _ | TextDocumentTypeDefinition (* TypeDefinitionParams.t.t *) _ | TextDocumentImplementation (* ImplementationParams.t.t *) _ @@ -640,7 +674,6 @@ let on_request | TextDocumentCodeLensResolve (* CodeLens.t.t *) _ | TextDocumentPrepareCallHierarchy (* CallHierarchyPrepareParams.t.t *) _ | TextDocumentPrepareRename (* PrepareRenameParams.t.t *) _ - | TextDocumentRename (* RenameParams.t.t *) _ | TextDocumentLink (* DocumentLinkParams.t.t *) _ | TextDocumentLinkResolve (* DocumentLink.t.t *) _ | TextDocumentMoniker (* MonikerParams.t.t *) _ @@ -707,4 +740,5 @@ module INTERNAL = struct let completion = handle_completion let document_symbol = handle_document_symbol let formatting = handle_formatting + let rename = handle_rename end diff --git a/src/lsp/cobol_lsp/lsp_request.mli b/src/lsp/cobol_lsp/lsp_request.mli index e73b59bc..bf9f84ec 100644 --- a/src/lsp/cobol_lsp/lsp_request.mli +++ b/src/lsp/cobol_lsp/lsp_request.mli @@ -41,4 +41,8 @@ module INTERNAL: sig : Lsp_server.t -> Lsp.Types.DocumentSymbolParams.t -> [> `DocumentSymbol of Lsp.Types.DocumentSymbol.t list ] option + val rename + : Lsp_server.t + -> Lsp.Types.RenameParams.t + -> (Lsp.Types.WorkspaceEdit.t, string) result end diff --git a/src/lsp/cobol_lsp/lsp_server.ml b/src/lsp/cobol_lsp/lsp_server.ml index c502397e..19bcc9af 100644 --- a/src/lsp/cobol_lsp/lsp_server.ml +++ b/src/lsp/cobol_lsp/lsp_server.ml @@ -82,6 +82,7 @@ module TYPES = struct and exit_status = (unit, string) result type 'a error = + | CopybookRenamingForbidden | InvalidStatus of state | UnhandledRequest of 'a Lsp.Client_request.t | UnknownRequest of string @@ -735,5 +736,7 @@ let jsonrpc_of_error error method_ = RequestFailed, Fmt.str "Unhandled request: %s" method_ | UnknownRequest method_ -> MethodNotFound, Fmt.str "Unknown request method: %s" method_ + | CopybookRenamingForbidden -> + RequestFailed, Fmt.str "Cancelled rename of variable contained in a copybook" in Jsonrpc.Response.Error.make ~code ~message () diff --git a/src/lsp/cobol_lsp/lsp_server.mli b/src/lsp/cobol_lsp/lsp_server.mli index 2251c8c3..1a827817 100644 --- a/src/lsp/cobol_lsp/lsp_server.mli +++ b/src/lsp/cobol_lsp/lsp_server.mli @@ -53,6 +53,7 @@ module TYPES: sig and exit_status = (unit, string) result type 'a error = + | CopybookRenamingForbidden | InvalidStatus of state | UnhandledRequest of 'a Lsp.Client_request.t | UnknownRequest of string diff --git a/test/lsp/lsp_rename.ml b/test/lsp/lsp_rename.ml new file mode 100644 index 00000000..f4da8d26 --- /dev/null +++ b/test/lsp/lsp_rename.ml @@ -0,0 +1,187 @@ +(**************************************************************************) +(* *) +(* SuperBOL OSS Studio *) +(* *) +(* Copyright (c) 2022-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This source code is licensed under the GNU Affero General Public *) +(* License version 3 found in the LICENSE.md file in the root directory *) +(* of this source tree. *) +(* *) +(**************************************************************************) + +open EzCompat (* StringMap *) +open Lsp.Types +open Lsp_testing + +let pp_assoc_elem ppf ((uri, edits): DocumentUri.t * TextEdit.t list) = + let pp_range ppf range = + let location_as_srcloc = new srcloc_resuscitator_cache in + location_as_srcloc#pp ppf @@ Location.create ~range ~uri + in + let pp_edit ppf (edit: TextEdit.t) = + Fmt.pf ppf "%s at " edit.newText; + pp_range ppf edit.range + in + Fmt.(list pp_edit) ppf edits + +let count l = + List.fold_left begin fun acc (_, t) -> acc + List.length t end 0 l + +let rename_positions ?(copybooks=[]) (doc, positions) : string -> unit = + let { end_with_postproc; projdir }, server = make_lsp_project () in + let server = List.fold_left begin fun server (name, document) -> + add_cobol_doc server ~projdir name document + |> fst + end server copybooks in + let server, prog = add_cobol_doc server ~projdir "prog.cob" doc in + let rename_at_position ?key (position: Position.t) = + let params = RenameParams.create ~newName:"aNewName" ~position ~textDocument:prog () in + Pretty.out "%a(line %d, character %d):\n" + Fmt.(option ~none:nop (string ++ sp)) key + position.line position.character; + begin + try + match LSP.Request.rename server params with + | Error e -> + Pretty.out "Renamed failed: %S@." e + | Ok { changes = None; _ } -> + Pretty.out "No renames@." + | Ok { changes = Some assoc; _ } -> + Pretty.out "@.@[%d rename entries:@;%a@]@\n" + (count assoc) + (Fmt.list ~sep:Fmt.sp pp_assoc_elem) assoc + with _ -> Pretty.out "Failed rename@." + end + in + StringMap.iter (fun n p -> rename_at_position ~key:n p) positions.pos_map; + List.iter (fun p -> rename_at_position p) positions.pos_anonymous; + end_with_postproc + +let%expect_test "rename" = + let end_with_postproc = rename_positions @@ extract_position_markers {cobol| + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 o_|_ld-name PIC 9. + PROCEDURE DIVISION. + MOVE 1 TO old-na_|_me. + S_|_TOP RUN. + |cobol} + in + end_with_postproc [%expect.output]; + [%expect {| + {"params":{"diagnostics":[],"uri":"file://__rootdir__/prog.cob"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"} + (line 5, character 12): + 2 rename entries: + aNewName at __rootdir__/prog.cob:8.20-8.28: + 5 WORKING-STORAGE SECTION. + 6 01 old-name PIC 9. + 7 PROCEDURE DIVISION. + 8 > MOVE 1 TO old-name. + ---- ^^^^^^^^ + 9 STOP RUN. + 10 + aNewName at __rootdir__/prog.cob:6.11-6.19: + 3 PROGRAM-ID. prog. + 4 DATA DIVISION. + 5 WORKING-STORAGE SECTION. + 6 > 01 old-name PIC 9. + ---- ^^^^^^^^ + 7 PROCEDURE DIVISION. + 8 MOVE 1 TO old-name. + (line 7, character 26): + 2 rename entries: + aNewName at __rootdir__/prog.cob:8.20-8.28: + 5 WORKING-STORAGE SECTION. + 6 01 old-name PIC 9. + 7 PROCEDURE DIVISION. + 8 > MOVE 1 TO old-name. + ---- ^^^^^^^^ + 9 STOP RUN. + 10 + aNewName at __rootdir__/prog.cob:6.11-6.19: + 3 PROGRAM-ID. prog. + 4 DATA DIVISION. + 5 WORKING-STORAGE SECTION. + 6 > 01 old-name PIC 9. + ---- ^^^^^^^^ + 7 PROCEDURE DIVISION. + 8 MOVE 1 TO old-name. + (line 8, character 11): + 0 rename entries: |}] + +let%expect_test "rename-copybook" = + let copybooks = [ + ("lib.cpy", {cobol| + 01 copied-var pic 9.|cobol}) + ] in + let end_with_postproc = rename_positions ~copybooks @@ extract_position_markers {cobol| + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + COPY "lib.cpy". + PROCEDURE DIVISION. + MOVE 1 TO c_|_opied-var. + STOP RUN. + |cobol} + in + end_with_postproc [%expect.output]; + [%expect {| + {"params":{"diagnostics":[],"uri":"file://__rootdir__/lib.cpy"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"} + {"params":{"diagnostics":[],"uri":"file://__rootdir__/prog.cob"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"} + (line 7, character 21): + Renamed failed: "Reference of variable found in copybook, aborting rename" |}] + +let%expect_test "rename-procedure" = + let end_with_postproc = rename_positions @@ extract_position_markers {cobol| + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + PROCEDURE DIVISION. + s_|newSectionName|_ec SECTION. + PERFORM sec. + STOP RUN. + |cobol} + in + end_with_postproc [%expect.output]; + [%expect {| + {"params":{"diagnostics":[],"uri":"file://__rootdir__/prog.cob"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"} + newSectionName + (line 4, character 11): + 4 rename entries: + aNewName at __rootdir__/prog.cob:6.18-6.21: + 3 PROGRAM-ID. prog. + 4 PROCEDURE DIVISION. + 5 sec SECTION. + 6 > PERFORM sec. + ---- ^^^ + 7 STOP RUN. + 8 + aNewName at __rootdir__/prog.cob:5.10-5.13: + 2 IDENTIFICATION DIVISION. + 3 PROGRAM-ID. prog. + 4 PROCEDURE DIVISION. + 5 > sec SECTION. + ---- ^^^ + 6 PERFORM sec. + 7 STOP RUN. + aNewName at __rootdir__/prog.cob:5.10-5.13: + 2 IDENTIFICATION DIVISION. + 3 PROGRAM-ID. prog. + 4 PROCEDURE DIVISION. + 5 > sec SECTION. + ---- ^^^ + 6 PERFORM sec. + 7 STOP RUN. + aNewName at __rootdir__/prog.cob:5.10-5.13: + 2 IDENTIFICATION DIVISION. + 3 PROGRAM-ID. prog. + 4 PROCEDURE DIVISION. + 5 > sec SECTION. + ---- ^^^ + 6 PERFORM sec. + 7 STOP RUN. |}] +