From 7b1f5be4d6d3566168f61ec8c7a07928ddb68885 Mon Sep 17 00:00:00 2001 From: Tom Ekander Date: Tue, 14 Oct 2025 12:02:28 +0800 Subject: [PATCH 1/6] construct auto-complete items --- ocaml-lsp-server/src/compl.ml | 56 +++++++++++++++++++++++- ocaml-lsp-server/src/ocaml_lsp_server.ml | 2 +- 2 files changed, 55 insertions(+), 3 deletions(-) diff --git a/ocaml-lsp-server/src/compl.ml b/ocaml-lsp-server/src/compl.ml index c5054ff2f..1bd3cc29a 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,22 @@ module Complete_with_construct = struct ;; end +(* Helper functions for type checking *) +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_relevant_for_argument_completion (item : CompletionItem.t) = + not (String.equal item.label "::" || String.equal item.label ":=") +;; + let complete (state : State.t) ({ textDocument = { uri }; position = pos; context; _ } : CompletionParams.t) @@ -316,7 +334,41 @@ 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-variant" + 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 irrelevant operators e.g. `::`, or `:=` *) + completions |> List.filter ~f:is_relevant_for_argument_completion + | _ -> 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:[ " "; "~"; "?"; ":"; "(" ] () From 12b612712d5e2e53def948af60bb9e4e52482e0c Mon Sep 17 00:00:00 2001 From: Tom Ekander Date: Tue, 14 Oct 2025 13:09:31 +0800 Subject: [PATCH 2/6] add test case --- ocaml-lsp-server/test/e2e-new/completion.ml | 143 ++++++++++++++++++++ 1 file changed, 143 insertions(+) diff --git a/ocaml-lsp-server/test/e2e-new/completion.ml b/ocaml-lsp-server/test/e2e-new/completion.ml index 5f2f874b3..c7399e217 100644 --- a/ocaml-lsp-server/test/e2e-new/completion.ml +++ b/ocaml-lsp-server/test/e2e-new/completion.ml @@ -1317,3 +1317,146 @@ 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 c = make_color ~color: +|ocaml} + in + print_completions 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 } + } + } + } + { + "detail": "color:color -> color", + "kind": 12, + "label": "make_color", + "sortText": "0004", + "textEdit": { + "newText": "make_color", + "range": { + "end": { "character": 26, "line": 5 }, + "start": { "character": 26, "line": 5 } + } + } + } + { + "detail": "'a ref -> 'a", + "kind": 12, + "label": "!", + "sortText": "0005", + "textEdit": { + "newText": "!", + "range": { + "end": { "character": 26, "line": 5 }, + "start": { "character": 26, "line": 5 } + } + } + } + { + "detail": "int -> 'a", + "kind": 12, + "label": "exit", + "sortText": "0006", + "textEdit": { + "newText": "exit", + "range": { + "end": { "character": 26, "line": 5 }, + "start": { "character": 26, "line": 5 } + } + } + } + { + "detail": "string -> 'a", + "kind": 12, + "label": "failwith", + "sortText": "0007", + "textEdit": { + "newText": "failwith", + "range": { + "end": { "character": 26, "line": 5 }, + "start": { "character": 26, "line": 5 } + } + } + } + { + "detail": "'a * 'b -> 'a", + "kind": 12, + "label": "fst", + "sortText": "0008", + "textEdit": { + "newText": "fst", + "range": { + "end": { "character": 26, "line": 5 }, + "start": { "character": 26, "line": 5 } + } + } + } + ............. + |}] +;; From 4221e0ee754876f5fbe2c2cd0b30c92768bf208e Mon Sep 17 00:00:00 2001 From: Tom Ekander Date: Tue, 14 Oct 2025 13:27:51 +0800 Subject: [PATCH 3/6] add test cases --- ocaml-lsp-server/test/e2e-new/completion.ml | 126 +++++++++----------- ocaml-lsp-server/test/e2e-new/start_stop.ml | 2 +- 2 files changed, 60 insertions(+), 68 deletions(-) diff --git a/ocaml-lsp-server/test/e2e-new/completion.ml b/ocaml-lsp-server/test/e2e-new/completion.ml index c7399e217..1e03753d3 100644 --- a/ocaml-lsp-server/test/e2e-new/completion.ml +++ b/ocaml-lsp-server/test/e2e-new/completion.ml @@ -1322,10 +1322,10 @@ 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 c = make_color ~color: +let _ = make_color ~color: |ocaml} in - print_completions source (Position.create ~line:5 ~character:26); + print_completions ~limit:5 source (Position.create ~line:5 ~character:26); [%expect {| Completions: @@ -1392,71 +1392,63 @@ let c = make_color ~color: } } } - { - "detail": "color:color -> color", - "kind": 12, - "label": "make_color", - "sortText": "0004", - "textEdit": { - "newText": "make_color", - "range": { - "end": { "character": 26, "line": 5 }, - "start": { "character": 26, "line": 5 } - } - } - } - { - "detail": "'a ref -> 'a", - "kind": 12, - "label": "!", - "sortText": "0005", - "textEdit": { - "newText": "!", - "range": { - "end": { "character": 26, "line": 5 }, - "start": { "character": 26, "line": 5 } - } - } - } - { - "detail": "int -> 'a", - "kind": 12, - "label": "exit", - "sortText": "0006", - "textEdit": { - "newText": "exit", - "range": { - "end": { "character": 26, "line": 5 }, - "start": { "character": 26, "line": 5 } - } - } - } - { - "detail": "string -> 'a", - "kind": 12, - "label": "failwith", - "sortText": "0007", - "textEdit": { - "newText": "failwith", - "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 } } - { - "detail": "'a * 'b -> 'a", - "kind": 12, - "label": "fst", - "sortText": "0008", - "textEdit": { - "newText": "fst", - "range": { - "end": { "character": 26, "line": 5 }, - "start": { "character": 26, "line": 5 } - } - } + } +} +{ + "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, From 1090b56547134651d25b3e631b435b5cb156a060 Mon Sep 17 00:00:00 2001 From: Tom Ekander Date: Tue, 14 Oct 2025 13:31:56 +0800 Subject: [PATCH 4/6] remove superfluous comment --- ocaml-lsp-server/src/compl.ml | 1 - 1 file changed, 1 deletion(-) diff --git a/ocaml-lsp-server/src/compl.ml b/ocaml-lsp-server/src/compl.ml index 1bd3cc29a..d9ac60e55 100644 --- a/ocaml-lsp-server/src/compl.ml +++ b/ocaml-lsp-server/src/compl.ml @@ -262,7 +262,6 @@ module Complete_with_construct = struct ;; end -(* Helper functions for type checking *) let is_polymorphic_type argument_type = String.is_prefix ~prefix:"'" argument_type ;; From f7c35546da426c8957024944295a0a12e14734e2 Mon Sep 17 00:00:00 2001 From: Tom Ekander Date: Wed, 15 Oct 2025 10:22:51 +0800 Subject: [PATCH 5/6] naming, match on all branches --- ocaml-lsp-server/src/compl.ml | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/ocaml-lsp-server/src/compl.ml b/ocaml-lsp-server/src/compl.ml index d9ac60e55..8d7aef9f4 100644 --- a/ocaml-lsp-server/src/compl.ml +++ b/ocaml-lsp-server/src/compl.ml @@ -345,7 +345,7 @@ let complete && not (is_primitive_type argument_type) -> let+ construct_response = Document.Merlin.with_pipeline_exn - ~name:"completion-construct-variant" + ~name:"completion-construct" merlin (fun pipeline -> Complete_with_construct.dispatch_cmd position pipeline) @@ -365,7 +365,8 @@ let complete | `Application _ -> (* When in application context try to filter out irrelevant operators e.g. `::`, or `:=` *) completions |> List.filter ~f:is_relevant_for_argument_completion - | _ -> completions + | `Unknown -> + completions in construct_completionItems @ prefix_completionItems) else ( From 78ed8812a4e00f48c6622511c6bbe9e3f0ab4091 Mon Sep 17 00:00:00 2001 From: Tom Ekander Date: Wed, 15 Oct 2025 15:01:10 +0800 Subject: [PATCH 6/6] function name --- ocaml-lsp-server/src/compl.ml | 19 +++++++++++++++---- 1 file changed, 15 insertions(+), 4 deletions(-) diff --git a/ocaml-lsp-server/src/compl.ml b/ocaml-lsp-server/src/compl.ml index 8d7aef9f4..eb04adbe4 100644 --- a/ocaml-lsp-server/src/compl.ml +++ b/ocaml-lsp-server/src/compl.ml @@ -273,8 +273,18 @@ let is_primitive_type argument_type = List.mem primitives argument_type ~equal:String.equal ;; -let is_relevant_for_argument_completion (item : CompletionItem.t) = - not (String.equal item.label "::" || String.equal item.label ":=") +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 @@ -363,8 +373,9 @@ let complete let prefix_completionItems = match context with | `Application _ -> - (* When in application context try to filter out irrelevant operators e.g. `::`, or `:=` *) - completions |> List.filter ~f:is_relevant_for_argument_completion + (* 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