diff --git a/ocaml-lsp-server/src/compl.ml b/ocaml-lsp-server/src/compl.ml index c5054ff2f..eb04adbe4 100644 --- a/ocaml-lsp-server/src/compl.ml +++ b/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) -> diff --git a/ocaml-lsp-server/src/ocaml_lsp_server.ml b/ocaml-lsp-server/src/ocaml_lsp_server.ml index ec7f8e119..ac0b90b5c 100644 --- a/ocaml-lsp-server/src/ocaml_lsp_server.ml +++ b/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:[ " "; "~"; "?"; ":"; "(" ] () diff --git a/ocaml-lsp-server/test/e2e-new/completion.ml b/ocaml-lsp-server/test/e2e-new/completion.ml index 5f2f874b3..1e03753d3 100644 --- a/ocaml-lsp-server/test/e2e-new/completion.ml +++ b/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 } + } + } +} +|}] +;; diff --git a/ocaml-lsp-server/test/e2e-new/start_stop.ml b/ocaml-lsp-server/test/e2e-new/start_stop.ml index f369cf4a1..dd181e663 100644 --- a/ocaml-lsp-server/test/e2e-new/start_stop.ml +++ b/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,