respect completion prefix when completing optional arguments

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

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

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" =

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 }
+        }
+      }
+    }
+    |}]

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

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)

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