From b47bd7361649834ddb947de2711e353da06487a7 Mon Sep 17 00:00:00 2001 From: Aaron Bauer Date: Fri, 17 May 2024 12:39:34 -0400 Subject: [PATCH] respect completion prefix when completing optional arguments (#1277) * respect completion prefix --- CHANGES.md | 5 + ocaml-lsp-server/src/compl.ml | 12 +- ocaml-lsp-server/test/e2e-new/completion.ml | 123 ++-------------- ocaml-lsp-server/test/e2e-new/completions.ml | 133 ++++++++++++++++++ ocaml-lsp-server/test/e2e-new/dune | 1 + ocaml-lsp-server/test/e2e-new/helpers.ml | 36 +++++ ocaml-lsp-server/test/e2e-new/helpers.mli | 6 + .../test/e2e-new/hover_extended.ml | 57 ++------ .../test/e2e-new/workspace_change_config.ml | 41 +----- 9 files changed, 215 insertions(+), 199 deletions(-) create mode 100644 ocaml-lsp-server/test/e2e-new/completions.ml create mode 100644 ocaml-lsp-server/test/e2e-new/helpers.ml create mode 100644 ocaml-lsp-server/test/e2e-new/helpers.mli diff --git a/CHANGES.md b/CHANGES.md index c612a7b40..75b741ee6 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -43,6 +43,11 @@ toggled on, allows display of sytax documentation on hover tooltips. Can be controlled via environment variables and by GUI for VS code. (#1218) +- For completions on labels that the LSP gets from merlin, take into account + whether the prefix being completed starts with `~` or `?`. Change the label + completions that start with `?` to start with `~` when the prefix being + completed starts with `~`. (#1277) + # 1.17.0 ## Fixes diff --git a/ocaml-lsp-server/src/compl.ml b/ocaml-lsp-server/src/compl.ml index 2a08136fd..9734415f3 100644 --- a/ocaml-lsp-server/src/compl.ml +++ b/ocaml-lsp-server/src/compl.ml @@ -115,7 +115,7 @@ module Complete_by_prefix = struct in Query_commands.dispatch pipeline complete - let process_dispatch_resp ~deprecated ~resolve doc pos + let process_dispatch_resp ~deprecated ~resolve ~prefix doc pos (completion : Query_protocol.completions) = let range = let logical_pos = Position.logical pos in @@ -132,6 +132,13 @@ module Complete_by_prefix = struct | `Application { Query_protocol.Compl.labels; argument_type = _ } -> completion.entries @ List.map labels ~f:(fun (name, typ) -> + let name = + if + String.is_prefix prefix ~prefix:"~" + && String.is_prefix name ~prefix:"?" + then "~" ^ String.drop_prefix_if_exists name ~prefix:"?" + else name + in { Query_protocol.Compl.name ; kind = `Label ; desc = typ @@ -190,7 +197,7 @@ module Complete_by_prefix = struct | Impl -> complete_keywords pos prefix in keyword_completionItems - @ process_dispatch_resp ~deprecated ~resolve doc pos completion + @ process_dispatch_resp ~deprecated ~resolve ~prefix doc pos completion end module Complete_with_construct = struct @@ -348,6 +355,7 @@ let complete (state : State.t) Complete_by_prefix.process_dispatch_resp ~resolve ~deprecated + ~prefix merlin pos compl_by_prefix_resp diff --git a/ocaml-lsp-server/test/e2e-new/completion.ml b/ocaml-lsp-server/test/e2e-new/completion.ml index edfb96273..1a9ee961f 100644 --- a/ocaml-lsp-server/test/e2e-new/completion.ml +++ b/ocaml-lsp-server/test/e2e-new/completion.ml @@ -174,7 +174,7 @@ let%expect_test "can start completion after operator with space" = let position = Position.create ~line:0 ~character:16 in print_completions source position; [%expect - {| + {| Completions: { "detail": "('a -> 'b) -> 'a list -> 'b list", @@ -587,7 +587,7 @@ let somenum = 42 let somestring = "hello" let plus_42 (x:int) (y:int) = - somenum + + somenum + |ocaml} in let position = Position.create ~line:5 ~character:12 in @@ -596,134 +596,31 @@ let plus_42 (x:int) (y:int) = {| Completions: { - "kind": 14, - "label": "in", - "textEdit": { - "newText": "in", - "range": { - "end": { "character": 12, "line": 5 }, - "start": { "character": 12, "line": 5 } - } - } - } - { - "detail": "int", + "detail": "int -> int -> int", "kind": 12, - "label": "somenum", + "label": "+", "sortText": "0000", "textEdit": { - "newText": "somenum", + "newText": "+", "range": { "end": { "character": 12, "line": 5 }, - "start": { "character": 12, "line": 5 } + "start": { "character": 11, "line": 5 } } } } { - "detail": "int", + "detail": "float -> float -> float", "kind": 12, - "label": "x", + "label": "+.", "sortText": "0001", "textEdit": { - "newText": "x", - "range": { - "end": { "character": 12, "line": 5 }, - "start": { "character": 12, "line": 5 } - } - } - } - { - "detail": "int", - "kind": 12, - "label": "y", - "sortText": "0002", - "textEdit": { - "newText": "y", - "range": { - "end": { "character": 12, "line": 5 }, - "start": { "character": 12, "line": 5 } - } - } - } - { - "detail": "int", - "kind": 12, - "label": "max_int", - "sortText": "0003", - "textEdit": { - "newText": "max_int", - "range": { - "end": { "character": 12, "line": 5 }, - "start": { "character": 12, "line": 5 } - } - } - } - { - "detail": "int", - "kind": 12, - "label": "min_int", - "sortText": "0004", - "textEdit": { - "newText": "min_int", - "range": { - "end": { "character": 12, "line": 5 }, - "start": { "character": 12, "line": 5 } - } - } - } - { - "detail": "int -> int", - "kind": 12, - "label": "abs", - "sortText": "0005", - "textEdit": { - "newText": "abs", - "range": { - "end": { "character": 12, "line": 5 }, - "start": { "character": 12, "line": 5 } - } - } - } - { - "detail": "in_channel -> int", - "kind": 12, - "label": "in_channel_length", - "sortText": "0006", - "textEdit": { - "newText": "in_channel_length", - "range": { - "end": { "character": 12, "line": 5 }, - "start": { "character": 12, "line": 5 } - } - } - } - { - "detail": "in_channel -> int", - "kind": 12, - "label": "input_binary_int", - "sortText": "0007", - "textEdit": { - "newText": "input_binary_int", - "range": { - "end": { "character": 12, "line": 5 }, - "start": { "character": 12, "line": 5 } - } - } - } - { - "detail": "in_channel -> int", - "kind": 12, - "label": "input_byte", - "sortText": "0008", - "textEdit": { - "newText": "input_byte", + "newText": "+.", "range": { "end": { "character": 12, "line": 5 }, - "start": { "character": 12, "line": 5 } + "start": { "character": 11, "line": 5 } } } } - ............. |}] let%expect_test "completes labels" = diff --git a/ocaml-lsp-server/test/e2e-new/completions.ml b/ocaml-lsp-server/test/e2e-new/completions.ml new file mode 100644 index 000000000..08eec8555 --- /dev/null +++ b/ocaml-lsp-server/test/e2e-new/completions.ml @@ -0,0 +1,133 @@ +open Test.Import + +let print_completion + (completions : + [ `CompletionList of CompletionList.t | `List of CompletionItem.t list ] + option) = + let print_items (items : CompletionItem.t list) = + List.map items ~f:(fun item -> + CompletionItem.yojson_of_t item + |> Yojson.Safe.pretty_to_string ~std:false) + |> String.concat ~sep:"\n" |> print_endline + in + match completions with + | None -> print_endline "no completion response" + | Some completions -> ( + match completions with + | `List items -> print_items items + | `CompletionList completions -> print_items completions.items) + +let completion client position = + Client.request + client + (TextDocumentCompletion + (CompletionParams.create + ~position + ~textDocument:(TextDocumentIdentifier.create ~uri:Helpers.uri) + ())) + +let%expect_test "completing optional arguments" = + let source = + {ocaml| +let foo ?aaa ?aab ~abb () = 5 + +let foo_value = foo ~a +let foo_value = foo ?a +|ocaml} + in + let req client = + let* resp = completion client (Position.create ~line:3 ~character:22) in + let () = print_completion resp in + print_endline "****************************************"; + let* resp = completion client (Position.create ~line:4 ~character:22) in + let () = print_completion resp in + Fiber.return () + in + (* The first three results should respect the [~] prefix and contain "newText" that + starts with a [~]. The second three should contain the prefix matching the argument + type. The LSP could filter these to exclude those that don't match the [?] prefix, + but since the LSP already relies on the clients to do filtering, it feels weird to + add filtering to the LSP. *) + Helpers.test source req; + [%expect + {| + { + "detail": "'a", + "kind": 5, + "label": "~aaa", + "sortText": "0000", + "textEdit": { + "newText": "~aaa", + "range": { + "end": { "character": 22, "line": 3 }, + "start": { "character": 20, "line": 3 } + } + } + } + { + "detail": "'b", + "kind": 5, + "label": "~aab", + "sortText": "0001", + "textEdit": { + "newText": "~aab", + "range": { + "end": { "character": 22, "line": 3 }, + "start": { "character": 20, "line": 3 } + } + } + } + { + "detail": "'c", + "kind": 5, + "label": "~abb", + "sortText": "0002", + "textEdit": { + "newText": "~abb", + "range": { + "end": { "character": 22, "line": 3 }, + "start": { "character": 20, "line": 3 } + } + } + } + **************************************** + { + "detail": "'a", + "kind": 5, + "label": "?aaa", + "sortText": "0000", + "textEdit": { + "newText": "?aaa", + "range": { + "end": { "character": 22, "line": 4 }, + "start": { "character": 20, "line": 4 } + } + } + } + { + "detail": "'b", + "kind": 5, + "label": "?aab", + "sortText": "0001", + "textEdit": { + "newText": "?aab", + "range": { + "end": { "character": 22, "line": 4 }, + "start": { "character": 20, "line": 4 } + } + } + } + { + "detail": "'c", + "kind": 5, + "label": "~abb", + "sortText": "0002", + "textEdit": { + "newText": "~abb", + "range": { + "end": { "character": 22, "line": 4 }, + "start": { "character": 20, "line": 4 } + } + } + } + |}] diff --git a/ocaml-lsp-server/test/e2e-new/dune b/ocaml-lsp-server/test/e2e-new/dune index ca5b03068..fe4d8b125 100644 --- a/ocaml-lsp-server/test/e2e-new/dune +++ b/ocaml-lsp-server/test/e2e-new/dune @@ -45,6 +45,7 @@ action_mark_remove code_actions completion + completions doc_to_md document_flow exit_notification diff --git a/ocaml-lsp-server/test/e2e-new/helpers.ml b/ocaml-lsp-server/test/e2e-new/helpers.ml new file mode 100644 index 000000000..9e856e6a7 --- /dev/null +++ b/ocaml-lsp-server/test/e2e-new/helpers.ml @@ -0,0 +1,36 @@ +open Test.Import + +let client_capabilities = ClientCapabilities.create () + +let uri = DocumentUri.of_path "test.ml" + +let test ?extra_env text req = + let handler = + Client.Handler.make + ~on_notification:(fun client _notification -> + Client.state client; + Fiber.return ()) + () + in + Test.run ~handler ?extra_env (fun client -> + let run_client () = + Client.start + client + (InitializeParams.create ~capabilities:client_capabilities ()) + in + let run () = + let* (_ : InitializeResult.t) = Client.initialized client in + let textDocument = + TextDocumentItem.create ~uri ~languageId:"ocaml" ~version:0 ~text + in + let* () = + Client.notification + client + (TextDocumentDidOpen + (DidOpenTextDocumentParams.create ~textDocument)) + in + let* () = req client in + let* () = Client.request client Shutdown in + Client.stop client + in + Fiber.fork_and_join_unit run_client run) diff --git a/ocaml-lsp-server/test/e2e-new/helpers.mli b/ocaml-lsp-server/test/e2e-new/helpers.mli new file mode 100644 index 000000000..8aa6aba9b --- /dev/null +++ b/ocaml-lsp-server/test/e2e-new/helpers.mli @@ -0,0 +1,6 @@ +open Test.Import + +val uri : Uri.t + +val test : + ?extra_env:string list -> string -> (unit Client.t -> unit Fiber.t) -> unit diff --git a/ocaml-lsp-server/test/e2e-new/hover_extended.ml b/ocaml-lsp-server/test/e2e-new/hover_extended.ml index 2fd7b125a..0a8ee90d4 100644 --- a/ocaml-lsp-server/test/e2e-new/hover_extended.ml +++ b/ocaml-lsp-server/test/e2e-new/hover_extended.ml @@ -1,40 +1,5 @@ open Test.Import -let client_capabilities = ClientCapabilities.create () - -let uri = DocumentUri.of_path "test.ml" - -let test ?extra_env text req = - let handler = - Client.Handler.make - ~on_notification:(fun client _notification -> - Client.state client; - Fiber.return ()) - () - in - Test.run ~handler ?extra_env (fun client -> - let run_client () = - Client.start - client - (InitializeParams.create ~capabilities:client_capabilities ()) - in - let run () = - let* (_ : InitializeResult.t) = Client.initialized client in - let textDocument = - TextDocumentItem.create ~uri ~languageId:"ocaml" ~version:0 ~text - in - let* () = - Client.notification - client - (TextDocumentDidOpen - (DidOpenTextDocumentParams.create ~textDocument)) - in - let* () = req client in - let* () = Client.request client Shutdown in - Client.stop client - in - Fiber.fork_and_join_unit run_client run) - let print_hover hover = match hover with | None -> print_endline "no hover response" @@ -48,7 +13,7 @@ let hover client position = client (TextDocumentHover { HoverParams.position - ; textDocument = TextDocumentIdentifier.create ~uri + ; textDocument = TextDocumentIdentifier.create ~uri:Helpers.uri ; workDoneToken = None }) @@ -60,7 +25,7 @@ let hover_extended client position verbosity = let required = [ ( "textDocument" , TextDocumentIdentifier.yojson_of_t - (TextDocumentIdentifier.create ~uri) ) + (TextDocumentIdentifier.create ~uri:Helpers.uri) ) ; ("position", Position.yojson_of_t position) ] in @@ -91,7 +56,7 @@ let foo_value : foo = Some 1 let () = print_hover resp in Fiber.return () in - test source req; + Helpers.test source req; [%expect {| { @@ -121,7 +86,7 @@ let f a b c d e f g h i = 1 + a + b + c + d + e + f + g + h + i let () = print_hover resp in Fiber.return () in - test source req; + Helpers.test source req; [%expect {| { @@ -151,7 +116,7 @@ let foo_value : foo = Some 1 let () = print_hover resp in Fiber.return () in - test ~extra_env:[ "OCAMLLSP_HOVER_IS_EXTENDED=true" ] source req; + Helpers.test ~extra_env:[ "OCAMLLSP_HOVER_IS_EXTENDED=true" ] source req; [%expect {| { @@ -183,7 +148,7 @@ let foo_value : foo = Some 1 let () = print_hover_extended resp in Fiber.return () in - test source req; + Helpers.test source req; [%expect {| { @@ -208,7 +173,7 @@ let foo_value : foo = Some 1 let () = print_hover_extended resp in Fiber.return () in - test source req; + Helpers.test source req; [%expect {| { @@ -233,7 +198,7 @@ let foo_value : foo = Some 1 let () = print_hover_extended resp in Fiber.return () in - test source req; + Helpers.test source req; [%expect {| { @@ -258,7 +223,7 @@ let foo_value : foo = Some 1 let () = print_hover_extended resp in Fiber.return () in - test source req; + Helpers.test source req; [%expect {| { @@ -287,7 +252,7 @@ let foo_value : foo = Some 1 let () = print_hover_extended resp in Fiber.return () in - test source req; + Helpers.test source req; [%expect {| { @@ -325,7 +290,7 @@ let f a b c d e f g h i = 1 + a + b + c + d + e + f + g + h + i let () = print_hover_extended resp in Fiber.return () in - test source req; + Helpers.test source req; [%expect {| { diff --git a/ocaml-lsp-server/test/e2e-new/workspace_change_config.ml b/ocaml-lsp-server/test/e2e-new/workspace_change_config.ml index 00364080c..76f38d0f3 100644 --- a/ocaml-lsp-server/test/e2e-new/workspace_change_config.ml +++ b/ocaml-lsp-server/test/e2e-new/workspace_change_config.ml @@ -1,40 +1,5 @@ open Test.Import -let client_capabilities = ClientCapabilities.create () - -let uri = DocumentUri.of_path "test.ml" - -let test text req = - let handler = - Client.Handler.make - ~on_notification:(fun client _notification -> - Client.state client; - Fiber.return ()) - () - in - Test.run ~handler (fun client -> - let run_client () = - Client.start - client - (InitializeParams.create ~capabilities:client_capabilities ()) - in - let run () = - let* (_ : InitializeResult.t) = Client.initialized client in - let textDocument = - TextDocumentItem.create ~uri ~languageId:"ocaml" ~version:0 ~text - in - let* () = - Client.notification - client - (TextDocumentDidOpen - (DidOpenTextDocumentParams.create ~textDocument)) - in - let* () = req client in - let* () = Client.request client Shutdown in - Client.stop client - in - Fiber.fork_and_join_unit run_client run) - let change_config client params = Client.notification client (ChangeConfiguration params) @@ -50,7 +15,7 @@ let string = "Hello" |ocaml} in let req client = - let text_document = TextDocumentIdentifier.create ~uri in + let text_document = TextDocumentIdentifier.create ~uri:Helpers.uri in let* () = change_config client @@ -67,7 +32,7 @@ let string = "Hello" Fiber.return () in - test source req; + Helpers.test source req; [%expect {| CodeLens found: 0 |}] let%expect_test "enable hover extended" = @@ -103,7 +68,7 @@ let foo_value : foo = Some 1 let () = Hover_extended.print_hover resp in Fiber.return () in - test source req; + Helpers.test source req; [%expect {| {