diff --git a/CHANGES.md b/CHANGES.md index 5a36ef631..aefc5f24c 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -28,6 +28,9 @@ This now includes PPXs like `let%expect_test` or `let%bench` in the outline. +- Introduce a `destruct-line` code action. This is an improved version of the + old `destruct` code action. (#1283) + ## Fixes - Detect document kind by looking at merlin's `suffixes` config. diff --git a/dune-project b/dune-project index a0cf4a626..a7616fb78 100644 --- a/dune-project +++ b/dune-project @@ -45,6 +45,7 @@ possible and does not make any assumptions about IO. (description "An LSP server for OCaml.") (depends yojson + base (re (>= 1.5.0)) (ppx_yojson_conv_lib (>= "v0.14")) (dune-rpc (>= 3.4.0)) diff --git a/flake.nix b/flake.nix index c0870c67f..85c220ef7 100644 --- a/flake.nix +++ b/flake.nix @@ -104,6 +104,7 @@ yojson ppx_yojson_conv_lib merlin-lib + base ]; propagatedBuildInputs = [ ]; buildPhase = '' diff --git a/ocaml-lsp-server.opam b/ocaml-lsp-server.opam index 73193e528..f0609e6d8 100644 --- a/ocaml-lsp-server.opam +++ b/ocaml-lsp-server.opam @@ -21,6 +21,7 @@ bug-reports: "https://github.com/ocaml/ocaml-lsp/issues" depends: [ "dune" {>= "3.0"} "yojson" + "base" "re" {>= "1.5.0"} "ppx_yojson_conv_lib" {>= "v0.14"} "dune-rpc" {>= "3.4.0"} diff --git a/ocaml-lsp-server/src/code_actions.ml b/ocaml-lsp-server/src/code_actions.ml index 0a7be7b2f..f76529599 100644 --- a/ocaml-lsp-server/src/code_actions.ml +++ b/ocaml-lsp-server/src/code_actions.ml @@ -34,7 +34,8 @@ let compute_ocaml_code_actions (params : CodeActionParams.t) state doc = let enabled_actions = List.filter ~f:action_is_enabled - [ Action_destruct.t state + [ Action_destruct_line.t state + ; Action_destruct.t state ; Action_inferred_intf.t state ; Action_type_annotate.t ; Action_remove_type_annotation.t diff --git a/ocaml-lsp-server/src/code_actions/action_destruct.ml b/ocaml-lsp-server/src/code_actions/action_destruct.ml index 37feb2831..4414305b8 100644 --- a/ocaml-lsp-server/src/code_actions/action_destruct.ml +++ b/ocaml-lsp-server/src/code_actions/action_destruct.ml @@ -1,7 +1,7 @@ open Import open Fiber.O -let action_kind = "destruct" +let action_kind = "destruct (enumerate cases)" let kind = CodeActionKind.Other action_kind diff --git a/ocaml-lsp-server/src/code_actions/action_destruct_line.ml b/ocaml-lsp-server/src/code_actions/action_destruct_line.ml new file mode 100644 index 000000000..fdd810df0 --- /dev/null +++ b/ocaml-lsp-server/src/code_actions/action_destruct_line.ml @@ -0,0 +1,298 @@ +open Import +open Fiber.O + +let action_kind = "destruct-line (enumerate cases, use existing match)" + +let kind = CodeActionKind.Other action_kind + +(* TODO: All of the pre- and post-processing here is done by simple regexes and other + string manipulations. It would be nice if more of it could rely on the typed tree or + other analysis of the code provided by Merlin. *) + +type statement_kind = + | MatchLine (* [match ...] *) + | MatchWithLine (* [match ... with] *) + | CaseLine (* [|...->...] *) + | Hole +(* [|..._...->...] AND the range indicates a query at the underscore. *) + +type destructable_statement = + { code : string + ; kind : statement_kind + ; query_range : Range.t + (* Range sent to Merlin based on our pre-processing. *) + ; reply_range : Range.t (* Where Merlin's reply will go. *) + } + +(** Extracts the line of [doc] that the query indicated by [range] starts on.*) +let get_line (doc : Document.t) (range : Range.t) = + let text = Document.text doc in + let start_line = range.start.line + 1 in + let source = Document.source doc in + let (`Offset pos) = Msource.get_offset source (`Logical (start_line, 0)) in + let (`Offset next) = + Msource.get_offset source (`Logical (start_line + 1, 0)) + in + let len = next - pos in + String.sub text ~pos ~len + +(** Trims leading and trailing whitespace plus some number of additional + characters from the head and tail of a string. Used to transform [match x] + or [match x with] to [x]. *) +let strip_head_and_tail str ~head_offset ~tail_offset = + let str = String.strip str in + let l = String.length str in + let substr = + String.sub str ~pos:head_offset ~len:(l - head_offset - tail_offset) + in + String.strip substr + +(** Finds the start and end indices of a substring for extraction. *) +let substr_endpoints_exn ~str ~substr = + let start_index = String.substr_index_exn str ~pattern:substr in + let end_index = start_index + String.length substr in + (start_index, end_index) + +(** Assumes [case_line] passes the check for a CaseLine, but hasn't had + whitespace removed. Checks that the cursor is before the arrow and the + position before or after the cursor has an underscore. *) +let is_hole (case_line : string) (cursor_pos : int) = + let arrow_pos = String.substr_index_exn case_line ~pattern:"->" in + if cursor_pos <= 0 || cursor_pos >= arrow_pos then false + (* We're only looking for '_' if the cursor is between "|" and "->". *) + else if + Char.equal case_line.[cursor_pos] '_' + || Char.equal case_line.[cursor_pos - 1] '_' + then true + else false + +let get_statement_kind = + let space_without_nl = Re.set " \t" in + (* Line starts with [match] and has at least one other word. *) + let match_regex = + let open Re in + seq [ str "match"; rep1 space_without_nl; compl [ space_without_nl ] ] + in + let match_with_regex = + let open Re in + seq [ match_regex; rep any; space_without_nl; str "with"; eos ] + in + (* Line starts with a pipe and contains an arrow. *) + let case_regex = + let open Re in + seq [ str "|"; rep any; str "->"; rep any ] + in + let regexes = + [ (match_with_regex, `MatchWithLine) + ; (match_regex, `MatchLine) + ; (case_regex, `CaseLine) + ] + |> List.map ~f:(fun (re, kind) -> (Re.(seq [ bos; re ] |> compile), kind)) + in + fun (code_line : string) (range : Range.t) -> + let logical_line = String.strip code_line in + (* Line starts with [match], ends with [with], and has at least one other word. *) + List.find_map regexes ~f:(fun (re, name) -> + Option.some_if (Re.execp re logical_line) name) + |> Option.bind ~f:(function + | `MatchWithLine -> Some MatchWithLine + | `MatchLine -> Some MatchLine + | `CaseLine -> + if is_hole code_line range.start.character then Some Hole + else Some CaseLine) + +(** Given a line of the form [match x] or [match x with] or [| x -> y], create a + query range corresponding to [x]. *) +let get_query_range (code : string) (kind : statement_kind) (range : Range.t) : + Range.t = + let expr = + match kind with + | MatchLine -> strip_head_and_tail code ~head_offset:5 ~tail_offset:0 + | MatchWithLine -> strip_head_and_tail code ~head_offset:5 ~tail_offset:4 + | CaseLine -> + let len = String.substr_index_exn code ~pattern:"->" in + let expr = String.sub code ~pos:0 ~len in + strip_head_and_tail expr ~head_offset:1 ~tail_offset:0 + | Hole -> "" + in + let start_index, end_index = + match kind with + | Hole -> (range.start.character, range.end_.character) + | _ -> substr_endpoints_exn ~str:code ~substr:expr + in + { start = { range.start with character = start_index } + ; end_ = { range.end_ with character = end_index } + } + +(** Finds the portion of the text that will be overwritten by Merlin's reply. + For a MatchLine or a MatchWithLine, Merlin's reply will include "match" and + "with", so to avoid duplication, we want the existing "match" and (possibly) + "with" to be included in the range that gets replaced. *) +let get_reply_range (code : string) (kind : statement_kind) + (query_range : Range.t) = + match kind with + | CaseLine | Hole -> query_range + | MatchLine | MatchWithLine -> + let logical_line = String.strip code in + let start_char, end_char = + substr_endpoints_exn ~str:code ~substr:logical_line + in + { start = { query_range.start with character = start_char } + ; end_ = { query_range.end_ with character = end_char } + } + +(** Adjusts the location Merlin gave us to ensure the right text gets + overwritten. *) +let adjust_reply_location ~(statement : destructable_statement) (loc : Loc.t) : + Loc.t = + let start_offset = + statement.reply_range.start.character + - statement.query_range.start.character + in + let end_offset = + statement.reply_range.end_.character - statement.query_range.end_.character + in + let loc_start = + { loc.loc_start with pos_cnum = loc.loc_start.pos_cnum + start_offset } + in + let loc_end = + { loc.loc_end with pos_cnum = loc.loc_end.pos_cnum + end_offset } + in + { loc with loc_start; loc_end } + +(** Tries to find a statement we know how to handle on the line where the range + starts. *) +let extract_statement (doc : Document.t) (ca_range : Range.t) : + destructable_statement option = + if ca_range.start.line <> ca_range.end_.line then None + else + let code = get_line doc ca_range in + match get_statement_kind code ca_range with + | None -> None + | Some kind -> + let query_range = get_query_range code kind ca_range in + let reply_range = get_reply_range code kind query_range in + Some { code; kind; query_range; reply_range } + +(* Merlin often surrounds [line] (or part of it) with parentheses that we don't want. *) +let strip_parentheses = + let regex = + let open Re in + seq [ str ")"; rep1 space; str "->"; rep1 space; char '_' ] |> compile + in + fun ~(kind : statement_kind) (line : string) -> + (match kind with + | MatchLine | MatchWithLine | Hole -> line + | CaseLine -> Re.replace ~f:(fun _ -> " -> _") regex line) + |> String.chop_prefix_if_exists ~prefix:"(" + |> String.chop_suffix_if_exists ~suffix:")" + +let match_indent = + let re = Re.str "\n| " |> Re.compile in + fun ~(statement : destructable_statement) (new_code : string) -> + let full_line = statement.code in + let i = + String.substr_index_exn full_line ~pattern:(String.strip full_line) + in + let indent = String.sub full_line ~pos:0 ~len:i in + Re.replace ~f:(fun _ -> "\n" ^ indent ^ "| ") re new_code + +(* TODO: If [ocamlformat_rpc] ever gets implemented, it would probably be worth + re-thinking the post-processing that's happening here. *) +let format_merlin_reply = + let start_of_case = Re.str " | " |> Re.compile in + fun ~(statement : destructable_statement) (new_code : string) -> + let lines = Re.split start_of_case new_code in + let lines = + match lines with + | fst :: rst -> fst :: List.map ~f:String.strip rst + | [] -> lines + in + match statement.kind with + | MatchLine | MatchWithLine -> + String.concat ~sep:"\n| " lines + |> strip_parentheses ~kind:statement.kind + |> match_indent ~statement + | CaseLine -> + List.map ~f:(strip_parentheses ~kind:statement.kind) lines + |> String.concat ~sep:" -> _\n| " + |> match_indent ~statement + | Hole -> String.concat ~sep:" -> _\n| " lines |> match_indent ~statement + +let code_action_of_case_analysis ~supportsJumpToNextHole doc uri (loc, newText) + = + let range : Range.t = Range.of_loc loc in + let textedit : TextEdit.t = { range; newText } in + let edit : WorkspaceEdit.t = + let version = Document.version doc in + let textDocument = + OptionalVersionedTextDocumentIdentifier.create ~uri ~version () + in + let edit = + TextDocumentEdit.create ~textDocument ~edits:[ `TextEdit textedit ] + in + WorkspaceEdit.create ~documentChanges:[ `TextDocumentEdit edit ] () + in + let title = String.capitalize action_kind in + let command = + if supportsJumpToNextHole then + Some + (Client.Custom_commands.next_hole + ~in_range:(Range.resize_for_edit textedit) + ~notify_if_no_hole:false + ()) + else None + in + CodeAction.create + ~title + ~kind:(CodeActionKind.Other action_kind) + ~edit + ?command + ~isPreferred:false + () + +let dispatch_destruct (merlin : Document.Merlin.t) (range : Range.t) = + let command = + let start = Position.logical range.start in + let finish = Position.logical range.end_ in + Query_protocol.Case_analysis (start, finish) + in + Document.Merlin.dispatch ~name:"destruct" merlin command + +let code_action (state : State.t) (doc : Document.t) + (params : CodeActionParams.t) = + let uri = params.textDocument.uri in + match Document.kind doc with + | `Other -> Fiber.return None + | `Merlin merlin -> ( + match (Document.Merlin.kind merlin, extract_statement doc params.range) with + | Intf, _ | _, None -> Fiber.return None + | Impl, Some statement -> ( + let+ res = dispatch_destruct merlin statement.query_range in + match res with + | Ok (loc, newText) -> + let loc = adjust_reply_location ~statement loc in + let newText = format_merlin_reply ~statement newText in + let supportsJumpToNextHole = + State.experimental_client_capabilities state + |> Client.Experimental_capabilities.supportsJumpToNextHole + in + Some + (code_action_of_case_analysis + ~supportsJumpToNextHole + doc + uri + (loc, newText)) + | Error + { exn = + ( Merlin_analysis.Destruct.Wrong_parent _ + | Query_commands.No_nodes + | Merlin_analysis.Destruct.Not_allowed _ + | Merlin_analysis.Destruct.Useless_refine + | Merlin_analysis.Destruct.Ill_typed + | Merlin_analysis.Destruct.Nothing_to_do ) + ; backtrace = _ + } -> None + | Error exn -> Exn_with_backtrace.reraise exn)) + +let t state = { Code_action.kind; run = `Non_batchable (code_action state) } diff --git a/ocaml-lsp-server/src/code_actions/action_destruct_line.mli b/ocaml-lsp-server/src/code_actions/action_destruct_line.mli new file mode 100644 index 000000000..fd63cdb23 --- /dev/null +++ b/ocaml-lsp-server/src/code_actions/action_destruct_line.mli @@ -0,0 +1,49 @@ +open Import + +(** This code action allows the user to invoke Merlin-destruct to enumerate + cases from various lines of a partial match statement. If the line is of any + of these forms: [match x] [match x with] [| x -> y] then the pre-processing + will extract [x] and invoke Merlin-destruct on it. Some post-processing is + applied to Merlin's response to make it more useful for adding subsequent + code: extraneous tokens are stripped and cases are split across lines. For + example, supposing [x] is a [bool], then the line [match x with] expands to + [match x with + | false -> _ + | true -> _]. The same expansion + results from invoking the code action on the second line of + [match x with + | false -> _]. + + In addition, the code action detects a sub-case of the [| x -> y] form, + where the cursor is on an underscore within [x]. This often corresponds to a + wildcard pattern where a destruct action is useful and extra post-processing + helps. The follwing expansions result from repeated applications of + [destruct-line]: + [let zip (type a b) (xs : a list) (ys : b list) : (a * b) list = + match xs, ys] + (code action invoked anywhere on the match line) + [let zip (type a b) (xs : a list) (ys : b list) : (a * b) list = + match (xs, ys) with + | (_, _) -> _] + (CA invoked on the first underscore) + [let zip (type a b) (xs : a list) (ys : b list) : (a * b) list = + match (xs, ys) with + | ([], _) -> _ + | (_::_, _) -> _] + (CA invoked on the first underscore) + [let zip (type a b) (xs : a list) (ys : b list) : (a * b) list = + match (xs, ys) with + | ([], []) -> _ + | ([], _::_) -> _ + | (_::_, _) -> _] + (CA invoked on the second-to-last underscore) + [let zip (type a b) (xs : a list) (ys : b list) : (a * b) list = + match (xs, ys) with + | ([], []) -> _ + | ([], _::_) -> _ + | (_::_, []) -> _ + | (_::_, _::_) -> _] *) + +val kind : CodeActionKind.t + +val t : State.t -> Code_action.t diff --git a/ocaml-lsp-server/src/dune b/ocaml-lsp-server/src/dune index 2adbc7c1c..90f17a714 100644 --- a/ocaml-lsp-server/src/dune +++ b/ocaml-lsp-server/src/dune @@ -35,7 +35,8 @@ yojson dune-rpc ocamlformat-rpc-lib - ocamlc-loc) + ocamlc-loc + base) (lint (pps ppx_yojson_conv)) (instrumentation diff --git a/ocaml-lsp-server/src/import.ml b/ocaml-lsp-server/src/import.ml index 74b5269d1..e250ec7eb 100644 --- a/ocaml-lsp-server/src/import.ml +++ b/ocaml-lsp-server/src/import.ml @@ -33,6 +33,14 @@ include struct module String = struct include String + let strip = trim + + let chop_prefix_if_exists = Base.String.chop_prefix_if_exists + + let chop_suffix_if_exists = Base.String.chop_suffix_if_exists + + let substr_index_exn = Base.String.substr_index_exn + (**Filters a string keeping any chars for which f returns true and discarding those for which it returns false*) let filter f s = diff --git a/ocaml-lsp-server/test/e2e-new/code_actions.ml b/ocaml-lsp-server/test/e2e-new/code_actions.ml index def90b54c..1d79ddce3 100644 --- a/ocaml-lsp-server/test/e2e-new/code_actions.ml +++ b/ocaml-lsp-server/test/e2e-new/code_actions.ml @@ -483,7 +483,10 @@ let f (x : t) = x let end_ = Position.create ~line:2 ~character:17 in Range.create ~start ~end_ in - print_code_actions source range ~filter:(find_action "destruct"); + print_code_actions + source + range + ~filter:(find_action "destruct (enumerate cases)"); [%expect {| Code actions: @@ -505,9 +508,276 @@ let f (x : t) = x ] }, "isPreferred": false, - "kind": "destruct", - "title": "Destruct" - } |}] + "kind": "destruct (enumerate cases)", + "title": "Destruct (enumerate cases)" + } + |}] + +let%expect_test "can destruct match line" = + let source = {ocaml| +let f (x:bool) = + match x +|ocaml} in + let range = + let start = Position.create ~line:2 ~character:5 in + let end_ = Position.create ~line:2 ~character:5 in + Range.create ~start ~end_ + in + print_code_actions + source + range + ~filter:(find_action "destruct-line (enumerate cases, use existing match)"); + [%expect + {| + Code actions: + { + "edit": { + "documentChanges": [ + { + "edits": [ + { + "newText": "match x with\n | false -> _\n | true -> _", + "range": { + "end": { "character": 9, "line": 2 }, + "start": { "character": 2, "line": 2 } + } + } + ], + "textDocument": { "uri": "file:///foo.ml", "version": 0 } + } + ] + }, + "isPreferred": false, + "kind": "destruct-line (enumerate cases, use existing match)", + "title": "Destruct-line (enumerate cases, use existing match)" + } + |}] + +let%expect_test "can destruct match-with line" = + let source = {ocaml| + match (Ok 0) with +|ocaml} in + let range = + let start = Position.create ~line:1 ~character:0 in + let end_ = Position.create ~line:1 ~character:0 in + Range.create ~start ~end_ + in + print_code_actions + source + range + ~filter:(find_action "destruct-line (enumerate cases, use existing match)"); + [%expect + {| + Code actions: + { + "edit": { + "documentChanges": [ + { + "edits": [ + { + "newText": "match Ok 0 with\n | Ok _ -> _\n | Error _ -> _", + "range": { + "end": { "character": 21, "line": 1 }, + "start": { "character": 4, "line": 1 } + } + } + ], + "textDocument": { "uri": "file:///foo.ml", "version": 0 } + } + ] + }, + "isPreferred": false, + "kind": "destruct-line (enumerate cases, use existing match)", + "title": "Destruct-line (enumerate cases, use existing match)" + } + |}] + +let%expect_test "can destruct case line" = + let source = + {ocaml| +type q = +| A +| B +| C +| D +let f (x: q) = + match x with + | C -> _ +|ocaml} + in + let range = + let start = Position.create ~line:8 ~character:0 in + let end_ = Position.create ~line:8 ~character:0 in + Range.create ~start ~end_ + in + print_code_actions + source + range + ~filter:(find_action "destruct-line (enumerate cases, use existing match)"); + [%expect + {| + Code actions: + { + "edit": { + "documentChanges": [ + { + "edits": [ + { + "newText": "\n | A -> _\n | B -> _\n | D -> _", + "range": { + "end": { "character": 10, "line": 8 }, + "start": { "character": 10, "line": 8 } + } + } + ], + "textDocument": { "uri": "file:///foo.ml", "version": 0 } + } + ] + }, + "isPreferred": false, + "kind": "destruct-line (enumerate cases, use existing match)", + "title": "Destruct-line (enumerate cases, use existing match)" + } + |}] + +let%expect_test "can destruct hole" = + let source = + {ocaml| +let zip (type a b) (xs : a list) (ys : b list) : (a * b) list = + match (xs, ys) with + | (_, _) -> _ +|ocaml} + in + let range = + let start = Position.create ~line:3 ~character:5 in + let end_ = Position.create ~line:3 ~character:5 in + Range.create ~start ~end_ + in + print_code_actions + source + range + ~filter:(find_action "destruct-line (enumerate cases, use existing match)"); + [%expect + {| + Code actions: + { + "edit": { + "documentChanges": [ + { + "edits": [ + { + "newText": "([], _) -> _\n | (_::_, _)", + "range": { + "end": { "character": 10, "line": 3 }, + "start": { "character": 4, "line": 3 } + } + } + ], + "textDocument": { "uri": "file:///foo.ml", "version": 0 } + } + ] + }, + "isPreferred": false, + "kind": "destruct-line (enumerate cases, use existing match)", + "title": "Destruct-line (enumerate cases, use existing match)" + } + |}] + +let%expect_test "destruct uses the right number of newlines" = + let source = + {ocaml| +type t = + | Very_long_name_for_for_the_first_case_so_that_merlin_will_use_multiple_lines + | Almost_as_long_name_for_for_the_second_case + | Another_long_name_for_for_the_third_case +;; +let f (x: t) = + match x with + |ocaml} + in + let range = + let start = Position.create ~line:7 ~character:7 in + let end_ = Position.create ~line:7 ~character:7 in + Range.create ~start ~end_ + in + print_code_actions + source + range + ~filter:(find_action "destruct-line (enumerate cases, use existing match)"); + [%expect + {| + Code actions: + { + "edit": { + "documentChanges": [ + { + "edits": [ + { + "newText": "match x with\n | Very_long_name_for_for_the_first_case_so_that_merlin_will_use_multiple_lines\n -> _\n | Almost_as_long_name_for_for_the_second_case -> _\n | Another_long_name_for_for_the_third_case -> _", + "range": { + "end": { "character": 14, "line": 7 }, + "start": { "character": 2, "line": 7 } + } + } + ], + "textDocument": { "uri": "file:///foo.ml", "version": 0 } + } + ] + }, + "isPreferred": false, + "kind": "destruct-line (enumerate cases, use existing match)", + "title": "Destruct-line (enumerate cases, use existing match)" + } + |}] + +let%expect_test "destruct strips parentheses even on long lines" = + let source = + {ocaml| +type q = + | Very_long_name_for_for_the_first_case_so_that_merlin_will_use_multiple_lines + | Almost_as_long_name_for_for_the_second_case + | Another_long_name_for_for_the_third_case + | Very_long_name_for_for_the_last_case_so_that_we_can_make_sure_it_strips_parens +;; +let f (x: q) = + match x with + | Almost_as_long_name_for_for_the_second_case -> _ +|ocaml} + in + let range = + let start = Position.create ~line:9 ~character:22 in + let end_ = Position.create ~line:9 ~character:22 in + Range.create ~start ~end_ + in + print_code_actions + source + range + ~filter:(find_action "destruct-line (enumerate cases, use existing match)"); + [%expect + {| + Code actions: + { + "edit": { + "documentChanges": [ + { + "edits": [ + { + "newText": "\n | Very_long_name_for_for_the_first_case_so_that_merlin_will_use_multiple_lines\n -> _\n | Another_long_name_for_for_the_third_case -> _\n | Very_long_name_for_for_the_last_case_so_that_we_can_make_sure_it_strips_parens -> _", + "range": { + "end": { "character": 52, "line": 9 }, + "start": { "character": 52, "line": 9 } + } + } + ], + "textDocument": { "uri": "file:///foo.ml", "version": 0 } + } + ] + }, + "isPreferred": false, + "kind": "destruct-line (enumerate cases, use existing match)", + "title": "Destruct-line (enumerate cases, use existing match)" + } + |}] let%expect_test "can infer module interfaces" = let impl_source = diff --git a/ocaml-lsp-server/test/e2e-new/start_stop.ml b/ocaml-lsp-server/test/e2e-new/start_stop.ml index c9f822580..dd8ab0dfe 100644 --- a/ocaml-lsp-server/test/e2e-new/start_stop.ml +++ b/ocaml-lsp-server/test/e2e-new/start_stop.ml @@ -54,85 +54,87 @@ let%expect_test "start/stop" = |> print_endline); [%expect {| - client: server initialized with: - { - "capabilities": { - "codeActionProvider": { - "codeActionKinds": [ - "quickfix", "refactor.inline", "construct", "destruct", - "inferred_intf", "put module name in identifiers", - "remove module name from identifiers", "remove type annotation", - "type-annotate" - ] - }, - "codeLensProvider": { "resolveProvider": false }, - "completionProvider": { - "resolveProvider": true, - "triggerCharacters": [ ".", "#" ] - }, - "declarationProvider": true, - "definitionProvider": true, - "documentFormattingProvider": true, - "documentHighlightProvider": true, - "documentSymbolProvider": true, - "executeCommandProvider": { - "commands": [ - "ocamllsp/view-metrics", "ocamllsp/open-related-source", - "ocamllsp/show-document-text", "ocamllsp/show-merlin-config", - "dune/promote" + client: server initialized with: + { + "capabilities": { + "codeActionProvider": { + "codeActionKinds": [ + "quickfix", "refactor.inline", "construct", + "destruct (enumerate cases)", "inferred_intf", + "put module name in identifiers", + "remove module name from identifiers", "remove type annotation", + "type-annotate" + ] + }, + "codeLensProvider": { "resolveProvider": false }, + "completionProvider": { + "resolveProvider": true, + "triggerCharacters": [ ".", "#" ] + }, + "declarationProvider": true, + "definitionProvider": true, + "documentFormattingProvider": true, + "documentHighlightProvider": true, + "documentSymbolProvider": true, + "executeCommandProvider": { + "commands": [ + "ocamllsp/view-metrics", "ocamllsp/open-related-source", + "ocamllsp/show-document-text", "ocamllsp/show-merlin-config", + "dune/promote" + ] + }, + "experimental": { + "ocamllsp": { + "interfaceSpecificLangId": true, + "handleSwitchImplIntf": true, + "handleInferIntf": true, + "handleTypedHoles": true, + "handleWrappingAstNode": true, + "diagnostic_promotions": true, + "handleHoverExtended": true + } + }, + "foldingRangeProvider": true, + "hoverProvider": true, + "inlayHintProvider": true, + "referencesProvider": true, + "renameProvider": { "prepareProvider": true }, + "selectionRangeProvider": true, + "semanticTokensProvider": { + "full": { "delta": true }, + "legend": { + "tokenModifiers": [ + "declaration", "definition", "readonly", "static", "deprecated", + "abstract", "async", "modification", "documentation", + "defaultLibrary" + ], + "tokenTypes": [ + "namespace", "type", "class", "enum", "interface", "struct", + "typeParameter", "parameter", "variable", "property", "enumMember", + "event", "function", "method", "macro", "keyword", "modifier", + "comment", "string", "number", "regexp", "operator", "decorator" ] - }, - "experimental": { - "ocamllsp": { - "interfaceSpecificLangId": true, - "handleSwitchImplIntf": true, - "handleInferIntf": true, - "handleTypedHoles": true, - "handleWrappingAstNode": true, - "diagnostic_promotions": true, - "handleHoverExtended": true - } - }, - "foldingRangeProvider": true, - "hoverProvider": true, - "inlayHintProvider": true, - "referencesProvider": true, - "renameProvider": { "prepareProvider": true }, - "selectionRangeProvider": true, - "semanticTokensProvider": { - "full": { "delta": true }, - "legend": { - "tokenModifiers": [ - "declaration", "definition", "readonly", "static", "deprecated", - "abstract", "async", "modification", "documentation", - "defaultLibrary" - ], - "tokenTypes": [ - "namespace", "type", "class", "enum", "interface", "struct", - "typeParameter", "parameter", "variable", "property", "enumMember", - "event", "function", "method", "macro", "keyword", "modifier", - "comment", "string", "number", "regexp", "operator", "decorator" - ] - } - }, - "signatureHelpProvider": { - "triggerCharacters": [ " ", "~", "?", ":", "(" ] - }, - "textDocumentSync": { - "change": 2, - "openClose": true, - "save": { "includeText": false }, - "willSave": false, - "willSaveWaitUntil": false - }, - "typeDefinitionProvider": true, - "workspace": { - "workspaceFolders": { "changeNotifications": true, "supported": true } - }, - "workspaceSymbolProvider": true + } + }, + "signatureHelpProvider": { + "triggerCharacters": [ " ", "~", "?", ":", "(" ] + }, + "textDocumentSync": { + "change": 2, + "openClose": true, + "save": { "includeText": false }, + "willSave": false, + "willSaveWaitUntil": false + }, + "typeDefinitionProvider": true, + "workspace": { + "workspaceFolders": { "changeNotifications": true, "supported": true } }, - "serverInfo": { "name": "ocamllsp", "version": "dev" } - } - client: shutting down server + "workspaceSymbolProvider": true + }, + "serverInfo": { "name": "ocamllsp", "version": "dev" } + } + client: shutting down server - notifications received: |}] + notifications received: + |}]