Add autocompletion for labelled args

ocaml-lsp-server/src/compl.ml

@@ -205,8 +205,10 @@ module Complete_by_prefix = struct
       | Intf -> []
       | Impl -> complete_keywords pos prefix
     in
-    keyword_completionItems
+    let items = keyword_completionItems
     @ process_dispatch_resp ~deprecated ~resolve ~prefix doc pos completion
+    in
+    (items, completion.context)
   ;;
 end
 
@@ -260,6 +262,31 @@ module Complete_with_construct = struct
   ;;
 end
 
+let is_polymorphic_type argument_type =
+  String.is_prefix ~prefix:"'" argument_type
+;;
+
+let is_primitive_type argument_type =
+  let primitives = [
+    "int"; "float"; "string"; "char"; "bool"; "unit"; "int32"; "int64"; "nativeint"; "bytes"
+  ] in
+  List.mem primitives argument_type ~equal:String.equal
+;;
+
+let is_value_not_operator (item : CompletionItem.t) =
+  let irrelevant_operators = [
+    (* OCaml *)
+    "::"   (* list cons operator, not a value *)
+    ; ":=" (* mutable reference assignment operator *)
+    ; ":"  (* type annotation separator *)
+
+    (* Reason *)
+    ; "==" (* physical equality operator *)
+    ; "="  (* structural equality / let binding operator *)
+  ] in
+  not (List.mem irrelevant_operators item.label ~equal:String.equal)
+;;
+
 let complete
       (state : State.t)
       ({ textDocument = { uri }; position = pos; context; _ } : CompletionParams.t)
@@ -316,7 +343,43 @@ let complete
                 item.deprecatedSupport)
            in
            if not (Merlin_analysis.Typed_hole.can_be_hole prefix)
-           then Complete_by_prefix.complete merlin prefix pos ~resolve ~deprecated
+           then (
+             let* (completions, context) =
+               Complete_by_prefix.complete merlin prefix pos ~resolve ~deprecated
+             in
+             (* Check if we should generate construct completions *)
+             let+ construct_completionItems =
+               match context with
+               | `Application { Query_protocol.Compl.labels = _; argument_type }
+                 when not (is_polymorphic_type argument_type)
+                   && not (is_primitive_type argument_type) ->
+                 let+ construct_response =
+                   Document.Merlin.with_pipeline_exn
+                     ~name:"completion-construct"
+                     merlin
+                     (fun pipeline ->
+                       Complete_with_construct.dispatch_cmd position pipeline)
+                 in
+                 Complete_with_construct.process_dispatch_resp
+                   ~supportsJumpToNextHole:(
+                     state
+                     |> State.experimental_client_capabilities
+                     |> Client.Experimental_capabilities.supportsJumpToNextHole
+                   )
+                   construct_response
+               | _ ->
+                 Fiber.return []
+             in
+             let prefix_completionItems  =
+               match context with
+               | `Application _ ->
+                 (* When in application context try to filter out non-values that are suggested because of string match.
+                    For example, it's not helpful to suggest e.g. `:` or `:=` after `:` *)
+                 completions |> List.filter ~f:is_value_not_operator
+               | `Unknown ->
+                 completions
+             in
+             construct_completionItems @ prefix_completionItems)
            else (
              let reindex_sortText completion_items =
                List.mapi completion_items ~f:(fun idx (ci : CompletionItem.t) ->

ocaml-lsp-server/src/ocaml_lsp_server.ml

@@ -65,7 +65,7 @@ let initialize_info (client_capabilities : ClientCapabilities.t) : InitializeRes
   in
   let codeLensProvider = CodeLensOptions.create ~resolveProvider:false () in
   let completionProvider =
-    CompletionOptions.create ~triggerCharacters:[ "."; "#" ] ~resolveProvider:true ()
+    CompletionOptions.create ~triggerCharacters:[ "."; "#"; ":" ] ~resolveProvider:true ()
   in
   let signatureHelpProvider =
     SignatureHelpOptions.create ~triggerCharacters:[ " "; "~"; "?"; ":"; "(" ] ()

ocaml-lsp-server/test/e2e-new/completion.ml

@@ -1317,3 +1317,138 @@ let%expect_test "completion for object methods" =
       }
     } |}]
 ;;
+
+let%expect_test "completes variant constructors for labeled arguments" =
+  let source = {ocaml|
+type color = Red | Green | Blue | Rgb of int * int * int
+let make_color ~(color: color) = color
+let _ = make_color ~color:
+|ocaml}
+  in
+  print_completions ~limit:5 source (Position.create ~line:5 ~character:26);
+  [%expect
+    {|
+    Completions:
+    {
+      "kind": 14,
+      "label": "in",
+      "textEdit": {
+        "newText": "in",
+        "range": {
+          "end": { "character": 26, "line": 5 },
+          "start": { "character": 26, "line": 5 }
+        }
+      }
+    }
+    {
+      "detail": "color",
+      "kind": 4,
+      "label": "Blue",
+      "sortText": "0000",
+      "textEdit": {
+        "newText": "Blue",
+        "range": {
+          "end": { "character": 26, "line": 5 },
+          "start": { "character": 26, "line": 5 }
+        }
+      }
+    }
+    {
+      "detail": "color",
+      "kind": 4,
+      "label": "Green",
+      "sortText": "0001",
+      "textEdit": {
+        "newText": "Green",
+        "range": {
+          "end": { "character": 26, "line": 5 },
+          "start": { "character": 26, "line": 5 }
+        }
+      }
+    }
+    {
+      "detail": "color",
+      "kind": 4,
+      "label": "Red",
+      "sortText": "0002",
+      "textEdit": {
+        "newText": "Red",
+        "range": {
+          "end": { "character": 26, "line": 5 },
+          "start": { "character": 26, "line": 5 }
+        }
+      }
+    }
+    {
+      "detail": "int * int * int -> color",
+      "kind": 4,
+      "label": "Rgb",
+      "sortText": "0003",
+      "textEdit": {
+        "newText": "Rgb",
+        "range": {
+          "end": { "character": 26, "line": 5 },
+          "start": { "character": 26, "line": 5 }
+        }
+      }
+    }
+    |}]
+;;
+
+let%expect_test "does not complete constructors for primitive types" =
+  let source = {ocaml|
+let make_int ~(v:int) = v
+let x = make_int ~v:
+|ocaml}
+  in
+  print_completions source (Position.create ~line:2 ~character:20);
+  [%expect {| No completions |}]
+;;
+
+let%expect_test "does not complete for polymorphic types" =
+  let source = {ocaml|
+let identity ~(x:'a) = x
+let _ = identity ~x:
+|ocaml}
+  in
+  print_completions source (Position.create ~line:2 ~character:20);
+  [%expect {| No completions |}]
+;;
+
+let%expect_test "completes option type variants" =
+  let source = {ocaml|
+let process ~(value:int option) = value
+let _ = process ~value:
+|ocaml}
+  in
+  print_completions source (Position.create ~line:2 ~character:23);
+  [%expect {|
+Completions:
+{
+  "filterText": "_None",
+  "kind": 1,
+  "label": "None",
+  "sortText": "0000",
+  "textEdit": {
+    "newText": "None",
+    "range": {
+      "end": { "character": 23, "line": 2 },
+      "start": { "character": 23, "line": 2 }
+    }
+  }
+}
+{
+  "filterText": "_(Some _)",
+  "kind": 1,
+  "label": "Some _",
+  "sortText": "0001",
+  "textEdit": {
+    "newText": "(Some _)",
+    "range": {
+      "end": { "character": 23, "line": 2 },
+      "start": { "character": 23, "line": 2 }
+    }
+  }
+}
+|}]
+;;

ocaml-lsp-server/test/e2e-new/start_stop.ml

@@ -67,7 +67,7 @@ let%expect_test "start/stop" =
         "codeLensProvider": { "resolveProvider": false },
         "completionProvider": {
           "resolveProvider": true,
-          "triggerCharacters": [ ".", "#" ]
+          "triggerCharacters": [ ".", "#", ":" ]
         },
         "declarationProvider": true,
         "definitionProvider": true,