diff --git a/CHANGES.md b/CHANGES.md index c83f8573f..ba4426ac1 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,3 +1,9 @@ +# Unreleased + +## Features + +- Add custom [`ocamllsp/refactorExtract`](https://github.com/ocaml/ocaml-lsp/blob/ocaml-lsp-server/docs/ocamllsp/refactorExtract-spec.md) request (#1545) + # 1.23.0 ## Features diff --git a/ocaml-lsp-server/docs/ocamllsp/refactorExtract.md b/ocaml-lsp-server/docs/ocamllsp/refactorExtract.md new file mode 100644 index 000000000..ef095eb5d --- /dev/null +++ b/ocaml-lsp-server/docs/ocamllsp/refactorExtract.md @@ -0,0 +1,42 @@ +# Refactor Extract Request + +## Description + +Provides commands to extract an arbitrary region into a fresh let binding. + +## Client Capability + +There is no client capability relative to this request. + +## Server capability + +- property name: `refactorExtract` +- property type: `boolean` + +## Request + +- method: `ocamllsp/refactorExtract` +- params: + + ```json + { + "uri": textDocument, + "start": Position, + "stop": Position, + "extract_name?": string, + } + ``` + +`start` and `stop` represents the region to be extracted. The `extract_name` parameter allows choosing the name of the generated let binding. If `extract_name` is not specified, a name not taken in the scope is chosen. + +## Response + +```json +{ + "position": Range, + "content": string, + "selection_range": Range +} +``` + +The result contains the range (`position`) to be replaced (describing the selected region), the output intended to be substituted (`content`) and the range of the identifier of the generated binding (`selection_range`) which allows renaming it easily. diff --git a/ocaml-lsp-server/src/custom_requests/custom_request.ml b/ocaml-lsp-server/src/custom_requests/custom_request.ml index 0152afe10..5b15c61da 100644 --- a/ocaml-lsp-server/src/custom_requests/custom_request.ml +++ b/ocaml-lsp-server/src/custom_requests/custom_request.ml @@ -10,3 +10,4 @@ module Wrapping_ast_node = Req_wrapping_ast_node module Get_documentation = Req_get_documentation module Type_search = Req_type_search module Merlin_jump = Req_merlin_jump +module Refactor_extract = Req_refactor_extract diff --git a/ocaml-lsp-server/src/custom_requests/custom_request.mli b/ocaml-lsp-server/src/custom_requests/custom_request.mli index 13027eb59..58d4b1784 100644 --- a/ocaml-lsp-server/src/custom_requests/custom_request.mli +++ b/ocaml-lsp-server/src/custom_requests/custom_request.mli @@ -12,3 +12,4 @@ module Wrapping_ast_node = Req_wrapping_ast_node module Get_documentation = Req_get_documentation module Type_search = Req_type_search module Merlin_jump = Req_merlin_jump +module Refactor_extract = Req_refactor_extract diff --git a/ocaml-lsp-server/src/custom_requests/req_refactor_extract.ml b/ocaml-lsp-server/src/custom_requests/req_refactor_extract.ml new file mode 100644 index 000000000..2dc989078 --- /dev/null +++ b/ocaml-lsp-server/src/custom_requests/req_refactor_extract.ml @@ -0,0 +1,91 @@ +open Import + +let capability = "handleRefactorExtract", `Bool true +let meth = "ocamllsp/refactorExtract" + +module Request_params = struct + type t = + { text_document : TextDocumentIdentifier.t + ; start : Position.t + ; stop : Position.t + ; extract_name : string option + } + + let create ?extract_name ~text_document ~start ~stop () = + { text_document; start; stop; extract_name } + ;; + + let yojson_of_t { text_document; start; stop; extract_name } = + match TextDocumentIdentifier.yojson_of_t text_document with + | `Assoc assoc -> + let start = "start", Position.yojson_of_t start in + let stop = "stop", Position.yojson_of_t stop in + let extract_name = + "extract_name", Option.fold extract_name ~init:`Null ~f:(fun _ s -> `String s) + in + `Assoc (start :: stop :: extract_name :: assoc) + | _ -> (* unreachable *) assert false + ;; + + let t_of_yojson json = + let open Yojson.Safe.Util in + let text_document = json |> TextDocumentIdentifier.t_of_yojson in + let start = json |> member "start" |> Position.t_of_yojson in + let stop = json |> member "stop" |> Position.t_of_yojson in + let extract_name = json |> member "extract_name" |> to_string_option in + create ?extract_name ~text_document ~start ~stop () + ;; +end + +type t = + { position : Range.t + ; content : string + ; selection_range : Range.t + } + +let yojson_of_t { position; content; selection_range } = + `Assoc + [ "position", Range.yojson_of_t position + ; "content", `String content + ; "selection_range", Range.yojson_of_t selection_range + ] +;; + +let with_pipeline state uri f = + let doc = Document_store.get state.State.store uri in + match Document.kind doc with + | `Other -> Fiber.return `Null + | `Merlin merlin -> + (match Document.Merlin.kind merlin with + | Document.Kind.Intf -> + (* Extraction makes no sense if its called from an interface. *) + Fiber.return `Null + | Document.Kind.Impl -> Document.Merlin.with_pipeline_exn merlin f) +;; + +let dispatch ~start ~stop ~extract_name pipeline = + let start = Position.logical start in + let end_ = Position.logical stop in + let buffer = Mpipeline.raw_source pipeline in + let command = + Query_protocol.Refactor_extract_region (start, end_, extract_name, buffer) + in + let { Query_protocol.loc; content; selection_range } = + Query_commands.dispatch pipeline command + in + yojson_of_t + { position = Range.of_loc loc + ; content + ; selection_range = Range.of_loc selection_range + } +;; + +let on_request ~params state = + Fiber.of_thunk (fun () -> + let params = (Option.value ~default:(`Assoc []) params :> Yojson.Safe.t) in + let Request_params.{ text_document; start; stop; extract_name } = + Request_params.t_of_yojson params + in + let uri = text_document.uri in + with_pipeline state uri @@ dispatch ~start ~stop ~extract_name) +;; diff --git a/ocaml-lsp-server/src/custom_requests/req_refactor_extract.mli b/ocaml-lsp-server/src/custom_requests/req_refactor_extract.mli new file mode 100644 index 000000000..f17172fcf --- /dev/null +++ b/ocaml-lsp-server/src/custom_requests/req_refactor_extract.mli @@ -0,0 +1,21 @@ +open Import + +module Request_params : sig + type t + + val create + : ?extract_name:string + -> text_document:Lsp.Types.TextDocumentIdentifier.t + -> start:Position.t + -> stop:Position.t + -> unit + -> t + + val yojson_of_t : t -> Json.t +end + +type t + +val capability : string * Json.t +val meth : string +val on_request : params:Jsonrpc.Structured.t option -> State.t -> Json.t Fiber.t diff --git a/ocaml-lsp-server/src/ocaml_lsp_server.ml b/ocaml-lsp-server/src/ocaml_lsp_server.ml index ec7f8e119..4043dd58c 100644 --- a/ocaml-lsp-server/src/ocaml_lsp_server.ml +++ b/ocaml-lsp-server/src/ocaml_lsp_server.ml @@ -98,6 +98,7 @@ let initialize_info (client_capabilities : ClientCapabilities.t) : InitializeRes ; Req_get_documentation.capability ; Req_construct.capability ; Req_type_search.capability + ; Req_refactor_extract.capability ; Req_merlin_jump.capability ] ) ] @@ -541,6 +542,7 @@ let on_request ; Req_wrapping_ast_node.meth, Req_wrapping_ast_node.on_request ; Req_type_search.meth, Req_type_search.on_request ; Req_construct.meth, Req_construct.on_request + ; Req_refactor_extract.meth, Req_refactor_extract.on_request ; ( Semantic_highlighting.Debug.meth_request_full , Semantic_highlighting.Debug.on_request_full ) ; ( Req_hover_extended.meth diff --git a/ocaml-lsp-server/test/e2e-new/dune b/ocaml-lsp-server/test/e2e-new/dune index 2dfa3f4fc..6ed2eba5f 100644 --- a/ocaml-lsp-server/test/e2e-new/dune +++ b/ocaml-lsp-server/test/e2e-new/dune @@ -57,6 +57,7 @@ merlin_call_compatible diagnostics_filter metrics + refactor_extract semantic_hl_data semantic_hl_helpers semantic_hl_tests diff --git a/ocaml-lsp-server/test/e2e-new/refactor_extract.ml b/ocaml-lsp-server/test/e2e-new/refactor_extract.ml new file mode 100644 index 000000000..f93245bc2 --- /dev/null +++ b/ocaml-lsp-server/test/e2e-new/refactor_extract.ml @@ -0,0 +1,186 @@ +open Test.Import +module Req = Ocaml_lsp_server.Custom_request.Refactor_extract + +module Util = struct + let call_extract ?extract_name ~start ~stop client = + let uri = DocumentUri.of_path "test.ml" in + let text_document = TextDocumentIdentifier.create ~uri in + let params = + Req.Request_params.create ?extract_name ~text_document ~start ~stop () + |> Req.Request_params.yojson_of_t + |> Jsonrpc.Structured.t_of_yojson + |> Option.some + in + let req = Lsp.Client_request.UnknownRequest { meth = Req.meth; params } in + Client.request client req + ;; + + let test ?extract_name ~start ~stop source = + let request client = + let open Fiber.O in + let+ response = call_extract ?extract_name ~start ~stop client in + Test.print_result response + in + Helpers.test source request + ;; +end + +let%expect_test "Example sample from merlin 1" = + let source = + {|module type EMPTY = sig end +let f () : (module EMPTY) = + (module struct + let const_name2 = assert false + let secret = String.make 100 '@' + end) +|} + in + let start = Position.create ~line:4 ~character:33 + and stop = Position.create ~line:4 ~character:36 in + Util.test ~start ~stop source; + [%expect + {| + { + "position": { + "end": { "character": 6, "line": 5 }, + "start": { "character": 0, "line": 1 } + }, + "content": "let const_name1 = '@'\nlet f () : (module EMPTY) =\n (module struct\n let const_name2 = assert false\n let secret = String.make 100 const_name1\n end)", + "selection_range": { + "end": { "character": 15, "line": 1 }, + "start": { "character": 4, "line": 1 } + } + } |}] +;; + +let%expect_test "Example sample from merlin 2" = + let source = + {|let fun_name1 () = () + +let all_empty l = + List.for_all + (function + | [] -> true + | _ -> false) + l +|} + in + let start = Position.create ~line:4 ~character:4 + and stop = Position.create ~line:6 ~character:19 in + Util.test ~start ~stop source; + [%expect + {| + { + "position": { + "end": { "character": 5, "line": 7 }, + "start": { "character": 0, "line": 2 } + }, + "content": "let fun_name2 = (function | [] -> true | _ -> false)\nlet all_empty l =\n List.for_all\n fun_name2 \n l", + "selection_range": { + "end": { "character": 13, "line": 2 }, + "start": { "character": 4, "line": 2 } + } + } |}] +;; + +let%expect_test "Example sample from merlin 3" = + let source = + {|(* A comment *) +let z = "..." + +let test x y = + let fun_name2 = Fun.id in + let m = + let m = print_endline (x ^ y ^ z) in + m + in + m +|} + in + let start = Position.create ~line:6 ~character:12 + and stop = Position.create ~line:6 ~character:37 in + Util.test ~extract_name:"print_xyz" ~start ~stop source; + [%expect + {| + { + "position": { + "end": { "character": 3, "line": 9 }, + "start": { "character": 0, "line": 3 } + }, + "content": "let print_xyz (x) (y) = print_endline (x ^ (y ^ z))\nlet test x y =\n let fun_name2 = Fun.id in\n let m =\n let m = print_xyz x y in\n m\n in\n m", + "selection_range": { + "end": { "character": 13, "line": 3 }, + "start": { "character": 4, "line": 3 } + } + } + |}] +;; + +let%expect_test "Example sample from merlin 4" = + let source = + {|let f = + print_endline "Wild side effect!"; + 1 :: [ 2; 3; 4 ] +|} + in + let start = Position.create ~line:1 ~character:12 + and stop = Position.create ~line:1 ~character:37 in + Util.test ~extract_name:"show" ~start ~stop source; + [%expect + {| + { + "position": { + "end": { "character": 18, "line": 2 }, + "start": { "character": 0, "line": 0 } + }, + "content": "let show = \"Wild side effect!\"\nlet f =\n print_endline show;\n 1 :: [ 2; 3; 4 ]", + "selection_range": { + "end": { "character": 8, "line": 0 }, + "start": { "character": 4, "line": 0 } + } + } + |}] +;; + +let%expect_test "Example sample from merlin 5" = + let source = + {|class a = + let inner_expr = + let bar = 20 in + object + method foo = bar + end + in + object + method x = (Fun.const 10) () + method y = print_endline + method z = + let x = + object + method x = "foobar" + end + in + x + end + +and b = object end +|} + in + let start = Position.create ~line:2 ~character:4 + and stop = Position.create ~line:5 ~character:37 in + Util.test ~extract_name:"outsider_expr" ~start ~stop source; + [%expect + {| + { + "position": { + "end": { "character": 5, "line": 17 }, + "start": { "character": 0, "line": 0 } + }, + "content": "let outsider_expr () = let bar = 20 in object method foo = bar end\nclass a =\n let inner_expr =\n outsider_expr ()\n in\n object\n method x = (Fun.const 10) ()\n method y = print_endline\n method z =\n let x =\n object\n method x = \"foobar\"\n end\n in\n x\n end", + "selection_range": { + "end": { "character": 17, "line": 0 }, + "start": { "character": 4, "line": 0 } + } + } + |}] +;; diff --git a/ocaml-lsp-server/test/e2e-new/start_stop.ml b/ocaml-lsp-server/test/e2e-new/start_stop.ml index f369cf4a1..a4dc805ea 100644 --- a/ocaml-lsp-server/test/e2e-new/start_stop.ml +++ b/ocaml-lsp-server/test/e2e-new/start_stop.ml @@ -96,6 +96,7 @@ let%expect_test "start/stop" = "handleGetDocumentation": true, "handleConstruct": true, "handleTypeSearch": true, + "handleRefactorExtract": true, "handleJump": true } },