From 96376d132d133b98689b8389f96e9180cdbcad11 Mon Sep 17 00:00:00 2001 From: faldor20 Date: Mon, 18 Sep 2023 04:10:47 +1000 Subject: [PATCH 01/23] Tests passing --- ocaml-lsp-server/bench/dune | 16 ++ ocaml-lsp-server/bench/ocaml_lsp_bench.ml | 22 ++ ocaml-lsp-server/bench/run_bench.ml | 23 ++ ocaml-lsp-server/src/compl.ml | 101 ++++++++- ocaml-lsp-server/src/compl.mli | 4 + ocaml-lsp-server/src/ocaml_lsp_server.ml | 1 + ocaml-lsp-server/src/ocaml_lsp_server.mli | 2 + ocaml-lsp-server/src/prefix_parser.ml | 115 ++++++++++ ocaml-lsp-server/src/testing.ml | 5 + ocaml-lsp-server/src/testing.mli | 5 + ocaml-lsp-server/test/dune | 5 +- .../__tests__/textDocument-completion.test.ts | 210 +++++++++++++++++- .../test/position_prefix_tests.ml | 103 +++++++++ 13 files changed, 608 insertions(+), 4 deletions(-) create mode 100644 ocaml-lsp-server/bench/dune create mode 100644 ocaml-lsp-server/bench/ocaml_lsp_bench.ml create mode 100644 ocaml-lsp-server/bench/run_bench.ml create mode 100644 ocaml-lsp-server/src/prefix_parser.ml create mode 100644 ocaml-lsp-server/src/testing.ml create mode 100644 ocaml-lsp-server/src/testing.mli create mode 100644 ocaml-lsp-server/test/position_prefix_tests.ml diff --git a/ocaml-lsp-server/bench/dune b/ocaml-lsp-server/bench/dune new file mode 100644 index 000000000..12380aae7 --- /dev/null +++ b/ocaml-lsp-server/bench/dune @@ -0,0 +1,16 @@ + +(executables + (names ocaml_lsp_bench) + + (libraries + ocaml_lsp_server + core_unix.command_unix + merlin-lib.kernel + + base + core + core_bench + ) + + (preprocess(pps ppx_jane ppx_bench)) + ) diff --git a/ocaml-lsp-server/bench/ocaml_lsp_bench.ml b/ocaml-lsp-server/bench/ocaml_lsp_bench.ml new file mode 100644 index 000000000..544ba675f --- /dev/null +++ b/ocaml-lsp-server/bench/ocaml_lsp_bench.ml @@ -0,0 +1,22 @@ +open Core +open Core_bench +open Ocaml_lsp_server.Testing + +let () = + let document = + "let mem = ListLabels.mem\n\nlet _ = mem ~se" |> Merlin_kernel.Msource.make + in + + let position = `Logical (3, 15) in + Command_unix.run + (Bench.make_command + [ Bench.Test.create ~name:"non-regex" (fun _ -> + Compl.prefix_of_position ~short_path:false document position + |> ignore) + ; Bench.Test.create ~name:"regex" (fun _ -> + Compl.prefix_of_position_regex ~short_path:false document position + |> ignore) + ; Bench.Test.create ~name:"old" (fun _ -> + Compl.prefix_of_position_old ~short_path:false document position + |> ignore) + ]) diff --git a/ocaml-lsp-server/bench/run_bench.ml b/ocaml-lsp-server/bench/run_bench.ml new file mode 100644 index 000000000..b7e6fec47 --- /dev/null +++ b/ocaml-lsp-server/bench/run_bench.ml @@ -0,0 +1,23 @@ +open Core +open Core_bench +open Ocaml_lsp_server.Testing + +let () = + let document = + "let mem = ListLabels.mem\n\nlet _ = mem ~se" |> Merlin_kernel.Msource.make + in + + let position = `Logical (3, 15) in + Command.summary + (Bench.make_command + [ Bench.Test.create ~name:"non-regex" (fun _ -> + Compl.prefix_of_position ~short_path:false document position + |> ignore) + ; Bench.Test.create ~name:"regex" (fun _ -> + Compl.prefix_of_position_regex ~short_path:false document position + |> ignore) + ; Bench.Test.create ~name:"old" (fun _ -> + Compl.prefix_of_position_old ~short_path:false document position + |> ignore) + ]) + |> ignore diff --git a/ocaml-lsp-server/src/compl.ml b/ocaml-lsp-server/src/compl.ml index 9e4aa320c..168510937 100644 --- a/ocaml-lsp-server/src/compl.ml +++ b/ocaml-lsp-server/src/compl.ml @@ -26,8 +26,16 @@ let completion_kind kind : CompletionItemKind.t option = | `Constructor -> Some Constructor | `Type -> Some TypeParameter -(** @see reference *) -let prefix_of_position ~short_path source position = +(* I should just rewrite all of this so that it uses a nice for loop. This + current soluction is a nice try but overall crap we need to be able to look + ahead and behind + + Split it into name and infix name is obvious infix can be either a dot, a + label or an I could possibly do a regex based parser. + + Name regex: ((\w)|\w.)*$ *) + +let prefix_of_position_old ~short_path source position = match Msource.text source with | "" -> "" | text -> @@ -95,6 +103,80 @@ let prefix_of_position ~short_path source position = | None -> reconstructed_prefix else reconstructed_prefix +let prefix_of_position_parser ~short_path source position = + let open Prefix_parser in + match Msource.text source with + | "" -> "" + | text -> + let end_of_prefix = + let (`Offset index) = Msource.get_offset source position in + min (String.length text - 1) (index - 1) + in + (*TODO this is a mess and could be a lot faster*) + let prefix_text = + String.sub text ~pos:0 ~len:(end_of_prefix + 1) + |> String.to_seq |> List.of_seq |> List.rev + in + + (*Printf.printf "trying to parse text `%s`\n" + (prefix_text|>String.of_list);*) + let prefix_length = + match prefix_text with + | c :: next_char :: _ when c |> is_name_char ~next_char -> + (*Printf.printf "trying to parse as name or label";*) + prefix_text |> try_parse [ name_prefix ] + | x -> + (*Printf.printf "trying to parse as infix";*) + x |> try_parse [ infix_prefix ] + in + + let len = + match prefix_length with + | None -> 0 + | Some len -> len + in + let pos = end_of_prefix - len + 1 in + let reconstructed_prefix = String.sub text ~pos ~len in + if short_path then + match String.split_on_char reconstructed_prefix ~sep:'.'|> List.last with + | Some (s) -> s + | None -> reconstructed_prefix + else reconstructed_prefix + +let prefix_of_position ~short_path source position = + + let open Prefix_parser in + match Msource.text source with + | "" -> "" + | text -> + let end_of_prefix = + let (`Offset index) = Msource.get_offset source position in + min (String.length text - 1) (index - 1) + in + let prefix_text = + (*We do prevent completion from working across multiple lines here. But + this is probably an okay aproximation. We could add the the regex or + parser the fact that whitespace doesn't really matter in certain cases + like "List. map"*) + let pos = + text + |> String.rfindi ~from:end_of_prefix ~f:(( = ) '\n') + |> Option.value ~default:0 + in + String.sub text ~pos ~len:(end_of_prefix + 1 - pos) + in + + (*Printf.printf "trying to parse text `%s`\n" + (prefix_text|>String.of_list);*) + let reconstructed_prefix = + try_parse_regex prefix_text |> Option.value ~default:"" + in + if short_path then + match String.split_on_char reconstructed_prefix ~sep:'.'|> List.last with + | Some (s) -> s + | None -> reconstructed_prefix + else reconstructed_prefix + (** [suffix_of_position source position] computes the suffix of the identifier after [position]. *) let suffix_of_position source position = @@ -260,8 +342,12 @@ module Complete_with_construct = struct List.mapi constructed_exprs ~f:completionItem_of_constructed_expr end +let logCompletion log = + Log.log ~section:"resolveCompletion" (fun () -> Log.msg log []) + let complete (state : State.t) ({ textDocument = { uri }; position = pos; _ } : CompletionParams.t) = + logCompletion "ho1"; Fiber.of_thunk (fun () -> let doc = Document_store.get state.store uri in match Document.kind doc with @@ -296,6 +382,12 @@ let complete (state : State.t) let* item = completion_item_capability in item.deprecatedSupport) in + logCompletion + (Printf.sprintf + "prefix: %s; position %i:%i" + prefix + pos.line + pos.character); if not (Typed_hole.can_be_hole prefix) then Complete_by_prefix.complete merlin prefix pos ~resolve ~deprecated else @@ -365,10 +457,12 @@ let format_doc ~markdown doc = let resolve doc (compl : CompletionItem.t) (resolve : Resolve.t) query_doc ~markdown = + logCompletion "Starting completion"; Fiber.of_thunk (fun () -> (* Due to merlin's API, we create a version of the given document with the applied completion item and pass it to merlin to get the docs for the [compl.label] *) + logCompletion "Starting completion"; let position : Position.t = resolve.position in let logical_position = Position.logical position in let doc = @@ -380,6 +474,7 @@ let resolve doc (compl : CompletionItem.t) (resolve : Resolve.t) query_doc (Document.Merlin.source doc) logical_position in + logCompletion @@ "completion prefix is:" ^ prefix; { position with character = position.character - String.length prefix } @@ -392,7 +487,9 @@ let resolve doc (compl : CompletionItem.t) (resolve : Resolve.t) query_doc character = position.character + String.length suffix } in + let range = Range.create ~start ~end_ in + TextDocumentContentChangeEvent.create ~range ~text:compl.label () in Document.update_text (Document.Merlin.to_doc doc) [ complete ] diff --git a/ocaml-lsp-server/src/compl.mli b/ocaml-lsp-server/src/compl.mli index 8d094e9ca..8c3e49d68 100644 --- a/ocaml-lsp-server/src/compl.mli +++ b/ocaml-lsp-server/src/compl.mli @@ -34,6 +34,10 @@ val resolve : [List.m] returns ["m"] when [short_path] is set vs ["List.m"] when not. @return prefix of [position] in [source] and its length *) +val prefix_of_position_parser : + short_path:bool -> Msource.t -> [< Msource.position ] -> string +val prefix_of_position_old : + short_path:bool -> Msource.t -> [< Msource.position ] -> string val prefix_of_position : short_path:bool -> Msource.t -> [< Msource.position ] -> string diff --git a/ocaml-lsp-server/src/ocaml_lsp_server.ml b/ocaml-lsp-server/src/ocaml_lsp_server.ml index 6d0793608..613a2e1fd 100644 --- a/ocaml-lsp-server/src/ocaml_lsp_server.ml +++ b/ocaml-lsp-server/src/ocaml_lsp_server.ml @@ -3,6 +3,7 @@ module Version = Version module Diagnostics = Diagnostics module Doc_to_md = Doc_to_md module Diff = Diff +module Testing=Testing open Fiber.O let make_error = Jsonrpc.Response.Error.make diff --git a/ocaml-lsp-server/src/ocaml_lsp_server.mli b/ocaml-lsp-server/src/ocaml_lsp_server.mli index 10db38edd..d9d567ad5 100644 --- a/ocaml-lsp-server/src/ocaml_lsp_server.mli +++ b/ocaml-lsp-server/src/ocaml_lsp_server.mli @@ -3,3 +3,5 @@ val run : Lsp.Cli.Channel.t -> read_dot_merlin:bool -> unit -> unit module Diagnostics = Diagnostics module Version = Version module Doc_to_md = Doc_to_md + +module Testing=Testing \ No newline at end of file diff --git a/ocaml-lsp-server/src/prefix_parser.ml b/ocaml-lsp-server/src/prefix_parser.ml new file mode 100644 index 000000000..24a1c73e0 --- /dev/null +++ b/ocaml-lsp-server/src/prefix_parser.ml @@ -0,0 +1,115 @@ +type parse_state = + | Continue + | End + | IncludeAndEnd + | Fail + +let next continue = if continue then Continue else End + +let is_name_body_char char = + match char with + | '0' .. '9' | '\'' | '_' | 'a' .. 'z' | 'A' .. 'Z' -> true + | _ -> false + +let parse_name_char ~next_char currentChar = + match currentChar with + | '.' -> next_char |> is_name_body_char |> next + | '`' -> IncludeAndEnd + | '~' | '?' -> + if next_char |> is_name_body_char || next_char = ' ' then IncludeAndEnd + else End + | c -> c |> is_name_body_char |> next + +let is_name_char ~next_char currentChar = + match parse_name_char ~next_char currentChar with + | IncludeAndEnd | Continue -> true + | Fail | End -> false + +let is_infix_char' char = + match char with + | '~' + | '?' + | ':' + | '!' + | '$' + | '&' + | '*' + | '+' + | '-' + | '/' + | '=' + | '>' + | '@' + | '^' + | '|' + | '%' + | '<' + | '.' + | '#' -> true + | _ -> false + +let parse_infix_char ~next_char:_ char = is_infix_char' char |> next + +let parse_char is_correct_char text = + let rec loop text length = + match text with + | char :: (next_char :: _ as tail) -> ( + match is_correct_char ~next_char char with + | Continue -> loop tail (length + 1) + | IncludeAndEnd -> Some (length + 1) + | End -> Some length + | Fail -> None) + (*This is ugly but i'm not sure how else to deal with reaching the start of + the string*) + | [ char ] -> ( + match is_correct_char ~next_char:' ' char with + | Continue -> Some (length + 1) + | IncludeAndEnd -> Some (length + 1) + | End -> Some length + | Fail -> None) + | _ -> Some length + in + let len = loop text 0 in + Option.bind len (fun x -> if x = 0 then None else Some x) + +let infix_prefix text = + if text |> List.hd |> is_infix_char' && List.nth text 1 |> is_infix_char' then + None + else parse_char parse_infix_char text + +let name_prefix = parse_char parse_name_char + +let rec try_parse parsers str = + match parsers with + | head :: tail -> ( + match head str with + | Some l -> Some l + | None -> str |> try_parse tail) + | [] -> None +open Re + +(*Regex based parser*) + +let name_or_label_regex = + Re.compile @@ Re.Posix.re {|([~?`])?([a-zA-Z0-9_']|[a-zA-Z0-9_']\.)+$|} + +let infixRegex =Re.compile @@ Re.Posix.re {|[~?:!$&*+\-\/=><@^|%<.#]+$|} + +open Import + +module Option = struct + include Option + + let none_bind func option = + match option with + | None -> func () + | Some x -> Some x +end + +let try_parse_regex text = + + let matched = + Re.exec_opt name_or_label_regex text + |> Option.none_bind (fun () -> Re.exec_opt infixRegex text) + in + matched |>Option.map ~f:(fun x->Group.get x 0) diff --git a/ocaml-lsp-server/src/testing.ml b/ocaml-lsp-server/src/testing.ml new file mode 100644 index 000000000..f49f3e75a --- /dev/null +++ b/ocaml-lsp-server/src/testing.ml @@ -0,0 +1,5 @@ +module Compl=Compl +module Document =Document +module Import =Import +module Merlin_kernel =Merlin_kernel +module Position =Position \ No newline at end of file diff --git a/ocaml-lsp-server/src/testing.mli b/ocaml-lsp-server/src/testing.mli new file mode 100644 index 000000000..f49f3e75a --- /dev/null +++ b/ocaml-lsp-server/src/testing.mli @@ -0,0 +1,5 @@ +module Compl=Compl +module Document =Document +module Import =Import +module Merlin_kernel =Merlin_kernel +module Position =Position \ No newline at end of file diff --git a/ocaml-lsp-server/test/dune b/ocaml-lsp-server/test/dune index 9eb6a25ab..adc8cb7d6 100644 --- a/ocaml-lsp-server/test/dune +++ b/ocaml-lsp-server/test/dune @@ -1,7 +1,8 @@ (dirs :standard \ e2e) (library - (modules ocaml_lsp_tests) + + (modules ocaml_lsp_tests position_prefix_tests) (name ocaml_lsp_tests) (enabled_if (>= %{ocaml_version} 4.08)) @@ -9,6 +10,8 @@ (libraries stdune ocaml_lsp_server + merlin-lib.kernel + lsp yojson ;; This is because of the (implicit_transitive_deps false) diff --git a/ocaml-lsp-server/test/e2e/__tests__/textDocument-completion.test.ts b/ocaml-lsp-server/test/e2e/__tests__/textDocument-completion.test.ts index f1ab58d79..dc88d07be 100644 --- a/ocaml-lsp-server/test/e2e/__tests__/textDocument-completion.test.ts +++ b/ocaml-lsp-server/test/e2e/__tests__/textDocument-completion.test.ts @@ -91,7 +91,215 @@ describe_opt("textDocument/completion", () => { expect(items).toMatchObject([{ label: "StringLabels" }]); }); - it("can complete symbol passed as a named argument", async () => { + it("can start completion after operator with space", async () => { + openDocument(outdent` +[1;2] |> List.ma + `); + + let items = await queryCompletion(Types.Position.create(0, 16)); + expect(items).toMatchInlineSnapshot(` + Array [ + Object { + "label": "map", + "textEdit": Object { + "newText": "map", + "range": Object { + "end": Object { + "character": 16, + "line": 0, + }, + "start": Object { + "character": 14, + "line": 0, + }, + }, + }, + }, + Object { + "label": "mapi", + "textEdit": Object { + "newText": "mapi", + "range": Object { + "end": Object { + "character": 16, + "line": 0, + }, + "start": Object { + "character": 14, + "line": 0, + }, + }, + }, + }, + Object { + "label": "map2", + "textEdit": Object { + "newText": "map2", + "range": Object { + "end": Object { + "character": 16, + "line": 0, + }, + "start": Object { + "character": 14, + "line": 0, + }, + }, + }, + }, + ] + `); + }); + it("can start completion after operator without space", async () => { + openDocument(outdent` +[1;2]|>List.ma + `); + + let items = await queryCompletion(Types.Position.create(0, 14)); + expect(items).toMatchInlineSnapshot(` + Array [ + Object { + "label": "map", + "textEdit": Object { + "newText": "map", + "range": Object { + "end": Object { + "character": 14, + "line": 0, + }, + "start": Object { + "character": 12, + "line": 0, + }, + }, + }, + }, + Object { + "label": "mapi", + "textEdit": Object { + "newText": "mapi", + "range": Object { + "end": Object { + "character": 14, + "line": 0, + }, + "start": Object { + "character": 12, + "line": 0, + }, + }, + }, + }, + Object { + "label": "map2", + "textEdit": Object { + "newText": "map2", + "range": Object { + "end": Object { + "character": 14, + "line": 0, + }, + "start": Object { + "character": 12, + "line": 0, + }, + }, + }, + }, + ] + `); + + }); + + it("can start completion after operator with space", async () => { + openDocument(outdent` +[1;2] |> List.ma + `); + + let items = await queryCompletion(Types.Position.create(0, 16)); + expect(items).toMatchInlineSnapshot(` + Array [ + Object { + "label": "map", + "textEdit": Object { + "newText": "map", + "range": Object { + "end": Object { + "character": 16, + "line": 0, + }, + "start": Object { + "character": 14, + "line": 0, + }, + }, + }, + }, + Object { + "label": "mapi", + "textEdit": Object { + "newText": "mapi", + "range": Object { + "end": Object { + "character": 16, + "line": 0, + }, + "start": Object { + "character": 14, + "line": 0, + }, + }, + }, + }, + Object { + "label": "map2", + "textEdit": Object { + "newText": "map2", + "range": Object { + "end": Object { + "character": 16, + "line": 0, + }, + "start": Object { + "character": 14, + "line": 0, + }, + }, + }, + }, + ] + `); + }); + it("can start completion after dereference", async () => { + openDocument(outdent` +let apple=ref 10 in +!ap + `); + + let items = await queryCompletion(Types.Position.create(1, 3)); + expect(items).toMatchInlineSnapshot(` + Array [ + Object { + "label": "apple", + "textEdit": Object { + "newText": "apple", + "range": Object { + "end": Object { + "character": 3, + "line": 1, + }, + "start": Object { + "character": 1, + "line": 1, + }, + }, + }, + }, + ] + `); + + }); + it("can complete symbol passed as a named argument", async () => { openDocument(outdent` let g ~f = f 0 in g ~f:ig diff --git a/ocaml-lsp-server/test/position_prefix_tests.ml b/ocaml-lsp-server/test/position_prefix_tests.ml new file mode 100644 index 000000000..6c7a16970 --- /dev/null +++ b/ocaml-lsp-server/test/position_prefix_tests.ml @@ -0,0 +1,103 @@ +open Ocaml_lsp_server +open Testing +open! Import + +let%expect_test "varible in labelled pararm" = + let document = + "let map = ListLabels.map\n\nlet _ = map ~f:Int.abs\n" + |> Testing.Merlin_kernel.Msource.make + in + + let position = `Logical (3, 22) in + let prefix = Compl.prefix_of_position ~short_path:false document position in + + print_endline prefix; + [%expect "Int.abs"] +;; + +let%expect_test "labelled pararm" = + let document = + "let mem = ListLabels.mem\n\nlet _ = mem ~se" + |> Testing.Merlin_kernel.Msource.make + in + + let position = `Logical (3, 15) in + let prefix = Compl.prefix_of_position ~short_path:false document position in + + Printf.printf "prefix:'%s' " prefix; + [%expect "prefix:'~se'"] +;; + +let%expect_test "correctly handle typed hole for code action" = + let document = + "let x = _" + |> Testing.Merlin_kernel.Msource.make + in + let position = `Logical (1, 9) in + let prefix = Compl.prefix_of_position ~short_path:false document position in + + Printf.printf "prefix:'%s' " prefix; + [%expect "prefix:'_'"] +;; + +let%expect_test "complete at infix" = + let document = + "let x = 1|>." + |> Testing.Merlin_kernel.Msource.make + in + let position = `Logical (1, 11) in + let prefix = Compl.prefix_of_position ~short_path:false document position in + + Printf.printf "prefix:'%s' " prefix; + [%expect "prefix:'|>'"] +;; + +let%expect_test "complete at arbitrary position" = + let document = + "Strin.func" + |> Testing.Merlin_kernel.Msource.make + in + let position = `Logical (1, 5) in + let prefix = Compl.prefix_of_position ~short_path:false document position in + (*let prefix_old = Compl.prefix_of_position_old ~short_path:false document position in*) + + Printf.printf "prefix:'%s' " prefix; + (*Printf.printf "prefix_old:'%s' " prefix_old;*) + [%expect "prefix:'Strin'"] +;; + +let%expect_test "completion prefix multiple dots test" = + let document = "[1;2]|>Core.List.ma\n" |> Testing.Merlin_kernel.Msource.make in + let position = `Logical (1, 19) in + let prefix = Compl.prefix_of_position ~short_path:false document position in + print_endline prefix; + [%expect "Core.List.ma"] + +let%expect_test "completion prefix touching infix test" = + let document = "[1;2]|>List.ma\n" |> Testing.Merlin_kernel.Msource.make in + let position = `Logical (1, 14) in + let prefix = Compl.prefix_of_position ~short_path:false document position in + print_endline prefix; + [%expect "List.ma"] + +let%expect_test "completion prefix dot infix test" = + let document = "[1;2]|>.List.ma\n" |> Testing.Merlin_kernel.Msource.make in + let position = `Logical (1, 15) in + let prefix = Compl.prefix_of_position ~short_path:false document position in + print_endline prefix; + [%expect "List.ma"] + +let%expect_test "completion prefix with space test" = + let document = "[1;2] |> List.ma\n" |> Testing.Merlin_kernel.Msource.make in + let position = `Logical (1, 16) in + let prefix = Compl.prefix_of_position ~short_path:false document position in + print_endline prefix; + [%expect "List.ma"] + +let%expect_test "short path prefix" = + let document = "[1;2] |> Core.List.ma\n" |> Testing.Merlin_kernel.Msource.make in + let position = `Logical (1, 22) in + let prefix = Compl.prefix_of_position ~short_path:true document position in + print_endline prefix; + [%expect "ma"] + From 9bb112a4067c9a8a1cb8c53fd52edd08411d197f Mon Sep 17 00:00:00 2001 From: faldor20 Date: Mon, 18 Sep 2023 18:35:22 +1000 Subject: [PATCH 02/23] Added support for whitespace in completion The solution here is to change all whitespace to spaces for ease of regex matching(all whitespace is equivelent semantically) and then remove all spaces from the prefix that's passed to merlin. --- ocaml-lsp-server/bench/ocaml_lsp_bench.ml | 22 ++- ocaml-lsp-server/bench/run_bench.ml | 20 +- ocaml-lsp-server/src/compl.ml | 21 +- ocaml-lsp-server/src/prefix_parser.ml | 9 +- .../__tests__/textDocument-completion.test.ts | 183 +++++++++++++++++- .../test/position_prefix_tests.ml | 14 ++ 6 files changed, 248 insertions(+), 21 deletions(-) diff --git a/ocaml-lsp-server/bench/ocaml_lsp_bench.ml b/ocaml-lsp-server/bench/ocaml_lsp_bench.ml index 544ba675f..3b3aed47f 100644 --- a/ocaml-lsp-server/bench/ocaml_lsp_bench.ml +++ b/ocaml-lsp-server/bench/ocaml_lsp_bench.ml @@ -5,16 +5,30 @@ open Ocaml_lsp_server.Testing let () = let document = "let mem = ListLabels.mem\n\nlet _ = mem ~se" |> Merlin_kernel.Msource.make + in + let long_document = + " + arosietnaorisetnoarisent + arsotienarositen + arsotinarsotienarst + ast. rienrst .rst + !@#&984@#$ <><|||>> + aoris noarisetnaoiresnt aorisent aoierns + let b a= 5234 n oienar. rsoien . iri i... r + let mem = ListLabels.mem\n\nlet _ = mem ~se" |> Merlin_kernel.Msource.make in let position = `Logical (3, 15) in - Command_unix.run + Command_unix.run (Bench.make_command - [ Bench.Test.create ~name:"non-regex" (fun _ -> + [ Bench.Test.create ~name:"regex" (fun _ -> Compl.prefix_of_position ~short_path:false document position |> ignore) - ; Bench.Test.create ~name:"regex" (fun _ -> - Compl.prefix_of_position_regex ~short_path:false document position + ; Bench.Test.create ~name:"parser" (fun _ -> + Compl.prefix_of_position_parser ~short_path:false document position + |> ignore) + ; Bench.Test.create ~name:"regex_long" (fun _ -> + Compl.prefix_of_position ~short_path:false long_document position |> ignore) ; Bench.Test.create ~name:"old" (fun _ -> Compl.prefix_of_position_old ~short_path:false document position diff --git a/ocaml-lsp-server/bench/run_bench.ml b/ocaml-lsp-server/bench/run_bench.ml index b7e6fec47..28deac118 100644 --- a/ocaml-lsp-server/bench/run_bench.ml +++ b/ocaml-lsp-server/bench/run_bench.ml @@ -5,16 +5,30 @@ open Ocaml_lsp_server.Testing let () = let document = "let mem = ListLabels.mem\n\nlet _ = mem ~se" |> Merlin_kernel.Msource.make + in + let long_document = + " + arosietnaorisetnoarisent + arsotienarositen + arsotinarsotienarst + ast. rienrst .rst + !@#&984@#$ <><|||>> + aoris noarisetnaoiresnt aorisent aoierns + let b a= 5234 n oienar. rsoien . iri i... r + let mem = ListLabels.mem\n\nlet _ = mem ~se" |> Merlin_kernel.Msource.make in let position = `Logical (3, 15) in Command.summary (Bench.make_command - [ Bench.Test.create ~name:"non-regex" (fun _ -> + [ Bench.Test.create ~name:"regex" (fun _ -> Compl.prefix_of_position ~short_path:false document position |> ignore) - ; Bench.Test.create ~name:"regex" (fun _ -> - Compl.prefix_of_position_regex ~short_path:false document position + ; Bench.Test.create ~name:"parser" (fun _ -> + Compl.prefix_of_position_parser ~short_path:false document position + |> ignore) + ; Bench.Test.create ~name:"regex_long" (fun _ -> + Compl.prefix_of_position ~short_path:false long_document position |> ignore) ; Bench.Test.create ~name:"old" (fun _ -> Compl.prefix_of_position_old ~short_path:false document position diff --git a/ocaml-lsp-server/src/compl.ml b/ocaml-lsp-server/src/compl.ml index 168510937..1626f66d5 100644 --- a/ocaml-lsp-server/src/compl.ml +++ b/ocaml-lsp-server/src/compl.ml @@ -138,13 +138,12 @@ let prefix_of_position_parser ~short_path source position = let pos = end_of_prefix - len + 1 in let reconstructed_prefix = String.sub text ~pos ~len in if short_path then - match String.split_on_char reconstructed_prefix ~sep:'.'|> List.last with - | Some (s) -> s + match String.split_on_char reconstructed_prefix ~sep:'.' |> List.last with + | Some s -> s | None -> reconstructed_prefix else reconstructed_prefix let prefix_of_position ~short_path source position = - let open Prefix_parser in match Msource.text source with | "" -> "" @@ -159,21 +158,25 @@ let prefix_of_position ~short_path source position = parser the fact that whitespace doesn't really matter in certain cases like "List. map"*) let pos = - text - |> String.rfindi ~from:end_of_prefix ~f:(( = ) '\n') - |> Option.value ~default:0 + (* text |> String.rfindi ~from:end_of_prefix ~f:(( = ) '\n') |> + Option.value ~default:0 *) + + (*clamp the length of a line to process at 500 chars*) + max 0 (end_of_prefix - 500) in String.sub text ~pos ~len:(end_of_prefix + 1 - pos) + |> String.map ~f:(fun x -> if x = '\n'||x='\t' then ' ' else x) in (*Printf.printf "trying to parse text `%s`\n" (prefix_text|>String.of_list);*) let reconstructed_prefix = - try_parse_regex prefix_text |> Option.value ~default:"" + try_parse_regex prefix_text |> Option.value ~default:"" |>String.filter_map ~f:(fun x-> if x=' ' then None else Some x ) + in if short_path then - match String.split_on_char reconstructed_prefix ~sep:'.'|> List.last with - | Some (s) -> s + match String.split_on_char reconstructed_prefix ~sep:'.' |> List.last with + | Some s -> s | None -> reconstructed_prefix else reconstructed_prefix diff --git a/ocaml-lsp-server/src/prefix_parser.ml b/ocaml-lsp-server/src/prefix_parser.ml index 24a1c73e0..4fc3062d1 100644 --- a/ocaml-lsp-server/src/prefix_parser.ml +++ b/ocaml-lsp-server/src/prefix_parser.ml @@ -86,14 +86,16 @@ let rec try_parse parsers str = | Some l -> Some l | None -> str |> try_parse tail) | [] -> None + open Re (*Regex based parser*) let name_or_label_regex = - Re.compile @@ Re.Posix.re {|([~?`])?([a-zA-Z0-9_']|[a-zA-Z0-9_']\.)+$|} + Re.compile @@ Re. + Posix. re {|([~?`])?([a-zA-Z0-9_']|[a-zA-Z0-9_']\.( )*)+$|} -let infixRegex =Re.compile @@ Re.Posix.re {|[~?:!$&*+\-\/=><@^|%<.#]+$|} +let infixRegex = Re.compile @@ Re.Posix.re {|[~?:!$&*+\-\/=><@^|%<.#]+$|} open Import @@ -107,9 +109,8 @@ module Option = struct end let try_parse_regex text = - let matched = Re.exec_opt name_or_label_regex text |> Option.none_bind (fun () -> Re.exec_opt infixRegex text) in - matched |>Option.map ~f:(fun x->Group.get x 0) + matched |> Option.map ~f:(fun x -> Group.get x 0) diff --git a/ocaml-lsp-server/test/e2e/__tests__/textDocument-completion.test.ts b/ocaml-lsp-server/test/e2e/__tests__/textDocument-completion.test.ts index dc88d07be..ff8f1a3e5 100644 --- a/ocaml-lsp-server/test/e2e/__tests__/textDocument-completion.test.ts +++ b/ocaml-lsp-server/test/e2e/__tests__/textDocument-completion.test.ts @@ -270,6 +270,187 @@ describe_opt("textDocument/completion", () => { ] `); }); + + + it("can start completion in dot chain with newline", async () => { + openDocument(outdent` +[1;2] |> List. +ma + `); + + let items = await queryCompletion(Types.Position.create(1, 2)); + expect(items).toMatchInlineSnapshot(` + Array [ + Object { + "label": "map", + "textEdit": Object { + "newText": "map", + "range": Object { + "end": Object { + "character": 2, + "line": 1, + }, + "start": Object { + "character": 0, + "line": 1, + }, + }, + }, + }, + Object { + "label": "mapi", + "textEdit": Object { + "newText": "mapi", + "range": Object { + "end": Object { + "character": 2, + "line": 1, + }, + "start": Object { + "character": 0, + "line": 1, + }, + }, + }, + }, + Object { + "label": "map2", + "textEdit": Object { + "newText": "map2", + "range": Object { + "end": Object { + "character": 2, + "line": 1, + }, + "start": Object { + "character": 0, + "line": 1, + }, + }, + }, + }, + ] + `); + }); + it("can start completion in dot chain with tab", async () => { + openDocument(outdent` +[1;2] |> List. ma + `); + + let items = await queryCompletion(Types.Position.create(0, 17)); + expect(items).toMatchInlineSnapshot(` + Array [ + Object { + "label": "map", + "textEdit": Object { + "newText": "map", + "range": Object { + "end": Object { + "character": 17, + "line": 0, + }, + "start": Object { + "character": 15, + "line": 0, + }, + }, + }, + }, + Object { + "label": "mapi", + "textEdit": Object { + "newText": "mapi", + "range": Object { + "end": Object { + "character": 17, + "line": 0, + }, + "start": Object { + "character": 15, + "line": 0, + }, + }, + }, + }, + Object { + "label": "map2", + "textEdit": Object { + "newText": "map2", + "range": Object { + "end": Object { + "character": 17, + "line": 0, + }, + "start": Object { + "character": 15, + "line": 0, + }, + }, + }, + }, + ] + `); + }); + it("can start completion in dot chain with space", async () => { + openDocument(outdent` +[1;2] |> List. ma + `); + + let items = await queryCompletion(Types.Position.create(0, 17)); + expect(items).toMatchInlineSnapshot(` + Array [ + Object { + "label": "map", + "textEdit": Object { + "newText": "map", + "range": Object { + "end": Object { + "character": 17, + "line": 0, + }, + "start": Object { + "character": 15, + "line": 0, + }, + }, + }, + }, + Object { + "label": "mapi", + "textEdit": Object { + "newText": "mapi", + "range": Object { + "end": Object { + "character": 17, + "line": 0, + }, + "start": Object { + "character": 15, + "line": 0, + }, + }, + }, + }, + Object { + "label": "map2", + "textEdit": Object { + "newText": "map2", + "range": Object { + "end": Object { + "character": 17, + "line": 0, + }, + "start": Object { + "character": 15, + "line": 0, + }, + }, + }, + }, + ] + `); + }); + it("can start completion after dereference", async () => { openDocument(outdent` let apple=ref 10 in @@ -299,7 +480,7 @@ let apple=ref 10 in `); }); - it("can complete symbol passed as a named argument", async () => { + it("can complete symbol passed as a named argument", async () => { openDocument(outdent` let g ~f = f 0 in g ~f:ig diff --git a/ocaml-lsp-server/test/position_prefix_tests.ml b/ocaml-lsp-server/test/position_prefix_tests.ml index 6c7a16970..281a99cc6 100644 --- a/ocaml-lsp-server/test/position_prefix_tests.ml +++ b/ocaml-lsp-server/test/position_prefix_tests.ml @@ -101,3 +101,17 @@ let%expect_test "short path prefix" = print_endline prefix; [%expect "ma"] +let%expect_test "Space in dot chain" = + let document = "[1;2] |> Core. List. ma\n" |> Testing.Merlin_kernel.Msource.make in + let position = `Logical (1, 23) in + let prefix = Compl.prefix_of_position ~short_path:false document position in + print_endline prefix; + [%expect "Core.List.ma"] + +let%expect_test "newline in dot chain" = + let document = "[1;2] |> Core.\nList.\nma\n" |> Testing.Merlin_kernel.Msource.make in + let position = `Logical (3, 2) in + let prefix = Compl.prefix_of_position ~short_path:false document position in + print_endline prefix; + [%expect "Core.List.ma"] + From 0b1920e229f4a1eadf76898f49baba9b37b33494 Mon Sep 17 00:00:00 2001 From: faldor20 Date: Mon, 18 Sep 2023 18:46:08 +1000 Subject: [PATCH 03/23] Addded ability to have whitespace before or after the dot and test. --- ocaml-lsp-server/src/prefix_parser.ml | 3 +- .../test/position_prefix_tests.ml | 57 +++++++++---------- 2 files changed, 27 insertions(+), 33 deletions(-) diff --git a/ocaml-lsp-server/src/prefix_parser.ml b/ocaml-lsp-server/src/prefix_parser.ml index 4fc3062d1..c315b4249 100644 --- a/ocaml-lsp-server/src/prefix_parser.ml +++ b/ocaml-lsp-server/src/prefix_parser.ml @@ -92,8 +92,7 @@ open Re (*Regex based parser*) let name_or_label_regex = - Re.compile @@ Re. - Posix. re {|([~?`])?([a-zA-Z0-9_']|[a-zA-Z0-9_']\.( )*)+$|} + Re.compile @@ Re.Posix.re {|([~?`])?([a-zA-Z0-9_']|[a-zA-Z0-9_'] *\. *)+$|} let infixRegex = Re.compile @@ Re.Posix.re {|[~?:!$&*+\-\/=><@^|%<.#]+$|} diff --git a/ocaml-lsp-server/test/position_prefix_tests.ml b/ocaml-lsp-server/test/position_prefix_tests.ml index 281a99cc6..c84d1c91e 100644 --- a/ocaml-lsp-server/test/position_prefix_tests.ml +++ b/ocaml-lsp-server/test/position_prefix_tests.ml @@ -7,13 +7,12 @@ let%expect_test "varible in labelled pararm" = "let map = ListLabels.map\n\nlet _ = map ~f:Int.abs\n" |> Testing.Merlin_kernel.Msource.make in - + let position = `Logical (3, 22) in let prefix = Compl.prefix_of_position ~short_path:false document position in - + print_endline prefix; [%expect "Int.abs"] -;; let%expect_test "labelled pararm" = let document = @@ -23,51 +22,41 @@ let%expect_test "labelled pararm" = let position = `Logical (3, 15) in let prefix = Compl.prefix_of_position ~short_path:false document position in - + Printf.printf "prefix:'%s' " prefix; [%expect "prefix:'~se'"] -;; let%expect_test "correctly handle typed hole for code action" = - let document = - "let x = _" - |> Testing.Merlin_kernel.Msource.make - in + let document = "let x = _" |> Testing.Merlin_kernel.Msource.make in let position = `Logical (1, 9) in let prefix = Compl.prefix_of_position ~short_path:false document position in - + Printf.printf "prefix:'%s' " prefix; [%expect "prefix:'_'"] -;; let%expect_test "complete at infix" = - let document = - "let x = 1|>." - |> Testing.Merlin_kernel.Msource.make - in + let document = "let x = 1|>." |> Testing.Merlin_kernel.Msource.make in let position = `Logical (1, 11) in let prefix = Compl.prefix_of_position ~short_path:false document position in - + Printf.printf "prefix:'%s' " prefix; [%expect "prefix:'|>'"] -;; let%expect_test "complete at arbitrary position" = - let document = - "Strin.func" - |> Testing.Merlin_kernel.Msource.make - in + let document = "Strin.func" |> Testing.Merlin_kernel.Msource.make in let position = `Logical (1, 5) in let prefix = Compl.prefix_of_position ~short_path:false document position in - (*let prefix_old = Compl.prefix_of_position_old ~short_path:false document position in*) - + + (*let prefix_old = Compl.prefix_of_position_old ~short_path:false document + position in*) Printf.printf "prefix:'%s' " prefix; (*Printf.printf "prefix_old:'%s' " prefix_old;*) [%expect "prefix:'Strin'"] -;; let%expect_test "completion prefix multiple dots test" = - let document = "[1;2]|>Core.List.ma\n" |> Testing.Merlin_kernel.Msource.make in + let document = + "[1;2]|>Core.List.ma\n" |> Testing.Merlin_kernel.Msource.make + in let position = `Logical (1, 19) in let prefix = Compl.prefix_of_position ~short_path:false document position in print_endline prefix; @@ -95,23 +84,29 @@ let%expect_test "completion prefix with space test" = [%expect "List.ma"] let%expect_test "short path prefix" = - let document = "[1;2] |> Core.List.ma\n" |> Testing.Merlin_kernel.Msource.make in + let document = + "[1;2] |> Core.List.ma\n" |> Testing.Merlin_kernel.Msource.make + in let position = `Logical (1, 22) in let prefix = Compl.prefix_of_position ~short_path:true document position in print_endline prefix; [%expect "ma"] let%expect_test "Space in dot chain" = - let document = "[1;2] |> Core. List. ma\n" |> Testing.Merlin_kernel.Msource.make in - let position = `Logical (1, 23) in + let document = + "[1;2] |> Other. Thing.Core .List . ma\n" + |> Testing.Merlin_kernel.Msource.make + in + let position = `Logical (1, 37) in let prefix = Compl.prefix_of_position ~short_path:false document position in print_endline prefix; - [%expect "Core.List.ma"] + [%expect "Other.Thing.Core.List.ma"] let%expect_test "newline in dot chain" = - let document = "[1;2] |> Core.\nList.\nma\n" |> Testing.Merlin_kernel.Msource.make in + let document = + "[1;2] |> Core.\nList.\nma\n" |> Testing.Merlin_kernel.Msource.make + in let position = `Logical (3, 2) in let prefix = Compl.prefix_of_position ~short_path:false document position in print_endline prefix; [%expect "Core.List.ma"] - From cfde1e0a1ed49dfea6df261c8c3ca80e79f2b93e Mon Sep 17 00:00:00 2001 From: faldor20 Date: Thu, 21 Sep 2023 07:20:32 +1000 Subject: [PATCH 04/23] finished cleanup and added support for monadic bind. --- ocaml-lsp-server/bench/ocaml_lsp_bench.ml | 38 +++--- ocaml-lsp-server/bench/run_bench.ml | 37 ------ ocaml-lsp-server/src/compl.ml | 74 +++-------- ocaml-lsp-server/src/compl.mli | 8 +- ocaml-lsp-server/src/prefix_parser.ml | 96 +------------- ocaml-lsp-server/src/testing.ml | 5 +- ocaml-lsp-server/src/testing.mli | 5 - .../__tests__/textDocument-completion.test.ts | 1 + .../test/position_prefix_tests.ml | 118 +++++++----------- 9 files changed, 102 insertions(+), 280 deletions(-) delete mode 100644 ocaml-lsp-server/bench/run_bench.ml delete mode 100644 ocaml-lsp-server/src/testing.mli diff --git a/ocaml-lsp-server/bench/ocaml_lsp_bench.ml b/ocaml-lsp-server/bench/ocaml_lsp_bench.ml index 3b3aed47f..b0069479c 100644 --- a/ocaml-lsp-server/bench/ocaml_lsp_bench.ml +++ b/ocaml-lsp-server/bench/ocaml_lsp_bench.ml @@ -5,32 +5,40 @@ open Ocaml_lsp_server.Testing let () = let document = "let mem = ListLabels.mem\n\nlet _ = mem ~se" |> Merlin_kernel.Msource.make - in - let long_document = - " - arosietnaorisetnoarisent - arsotienarositen - arsotinarsotienarst - ast. rienrst .rst - !@#&984@#$ <><|||>> - aoris noarisetnaoiresnt aorisent aoierns - let b a= 5234 n oienar. rsoien . iri i... r - let mem = ListLabels.mem\n\nlet _ = mem ~se" |> Merlin_kernel.Msource.make in + let long_document_text = + "pam .tsiL se~\n\ + \ arosietnaorisetnoarisent\n\ + \ arsotienarositen\n\ + \ arsotinarsotienarst\n\ + \ aoris noarisetnaoiresnt aorisent aoierns\n\ + \ ast. rienrst .rst \n\ + \ let b a= 5234 n oienar. rsoien . iri i... r\n\ + \ !@#&984@#$ <><|||>>\n\ + \ let mem = ListLabels.mem\n\n\ + let _ = mem ~se" + in + let long_document = long_document_text |> Merlin_kernel.Msource.make in let position = `Logical (3, 15) in - Command_unix.run + Command_unix.run (Bench.make_command [ Bench.Test.create ~name:"regex" (fun _ -> Compl.prefix_of_position ~short_path:false document position |> ignore) - ; Bench.Test.create ~name:"parser" (fun _ -> - Compl.prefix_of_position_parser ~short_path:false document position - |> ignore) ; Bench.Test.create ~name:"regex_long" (fun _ -> Compl.prefix_of_position ~short_path:false long_document position |> ignore) + ; Bench.Test.create ~name:"regex_only" (fun _ -> + Prefix_parser.try_parse_regex + (document |> Merlin_kernel.Msource.text) + |> ignore) + ; Bench.Test.create ~name:"regex_only_long" (fun _ -> + Prefix_parser.try_parse_regex long_document_text |> ignore) ; Bench.Test.create ~name:"old" (fun _ -> Compl.prefix_of_position_old ~short_path:false document position |> ignore) + ; Bench.Test.create ~name:"old_long" (fun _ -> + Compl.prefix_of_position_old ~short_path:false document position + |> ignore) ]) diff --git a/ocaml-lsp-server/bench/run_bench.ml b/ocaml-lsp-server/bench/run_bench.ml deleted file mode 100644 index 28deac118..000000000 --- a/ocaml-lsp-server/bench/run_bench.ml +++ /dev/null @@ -1,37 +0,0 @@ -open Core -open Core_bench -open Ocaml_lsp_server.Testing - -let () = - let document = - "let mem = ListLabels.mem\n\nlet _ = mem ~se" |> Merlin_kernel.Msource.make - in - let long_document = - " - arosietnaorisetnoarisent - arsotienarositen - arsotinarsotienarst - ast. rienrst .rst - !@#&984@#$ <><|||>> - aoris noarisetnaoiresnt aorisent aoierns - let b a= 5234 n oienar. rsoien . iri i... r - let mem = ListLabels.mem\n\nlet _ = mem ~se" |> Merlin_kernel.Msource.make - in - - let position = `Logical (3, 15) in - Command.summary - (Bench.make_command - [ Bench.Test.create ~name:"regex" (fun _ -> - Compl.prefix_of_position ~short_path:false document position - |> ignore) - ; Bench.Test.create ~name:"parser" (fun _ -> - Compl.prefix_of_position_parser ~short_path:false document position - |> ignore) - ; Bench.Test.create ~name:"regex_long" (fun _ -> - Compl.prefix_of_position ~short_path:false long_document position - |> ignore) - ; Bench.Test.create ~name:"old" (fun _ -> - Compl.prefix_of_position_old ~short_path:false document position - |> ignore) - ]) - |> ignore diff --git a/ocaml-lsp-server/src/compl.ml b/ocaml-lsp-server/src/compl.ml index 1626f66d5..eb768b149 100644 --- a/ocaml-lsp-server/src/compl.ml +++ b/ocaml-lsp-server/src/compl.ml @@ -103,45 +103,17 @@ let prefix_of_position_old ~short_path source position = | None -> reconstructed_prefix else reconstructed_prefix -let prefix_of_position_parser ~short_path source position = - let open Prefix_parser in - match Msource.text source with - | "" -> "" - | text -> - let end_of_prefix = - let (`Offset index) = Msource.get_offset source position in - min (String.length text - 1) (index - 1) - in - (*TODO this is a mess and could be a lot faster*) - let prefix_text = - String.sub text ~pos:0 ~len:(end_of_prefix + 1) - |> String.to_seq |> List.of_seq |> List.rev - in - - (*Printf.printf "trying to parse text `%s`\n" - (prefix_text|>String.of_list);*) - let prefix_length = - match prefix_text with - | c :: next_char :: _ when c |> is_name_char ~next_char -> - (*Printf.printf "trying to parse as name or label";*) - prefix_text |> try_parse [ name_prefix ] - | x -> - (*Printf.printf "trying to parse as infix";*) - x |> try_parse [ infix_prefix ] - in - - let len = - match prefix_length with - | None -> 0 - | Some len -> len - in - let pos = end_of_prefix - len + 1 in - let reconstructed_prefix = String.sub text ~pos ~len in - if short_path then - match String.split_on_char reconstructed_prefix ~sep:'.' |> List.last with - | Some s -> s - | None -> reconstructed_prefix - else reconstructed_prefix +module String = struct + include String + + (**Filters a string keeping any chars for which f returns true and discarding + those for which it returns false*) + let filter str ~f = + let buffer = Buffer.create (str |> String.length) in + String.iter ~f:(fun s -> if f s then Buffer.add_char buffer s else ()) str; + let s : string = Buffer.contents buffer in + s +end let prefix_of_position ~short_path source position = let open Prefix_parser in @@ -153,35 +125,29 @@ let prefix_of_position ~short_path source position = min (String.length text - 1) (index - 1) in let prefix_text = - (*We do prevent completion from working across multiple lines here. But - this is probably an okay aproximation. We could add the the regex or - parser the fact that whitespace doesn't really matter in certain cases - like "List. map"*) let pos = - (* text |> String.rfindi ~from:end_of_prefix ~f:(( = ) '\n') |> - Option.value ~default:0 *) - - (*clamp the length of a line to process at 500 chars*) + (*clamp the length of a line to process at 500 chars, this is just a + reasonable limit for regex performance*) max 0 (end_of_prefix - 500) in String.sub text ~pos ~len:(end_of_prefix + 1 - pos) - |> String.map ~f:(fun x -> if x = '\n'||x='\t' then ' ' else x) + (*because all whitespace is semantically the same we convert it all to + spaces for easier regex matching*) + |> String.map ~f:(fun x -> if x = '\n' || x = '\t' then ' ' else x) in - (*Printf.printf "trying to parse text `%s`\n" - (prefix_text|>String.of_list);*) let reconstructed_prefix = - try_parse_regex prefix_text |> Option.value ~default:"" |>String.filter_map ~f:(fun x-> if x=' ' then None else Some x ) - + try_parse_regex prefix_text + |> Option.value ~default:"" + |> String.filter ~f:(fun x -> x <> ' ') in + if short_path then match String.split_on_char reconstructed_prefix ~sep:'.' |> List.last with | Some s -> s | None -> reconstructed_prefix else reconstructed_prefix -(** [suffix_of_position source position] computes the suffix of the identifier - after [position]. *) let suffix_of_position source position = match Msource.text source with | "" -> "" diff --git a/ocaml-lsp-server/src/compl.mli b/ocaml-lsp-server/src/compl.mli index 8c3e49d68..419cd9a8f 100644 --- a/ocaml-lsp-server/src/compl.mli +++ b/ocaml-lsp-server/src/compl.mli @@ -27,19 +27,19 @@ val resolve : -> CompletionItem.t Fiber.t (** [prefix_of_position ~short_path source position] computes prefix before - given [position]. + given [position]. + A prefix is essentially a piece of code that refers to one thing eg a single infix operator "|>", a single reference to a function or variable: "List.map" a keyword "let" etc + If there is semantically irrelivent whitespace it is removed eg "List. map"->"List.map" @param short_path determines whether we want full prefix or cut at ["."], e.g. [List.m] returns ["m"] when [short_path] is set vs ["List.m"] when not. @return prefix of [position] in [source] and its length *) -val prefix_of_position_parser : +val prefix_of_position : short_path:bool -> Msource.t -> [< Msource.position ] -> string val prefix_of_position_old : short_path:bool -> Msource.t -> [< Msource.position ] -> string -val prefix_of_position : - short_path:bool -> Msource.t -> [< Msource.position ] -> string (** [reconstruct_ident source position] returns the identifier at [position]. Note: [position] can be in the middle of the identifier. diff --git a/ocaml-lsp-server/src/prefix_parser.ml b/ocaml-lsp-server/src/prefix_parser.ml index c315b4249..bebad09fa 100644 --- a/ocaml-lsp-server/src/prefix_parser.ml +++ b/ocaml-lsp-server/src/prefix_parser.ml @@ -1,98 +1,13 @@ -type parse_state = - | Continue - | End - | IncludeAndEnd - | Fail - -let next continue = if continue then Continue else End - -let is_name_body_char char = - match char with - | '0' .. '9' | '\'' | '_' | 'a' .. 'z' | 'A' .. 'Z' -> true - | _ -> false - -let parse_name_char ~next_char currentChar = - match currentChar with - | '.' -> next_char |> is_name_body_char |> next - | '`' -> IncludeAndEnd - | '~' | '?' -> - if next_char |> is_name_body_char || next_char = ' ' then IncludeAndEnd - else End - | c -> c |> is_name_body_char |> next - -let is_name_char ~next_char currentChar = - match parse_name_char ~next_char currentChar with - | IncludeAndEnd | Continue -> true - | Fail | End -> false - -let is_infix_char' char = - match char with - | '~' - | '?' - | ':' - | '!' - | '$' - | '&' - | '*' - | '+' - | '-' - | '/' - | '=' - | '>' - | '@' - | '^' - | '|' - | '%' - | '<' - | '.' - | '#' -> true - | _ -> false - -let parse_infix_char ~next_char:_ char = is_infix_char' char |> next - -let parse_char is_correct_char text = - let rec loop text length = - match text with - | char :: (next_char :: _ as tail) -> ( - match is_correct_char ~next_char char with - | Continue -> loop tail (length + 1) - | IncludeAndEnd -> Some (length + 1) - | End -> Some length - | Fail -> None) - (*This is ugly but i'm not sure how else to deal with reaching the start of - the string*) - | [ char ] -> ( - match is_correct_char ~next_char:' ' char with - | Continue -> Some (length + 1) - | IncludeAndEnd -> Some (length + 1) - | End -> Some length - | Fail -> None) - | _ -> Some length - in - let len = loop text 0 in - Option.bind len (fun x -> if x = 0 then None else Some x) - -let infix_prefix text = - if text |> List.hd |> is_infix_char' && List.nth text 1 |> is_infix_char' then - None - else parse_char parse_infix_char text - -let name_prefix = parse_char parse_name_char - -let rec try_parse parsers str = - match parsers with - | head :: tail -> ( - match head str with - | Some l -> Some l - | None -> str |> try_parse tail) - | [] -> None - open Re (*Regex based parser*) let name_or_label_regex = - Re.compile @@ Re.Posix.re {|([~?`])?([a-zA-Z0-9_']|[a-zA-Z0-9_'] *\. *)+$|} + Re.compile @@ Re.Posix.re {|[~?`]$|([~?`]|let%|and%)?([a-zA-Z0-9_']|[a-zA-Z0-9_'] *\. *)+$|} + +(** matches let%lwt and let* style expressions. See here:https://v2.ocaml.org/manual/bindingops.html *) +let monadic_bind = + Re.compile @@ Re.Posix.re {|(let|and)([$&*+\-/=>@^|.]|(%[a-zA-Z0-9_']*))$|} let infixRegex = Re.compile @@ Re.Posix.re {|[~?:!$&*+\-\/=><@^|%<.#]+$|} @@ -110,6 +25,7 @@ end let try_parse_regex text = let matched = Re.exec_opt name_or_label_regex text + |> Option.none_bind (fun () -> Re.exec_opt monadic_bind text) |> Option.none_bind (fun () -> Re.exec_opt infixRegex text) in matched |> Option.map ~f:(fun x -> Group.get x 0) diff --git a/ocaml-lsp-server/src/testing.ml b/ocaml-lsp-server/src/testing.ml index f49f3e75a..eb19fe5c4 100644 --- a/ocaml-lsp-server/src/testing.ml +++ b/ocaml-lsp-server/src/testing.ml @@ -1,5 +1,8 @@ +(**WARNING: This is for internal use in testing only *) + module Compl=Compl module Document =Document module Import =Import module Merlin_kernel =Merlin_kernel -module Position =Position \ No newline at end of file +module Position =Position +module Prefix_parser =Prefix_parser \ No newline at end of file diff --git a/ocaml-lsp-server/src/testing.mli b/ocaml-lsp-server/src/testing.mli deleted file mode 100644 index f49f3e75a..000000000 --- a/ocaml-lsp-server/src/testing.mli +++ /dev/null @@ -1,5 +0,0 @@ -module Compl=Compl -module Document =Document -module Import =Import -module Merlin_kernel =Merlin_kernel -module Position =Position \ No newline at end of file diff --git a/ocaml-lsp-server/test/e2e/__tests__/textDocument-completion.test.ts b/ocaml-lsp-server/test/e2e/__tests__/textDocument-completion.test.ts index ff8f1a3e5..b87ea4758 100644 --- a/ocaml-lsp-server/test/e2e/__tests__/textDocument-completion.test.ts +++ b/ocaml-lsp-server/test/e2e/__tests__/textDocument-completion.test.ts @@ -858,6 +858,7 @@ g ?f:M.ig it("completes labels", async () => { openDocument("let f = ListLabels.map ~"); + let items = (await queryCompletion(Types.Position.create(0, 24))) ?? []; let items_top5 = items.slice(0, 10); expect(items_top5).toMatchInlineSnapshot(` diff --git a/ocaml-lsp-server/test/position_prefix_tests.ml b/ocaml-lsp-server/test/position_prefix_tests.ml index c84d1c91e..68b6e568d 100644 --- a/ocaml-lsp-server/test/position_prefix_tests.ml +++ b/ocaml-lsp-server/test/position_prefix_tests.ml @@ -2,111 +2,81 @@ open Ocaml_lsp_server open Testing open! Import -let%expect_test "varible in labelled pararm" = - let document = - "let map = ListLabels.map\n\nlet _ = map ~f:Int.abs\n" - |> Testing.Merlin_kernel.Msource.make - in +(** An extensive set of tests to validation that the prefix_op_position function + correctly returns prefixes merlin is happy with for all the odd ocaml syntax + that exists *) - let position = `Logical (3, 22) in - let prefix = Compl.prefix_of_position ~short_path:false document position in +let prefix_test ?(short_path = false) document position = + let document_source = Testing.Merlin_kernel.Msource.make document in + let prefix = Compl.prefix_of_position ~short_path document_source position in + Printf.printf "%s " prefix - print_endline prefix; +let%expect_test "varible in labelled pararm" = + prefix_test + "let map = ListLabels.map\n\nlet _ = map ~f:Int.abs\n" + (`Logical (3, 22)); [%expect "Int.abs"] let%expect_test "labelled pararm" = - let document = - "let mem = ListLabels.mem\n\nlet _ = mem ~se" - |> Testing.Merlin_kernel.Msource.make - in + prefix_test "let mem = ListLabels.mem\n\nlet _ = mem ~se" (`Logical (3, 15)); + [%expect "~se"] - let position = `Logical (3, 15) in - let prefix = Compl.prefix_of_position ~short_path:false document position in +let%expect_test "completion of enum" = + prefix_test "match kind with\n| `Va" (`Logical (2, 21)); + [%expect "`Va"] - Printf.printf "prefix:'%s' " prefix; - [%expect "prefix:'~se'"] +let%expect_test "labelled pararm" = + prefix_test "let mem = ListLabels.mem\n\nlet _ = mem ~" (`Logical (3, 13)); + [%expect "~"] let%expect_test "correctly handle typed hole for code action" = - let document = "let x = _" |> Testing.Merlin_kernel.Msource.make in - let position = `Logical (1, 9) in - let prefix = Compl.prefix_of_position ~short_path:false document position in - - Printf.printf "prefix:'%s' " prefix; - [%expect "prefix:'_'"] + prefix_test "let x = _" (`Logical (1, 9)); + [%expect "_"] let%expect_test "complete at infix" = - let document = "let x = 1|>." |> Testing.Merlin_kernel.Msource.make in - let position = `Logical (1, 11) in - let prefix = Compl.prefix_of_position ~short_path:false document position in - - Printf.printf "prefix:'%s' " prefix; - [%expect "prefix:'|>'"] + prefix_test "let x = 1|>." (`Logical (1, 11)); + [%expect "|>"] let%expect_test "complete at arbitrary position" = - let document = "Strin.func" |> Testing.Merlin_kernel.Msource.make in - let position = `Logical (1, 5) in - let prefix = Compl.prefix_of_position ~short_path:false document position in - - (*let prefix_old = Compl.prefix_of_position_old ~short_path:false document - position in*) - Printf.printf "prefix:'%s' " prefix; - (*Printf.printf "prefix_old:'%s' " prefix_old;*) - [%expect "prefix:'Strin'"] + prefix_test "Strin.func" (`Logical (1, 5)); + [%expect "Strin"] let%expect_test "completion prefix multiple dots test" = - let document = - "[1;2]|>Core.List.ma\n" |> Testing.Merlin_kernel.Msource.make - in - let position = `Logical (1, 19) in - let prefix = Compl.prefix_of_position ~short_path:false document position in - print_endline prefix; + prefix_test "[1;2]|>Core.List.ma\n" (`Logical (1, 19)); [%expect "Core.List.ma"] let%expect_test "completion prefix touching infix test" = - let document = "[1;2]|>List.ma\n" |> Testing.Merlin_kernel.Msource.make in - let position = `Logical (1, 14) in - let prefix = Compl.prefix_of_position ~short_path:false document position in - print_endline prefix; + prefix_test "[1;2]|>List.ma\n" (`Logical (1, 14)); [%expect "List.ma"] let%expect_test "completion prefix dot infix test" = - let document = "[1;2]|>.List.ma\n" |> Testing.Merlin_kernel.Msource.make in - let position = `Logical (1, 15) in - let prefix = Compl.prefix_of_position ~short_path:false document position in - print_endline prefix; + prefix_test "[1;2]|>.List.ma\n" (`Logical (1, 15)); + [%expect "List.ma"] + +let%expect_test "completion against bracket" = + prefix_test "(List.ma)\n" (`Logical (1, 8)); [%expect "List.ma"] let%expect_test "completion prefix with space test" = - let document = "[1;2] |> List.ma\n" |> Testing.Merlin_kernel.Msource.make in - let position = `Logical (1, 16) in - let prefix = Compl.prefix_of_position ~short_path:false document position in - print_endline prefix; + prefix_test "[1;2] |> List.ma\n" (`Logical (1, 16)); [%expect "List.ma"] let%expect_test "short path prefix" = - let document = - "[1;2] |> Core.List.ma\n" |> Testing.Merlin_kernel.Msource.make - in - let position = `Logical (1, 22) in - let prefix = Compl.prefix_of_position ~short_path:true document position in - print_endline prefix; + prefix_test ~short_path:true "[1;2] |> Core.List.ma\n" (`Logical (1, 22)); [%expect "ma"] let%expect_test "Space in dot chain" = - let document = - "[1;2] |> Other. Thing.Core .List . ma\n" - |> Testing.Merlin_kernel.Msource.make - in - let position = `Logical (1, 37) in - let prefix = Compl.prefix_of_position ~short_path:false document position in - print_endline prefix; + prefix_test "[1;2] |> Other. Thing.Core .List . ma\n" (`Logical (1, 37)); [%expect "Other.Thing.Core.List.ma"] let%expect_test "newline in dot chain" = - let document = - "[1;2] |> Core.\nList.\nma\n" |> Testing.Merlin_kernel.Msource.make - in - let position = `Logical (3, 2) in - let prefix = Compl.prefix_of_position ~short_path:false document position in - print_endline prefix; + prefix_test "[1;2] |> Core.\nList.\nma\n" (`Logical (3, 2)); [%expect "Core.List.ma"] + +let%expect_test "let%lwt thing" = + prefix_test "let%lwt" (`Logical (1, 7)); + [%expect "let%lwt"] + +let%expect_test "let+ thing" = + prefix_test "let+" (`Logical (1, 4)); + [%expect "let+"] From f6a031c1cf120d48ed052a12fff5f9de3ea95fc4 Mon Sep 17 00:00:00 2001 From: faldor20 Date: Thu, 21 Sep 2023 07:30:45 +1000 Subject: [PATCH 05/23] removed pointless regex --- ocaml-lsp-server/src/prefix_parser.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ocaml-lsp-server/src/prefix_parser.ml b/ocaml-lsp-server/src/prefix_parser.ml index bebad09fa..8484f266e 100644 --- a/ocaml-lsp-server/src/prefix_parser.ml +++ b/ocaml-lsp-server/src/prefix_parser.ml @@ -3,7 +3,7 @@ open Re (*Regex based parser*) let name_or_label_regex = - Re.compile @@ Re.Posix.re {|[~?`]$|([~?`]|let%|and%)?([a-zA-Z0-9_']|[a-zA-Z0-9_'] *\. *)+$|} + Re.compile @@ Re.Posix.re {|([~?`]|let%|and%)?([a-zA-Z0-9_']|[a-zA-Z0-9_'] *\. *)+$|} (** matches let%lwt and let* style expressions. See here:https://v2.ocaml.org/manual/bindingops.html *) let monadic_bind = From bfddc86137581e6a56bcf77de0c3f84b61824740 Mon Sep 17 00:00:00 2001 From: faldor20 Date: Thu, 21 Sep 2023 08:15:13 +1000 Subject: [PATCH 06/23] reversed implimentation --- ocaml-lsp-server/src/compl.ml | 24 ++++++++++++++++++------ ocaml-lsp-server/src/prefix_parser.ml | 12 +++++++++--- 2 files changed, 27 insertions(+), 9 deletions(-) diff --git a/ocaml-lsp-server/src/compl.ml b/ocaml-lsp-server/src/compl.ml index eb768b149..fcace11b9 100644 --- a/ocaml-lsp-server/src/compl.ml +++ b/ocaml-lsp-server/src/compl.ml @@ -106,13 +106,25 @@ let prefix_of_position_old ~short_path source position = module String = struct include String - (**Filters a string keeping any chars for which f returns true and discarding - those for which it returns false*) - let filter str ~f = + (**reverses and Filters a string keeping any chars for which f returns true + and discarding those for which it returns false*) + let rev_filter str ~f = let buffer = Buffer.create (str |> String.length) in - String.iter ~f:(fun s -> if f s then Buffer.add_char buffer s else ()) str; + let len = str |> String.length in + + for i = 0 to len - 1 do + let s = String.unsafe_get str (len -1 - i) in + if f s then Buffer.add_char buffer s else () + done; let s : string = Buffer.contents buffer in s + + (**reverses a stirng and maps over the content at the same time*) + let rev_map str ~f = + let string = Bytes.unsafe_of_string str in + let len = Bytes.length string in + Bytes.init len (fun i -> f (Bytes.unsafe_get string (len - 1 - i))) + |> Bytes.unsafe_to_string end let prefix_of_position ~short_path source position = @@ -133,13 +145,13 @@ let prefix_of_position ~short_path source position = String.sub text ~pos ~len:(end_of_prefix + 1 - pos) (*because all whitespace is semantically the same we convert it all to spaces for easier regex matching*) - |> String.map ~f:(fun x -> if x = '\n' || x = '\t' then ' ' else x) + |> String.rev_map ~f:(fun x -> if x = '\n' || x = '\t' then ' ' else x) in let reconstructed_prefix = try_parse_regex prefix_text |> Option.value ~default:"" - |> String.filter ~f:(fun x -> x <> ' ') + |> String.rev_filter ~f:(fun x -> x <> ' ') in if short_path then diff --git a/ocaml-lsp-server/src/prefix_parser.ml b/ocaml-lsp-server/src/prefix_parser.ml index 8484f266e..27ea804d2 100644 --- a/ocaml-lsp-server/src/prefix_parser.ml +++ b/ocaml-lsp-server/src/prefix_parser.ml @@ -5,11 +5,17 @@ open Re let name_or_label_regex = Re.compile @@ Re.Posix.re {|([~?`]|let%|and%)?([a-zA-Z0-9_']|[a-zA-Z0-9_'] *\. *)+$|} +let name_or_label_regex_rev = + Re.compile @@ Re.Posix.re {|^([a-zA-Z0-9_']| *\. *[a-zA-Z0-9_'])+([~?`]|%tel|%dna)?|} + (** matches let%lwt and let* style expressions. See here:https://v2.ocaml.org/manual/bindingops.html *) let monadic_bind = Re.compile @@ Re.Posix.re {|(let|and)([$&*+\-/=>@^|.]|(%[a-zA-Z0-9_']*))$|} +let monadic_bind_rev = + Re.compile @@ Re.Posix.re {|^([$&*+\-/=>@^|.]|([a-zA-Z0-9_']*)%)(tel|dna)|} let infixRegex = Re.compile @@ Re.Posix.re {|[~?:!$&*+\-\/=><@^|%<.#]+$|} +let infixRegex_rev = Re.compile @@ Re.Posix.re {|^[~?:!$&*+\-\/=><@^|%<.#]+|} open Import @@ -24,8 +30,8 @@ end let try_parse_regex text = let matched = - Re.exec_opt name_or_label_regex text - |> Option.none_bind (fun () -> Re.exec_opt monadic_bind text) - |> Option.none_bind (fun () -> Re.exec_opt infixRegex text) + Re.exec_opt name_or_label_regex_rev text + |> Option.none_bind (fun () -> Re.exec_opt monadic_bind_rev text) + |> Option.none_bind (fun () -> Re.exec_opt infixRegex_rev text) in matched |> Option.map ~f:(fun x -> Group.get x 0) From f84be2f3cef5623390c107dc572e1f4172d90d6c Mon Sep 17 00:00:00 2001 From: faldor20 Date: Fri, 22 Sep 2023 00:27:31 +1000 Subject: [PATCH 07/23] fixed everything other than combinators --- ocaml-lsp-server/bench/ocaml_lsp_bench.ml | 26 +++++++++---- ocaml-lsp-server/src/compl.ml | 39 ------------------- ocaml-lsp-server/src/compl.mli | 8 ++-- ocaml-lsp-server/src/import.ml | 20 ++++++++++ ocaml-lsp-server/src/prefix_parser.ml | 3 +- .../test/position_prefix_tests.ml | 3 +- 6 files changed, 46 insertions(+), 53 deletions(-) diff --git a/ocaml-lsp-server/bench/ocaml_lsp_bench.ml b/ocaml-lsp-server/bench/ocaml_lsp_bench.ml index b0069479c..56e963245 100644 --- a/ocaml-lsp-server/bench/ocaml_lsp_bench.ml +++ b/ocaml-lsp-server/bench/ocaml_lsp_bench.ml @@ -1,6 +1,6 @@ open Core open Core_bench -open Ocaml_lsp_server.Testing +open Ocaml_lsp_server let () = let document = @@ -24,21 +24,33 @@ let () = Command_unix.run (Bench.make_command [ Bench.Test.create ~name:"regex" (fun _ -> - Compl.prefix_of_position ~short_path:false document position + Testing.Compl.prefix_of_position + ~short_path:false + document + position |> ignore) ; Bench.Test.create ~name:"regex_long" (fun _ -> - Compl.prefix_of_position ~short_path:false long_document position + Testing.Compl.prefix_of_position + ~short_path:false + long_document + position |> ignore) ; Bench.Test.create ~name:"regex_only" (fun _ -> - Prefix_parser.try_parse_regex + Testing.Prefix_parser.try_parse_regex (document |> Merlin_kernel.Msource.text) |> ignore) ; Bench.Test.create ~name:"regex_only_long" (fun _ -> - Prefix_parser.try_parse_regex long_document_text |> ignore) + Testing.Prefix_parser.try_parse_regex long_document_text |> ignore) ; Bench.Test.create ~name:"old" (fun _ -> - Compl.prefix_of_position_old ~short_path:false document position + Testing.Compl.prefix_of_position_old + ~short_path:false + document + position |> ignore) ; Bench.Test.create ~name:"old_long" (fun _ -> - Compl.prefix_of_position_old ~short_path:false document position + Testing.Compl.prefix_of_position_old + ~short_path:false + document + position |> ignore) ]) diff --git a/ocaml-lsp-server/src/compl.ml b/ocaml-lsp-server/src/compl.ml index fcace11b9..a382f4c47 100644 --- a/ocaml-lsp-server/src/compl.ml +++ b/ocaml-lsp-server/src/compl.ml @@ -103,30 +103,6 @@ let prefix_of_position_old ~short_path source position = | None -> reconstructed_prefix else reconstructed_prefix -module String = struct - include String - - (**reverses and Filters a string keeping any chars for which f returns true - and discarding those for which it returns false*) - let rev_filter str ~f = - let buffer = Buffer.create (str |> String.length) in - let len = str |> String.length in - - for i = 0 to len - 1 do - let s = String.unsafe_get str (len -1 - i) in - if f s then Buffer.add_char buffer s else () - done; - let s : string = Buffer.contents buffer in - s - - (**reverses a stirng and maps over the content at the same time*) - let rev_map str ~f = - let string = Bytes.unsafe_of_string str in - let len = Bytes.length string in - Bytes.init len (fun i -> f (Bytes.unsafe_get string (len - 1 - i))) - |> Bytes.unsafe_to_string -end - let prefix_of_position ~short_path source position = let open Prefix_parser in match Msource.text source with @@ -323,12 +299,8 @@ module Complete_with_construct = struct List.mapi constructed_exprs ~f:completionItem_of_constructed_expr end -let logCompletion log = - Log.log ~section:"resolveCompletion" (fun () -> Log.msg log []) - let complete (state : State.t) ({ textDocument = { uri }; position = pos; _ } : CompletionParams.t) = - logCompletion "ho1"; Fiber.of_thunk (fun () -> let doc = Document_store.get state.store uri in match Document.kind doc with @@ -363,12 +335,6 @@ let complete (state : State.t) let* item = completion_item_capability in item.deprecatedSupport) in - logCompletion - (Printf.sprintf - "prefix: %s; position %i:%i" - prefix - pos.line - pos.character); if not (Typed_hole.can_be_hole prefix) then Complete_by_prefix.complete merlin prefix pos ~resolve ~deprecated else @@ -438,12 +404,10 @@ let format_doc ~markdown doc = let resolve doc (compl : CompletionItem.t) (resolve : Resolve.t) query_doc ~markdown = - logCompletion "Starting completion"; Fiber.of_thunk (fun () -> (* Due to merlin's API, we create a version of the given document with the applied completion item and pass it to merlin to get the docs for the [compl.label] *) - logCompletion "Starting completion"; let position : Position.t = resolve.position in let logical_position = Position.logical position in let doc = @@ -455,7 +419,6 @@ let resolve doc (compl : CompletionItem.t) (resolve : Resolve.t) query_doc (Document.Merlin.source doc) logical_position in - logCompletion @@ "completion prefix is:" ^ prefix; { position with character = position.character - String.length prefix } @@ -468,9 +431,7 @@ let resolve doc (compl : CompletionItem.t) (resolve : Resolve.t) query_doc character = position.character + String.length suffix } in - let range = Range.create ~start ~end_ in - TextDocumentContentChangeEvent.create ~range ~text:compl.label () in Document.update_text (Document.Merlin.to_doc doc) [ complete ] diff --git a/ocaml-lsp-server/src/compl.mli b/ocaml-lsp-server/src/compl.mli index 419cd9a8f..b595844a1 100644 --- a/ocaml-lsp-server/src/compl.mli +++ b/ocaml-lsp-server/src/compl.mli @@ -27,9 +27,10 @@ val resolve : -> CompletionItem.t Fiber.t (** [prefix_of_position ~short_path source position] computes prefix before - given [position]. - A prefix is essentially a piece of code that refers to one thing eg a single infix operator "|>", a single reference to a function or variable: "List.map" a keyword "let" etc - If there is semantically irrelivent whitespace it is removed eg "List. map"->"List.map" + given [position]. A prefix is essentially a piece of code that refers to one + thing eg a single infix operator "|>", a single reference to a function or + variable: "List.map" a keyword "let" etc If there is semantically irrelivent + whitespace it is removed eg "List. map"->"List.map" @param short_path determines whether we want full prefix or cut at ["."], e.g. @@ -38,6 +39,7 @@ val resolve : @return prefix of [position] in [source] and its length *) val prefix_of_position : short_path:bool -> Msource.t -> [< Msource.position ] -> string + val prefix_of_position_old : short_path:bool -> Msource.t -> [< Msource.position ] -> string diff --git a/ocaml-lsp-server/src/import.ml b/ocaml-lsp-server/src/import.ml index 02fd89d83..53a42c95d 100644 --- a/ocaml-lsp-server/src/import.ml +++ b/ocaml-lsp-server/src/import.ml @@ -34,6 +34,26 @@ include struct module String = struct include String + (**reverses and Filters a string keeping any chars for which f returns true + and discarding those for which it returns false*) + let rev_filter str ~f = + let buffer = Buffer.create (str |> String.length) in + let len = str |> String.length in + + for i = 0 to len - 1 do + let s = String.unsafe_get str (len - 1 - i) in + if f s then Buffer.add_char buffer s else () + done; + let s : string = Buffer.contents buffer in + s + + (**reverses a stirng and maps over the content at the same time*) + let rev_map str ~f = + let string = Bytes.unsafe_of_string str in + let len = Bytes.length string in + Bytes.init len ~f:(fun i -> f (Bytes.unsafe_get string (len - 1 - i))) + |> Bytes.unsafe_to_string + let findi = let rec loop s len ~f i = if i >= len then None diff --git a/ocaml-lsp-server/src/prefix_parser.ml b/ocaml-lsp-server/src/prefix_parser.ml index 27ea804d2..a4741eca2 100644 --- a/ocaml-lsp-server/src/prefix_parser.ml +++ b/ocaml-lsp-server/src/prefix_parser.ml @@ -3,7 +3,7 @@ open Re (*Regex based parser*) let name_or_label_regex = - Re.compile @@ Re.Posix.re {|([~?`]|let%|and%)?([a-zA-Z0-9_']|[a-zA-Z0-9_'] *\. *)+$|} + {|([~?`]|let%|and%)?([a-zA-Z0-9_']|[a-zA-Z0-9_'] *\. *)+$|} let name_or_label_regex_rev = Re.compile @@ Re.Posix.re {|^([a-zA-Z0-9_']| *\. *[a-zA-Z0-9_'])+([~?`]|%tel|%dna)?|} @@ -21,7 +21,6 @@ open Import module Option = struct include Option - let none_bind func option = match option with | None -> func () diff --git a/ocaml-lsp-server/test/position_prefix_tests.ml b/ocaml-lsp-server/test/position_prefix_tests.ml index 68b6e568d..464894716 100644 --- a/ocaml-lsp-server/test/position_prefix_tests.ml +++ b/ocaml-lsp-server/test/position_prefix_tests.ml @@ -1,5 +1,4 @@ open Ocaml_lsp_server -open Testing open! Import (** An extensive set of tests to validation that the prefix_op_position function @@ -8,7 +7,7 @@ open! Import let prefix_test ?(short_path = false) document position = let document_source = Testing.Merlin_kernel.Msource.make document in - let prefix = Compl.prefix_of_position ~short_path document_source position in + let prefix = Testing.Compl.prefix_of_position ~short_path document_source position in Printf.printf "%s " prefix let%expect_test "varible in labelled pararm" = From 1fce0d6728411146f7ff70e99b9fc8b0c3cab90c Mon Sep 17 00:00:00 2001 From: faldor20 Date: Fri, 22 Sep 2023 00:37:01 +1000 Subject: [PATCH 08/23] fixed formatting and removed unnecissary import --- ocaml-lsp-server/test/position_prefix_tests.ml | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/ocaml-lsp-server/test/position_prefix_tests.ml b/ocaml-lsp-server/test/position_prefix_tests.ml index 464894716..f61bf6678 100644 --- a/ocaml-lsp-server/test/position_prefix_tests.ml +++ b/ocaml-lsp-server/test/position_prefix_tests.ml @@ -1,5 +1,4 @@ open Ocaml_lsp_server -open! Import (** An extensive set of tests to validation that the prefix_op_position function correctly returns prefixes merlin is happy with for all the odd ocaml syntax @@ -7,7 +6,9 @@ open! Import let prefix_test ?(short_path = false) document position = let document_source = Testing.Merlin_kernel.Msource.make document in - let prefix = Testing.Compl.prefix_of_position ~short_path document_source position in + let prefix = + Testing.Compl.prefix_of_position ~short_path document_source position + in Printf.printf "%s " prefix let%expect_test "varible in labelled pararm" = From 4d720d02d648a031d658dbf4506abf7f78b997f8 Mon Sep 17 00:00:00 2001 From: faldor20 Date: Mon, 25 Sep 2023 20:37:02 +1000 Subject: [PATCH 09/23] Misc fixes, names, formatting, etc converted to Re syntax for regex, cleaned up Testing module exports --- flake.nix | 5 ++ ocaml-lsp-server/bench/dune | 15 ++---- ocaml-lsp-server/bench/ocaml_lsp_bench.ml | 5 +- ocaml-lsp-server/src/compl.ml | 2 +- ocaml-lsp-server/src/ocaml_lsp_server.ml | 2 +- ocaml-lsp-server/src/ocaml_lsp_server.mli | 3 +- ocaml-lsp-server/src/prefix_parser.ml | 48 +++++++++++++------ ocaml-lsp-server/src/prefix_parser.mli | 4 ++ ocaml-lsp-server/src/testing.ml | 9 ++-- ocaml-lsp-server/test/dune | 2 - .../__tests__/textDocument-completion.test.ts | 4 -- .../test/position_prefix_tests.ml | 4 ++ 12 files changed, 60 insertions(+), 43 deletions(-) create mode 100644 ocaml-lsp-server/src/prefix_parser.mli diff --git a/flake.nix b/flake.nix index 66aa212ae..12d4bfdaa 100644 --- a/flake.nix +++ b/flake.nix @@ -118,6 +118,8 @@ ppx_yojson_conv = "*"; cinaps = "*"; ppx_expect = "*"; + core_bench="*"; + ppx_bench = "*"; ocamlfind = "1.9.2"; }; packagesFromNames = set: @@ -213,6 +215,9 @@ ocamlPackages.utop ocamlPackages.cinaps ocamlPackages.ppx_yojson_conv + #benchmarking + ocamlPackages.ppx_bench + ocamlPackages.core_bench ]); inputsFrom = [ fast.ocaml-lsp fast.jsonrpc fast.lsp ]; }; diff --git a/ocaml-lsp-server/bench/dune b/ocaml-lsp-server/bench/dune index 12380aae7..414d048bb 100644 --- a/ocaml-lsp-server/bench/dune +++ b/ocaml-lsp-server/bench/dune @@ -1,16 +1,11 @@ - (executables (names ocaml_lsp_bench) - - (libraries + (libraries ocaml_lsp_server - core_unix.command_unix + core_unix.command_unix merlin-lib.kernel - base core - core_bench - ) - - (preprocess(pps ppx_jane ppx_bench)) - ) + core_bench) + (preprocess + (pps ppx_bench))) diff --git a/ocaml-lsp-server/bench/ocaml_lsp_bench.ml b/ocaml-lsp-server/bench/ocaml_lsp_bench.ml index 56e963245..caba0337d 100644 --- a/ocaml-lsp-server/bench/ocaml_lsp_bench.ml +++ b/ocaml-lsp-server/bench/ocaml_lsp_bench.ml @@ -36,11 +36,12 @@ let () = position |> ignore) ; Bench.Test.create ~name:"regex_only" (fun _ -> - Testing.Prefix_parser.try_parse_regex + Testing.Prefix_parser.try_parse_with_regex (document |> Merlin_kernel.Msource.text) |> ignore) ; Bench.Test.create ~name:"regex_only_long" (fun _ -> - Testing.Prefix_parser.try_parse_regex long_document_text |> ignore) + Testing.Prefix_parser.try_parse_with_regex long_document_text + |> ignore) ; Bench.Test.create ~name:"old" (fun _ -> Testing.Compl.prefix_of_position_old ~short_path:false diff --git a/ocaml-lsp-server/src/compl.ml b/ocaml-lsp-server/src/compl.ml index a382f4c47..b7d69fbcd 100644 --- a/ocaml-lsp-server/src/compl.ml +++ b/ocaml-lsp-server/src/compl.ml @@ -125,7 +125,7 @@ let prefix_of_position ~short_path source position = in let reconstructed_prefix = - try_parse_regex prefix_text + try_parse_with_regex prefix_text |> Option.value ~default:"" |> String.rev_filter ~f:(fun x -> x <> ' ') in diff --git a/ocaml-lsp-server/src/ocaml_lsp_server.ml b/ocaml-lsp-server/src/ocaml_lsp_server.ml index 613a2e1fd..4d973ca0a 100644 --- a/ocaml-lsp-server/src/ocaml_lsp_server.ml +++ b/ocaml-lsp-server/src/ocaml_lsp_server.ml @@ -3,7 +3,7 @@ module Version = Version module Diagnostics = Diagnostics module Doc_to_md = Doc_to_md module Diff = Diff -module Testing=Testing +module Testing = Testing open Fiber.O let make_error = Jsonrpc.Response.Error.make diff --git a/ocaml-lsp-server/src/ocaml_lsp_server.mli b/ocaml-lsp-server/src/ocaml_lsp_server.mli index d9d567ad5..9fa5c0ce7 100644 --- a/ocaml-lsp-server/src/ocaml_lsp_server.mli +++ b/ocaml-lsp-server/src/ocaml_lsp_server.mli @@ -3,5 +3,4 @@ val run : Lsp.Cli.Channel.t -> read_dot_merlin:bool -> unit -> unit module Diagnostics = Diagnostics module Version = Version module Doc_to_md = Doc_to_md - -module Testing=Testing \ No newline at end of file +module Testing = Testing diff --git a/ocaml-lsp-server/src/prefix_parser.ml b/ocaml-lsp-server/src/prefix_parser.ml index a4741eca2..8ea6f1dd0 100644 --- a/ocaml-lsp-server/src/prefix_parser.ml +++ b/ocaml-lsp-server/src/prefix_parser.ml @@ -2,35 +2,53 @@ open Re (*Regex based parser*) -let name_or_label_regex = - {|([~?`]|let%|and%)?([a-zA-Z0-9_']|[a-zA-Z0-9_'] *\. *)+$|} +let name_char = + Re.alt [ rg 'a' 'z'; rg 'A' 'Z'; rg '0' '9'; char '_'; char '\'' ] -let name_or_label_regex_rev = - Re.compile @@ Re.Posix.re {|^([a-zA-Z0-9_']| *\. *[a-zA-Z0-9_'])+([~?`]|%tel|%dna)?|} +let name_with_dot = + Re.seq [ char ' ' |> rep; char '.'; char ' ' |> rep; name_char ] -(** matches let%lwt and let* style expressions. See here:https://v2.ocaml.org/manual/bindingops.html *) -let monadic_bind = - Re.compile @@ Re.Posix.re {|(let|and)([$&*+\-/=>@^|.]|(%[a-zA-Z0-9_']*))$|} -let monadic_bind_rev = - Re.compile @@ Re.Posix.re {|^([$&*+\-/=>@^|.]|([a-zA-Z0-9_']*)%)(tel|dna)|} +let core_operator_str = {|$&*+-/=>@^||} -let infixRegex = Re.compile @@ Re.Posix.re {|[~?:!$&*+\-\/=><@^|%<.#]+$|} -let infixRegex_rev = Re.compile @@ Re.Posix.re {|^[~?:!$&*+\-\/=><@^|%<.#]+|} +let operator = core_operator_str ^ {|~!?%<:.|} + +let infix = set (operator ^ "#") + +let name_or_label_regex_rev_2 = + compile + (seq + [ start + ; alt [ name_char; name_with_dot ] |> rep1 + ; alt [ set "~?``"; str "%tel"; str "%dna" ] |> opt + ]) + +(** matches let%lwt and let* style expressions. See + here:https://v2.ocaml.org/manual/bindingops.html *) +let monadic_bind_rev_2 = + compile + (seq + [ start + ; alt [ infix |> rep1; seq [ name_char |> rep1; char '%' ] ] + ; alt [ str "tel"; str "dna" ] + ]) + +let infix_regex_rev_2 = compile (seq [ start; infix |> rep1 ]) open Import module Option = struct include Option + let none_bind func option = match option with | None -> func () | Some x -> Some x end -let try_parse_regex text = +let try_parse_with_regex text = let matched = - Re.exec_opt name_or_label_regex_rev text - |> Option.none_bind (fun () -> Re.exec_opt monadic_bind_rev text) - |> Option.none_bind (fun () -> Re.exec_opt infixRegex_rev text) + Re.exec_opt name_or_label_regex_rev_2 text + |> Option.none_bind (fun () -> Re.exec_opt monadic_bind_rev_2 text) + |> Option.none_bind (fun () -> Re.exec_opt infix_regex_rev_2 text) in matched |> Option.map ~f:(fun x -> Group.get x 0) diff --git a/ocaml-lsp-server/src/prefix_parser.mli b/ocaml-lsp-server/src/prefix_parser.mli new file mode 100644 index 000000000..6a7b28422 --- /dev/null +++ b/ocaml-lsp-server/src/prefix_parser.mli @@ -0,0 +1,4 @@ +(**Try's the parse the incoming string for a prefix. The string should be a + reversed copy of the line, starting at the position where the prefix ends and + continuing backwards from there. Does not handle whitespace other than spaces *) +val try_parse_with_regex : string -> string option diff --git a/ocaml-lsp-server/src/testing.ml b/ocaml-lsp-server/src/testing.ml index eb19fe5c4..a41133624 100644 --- a/ocaml-lsp-server/src/testing.ml +++ b/ocaml-lsp-server/src/testing.ml @@ -1,8 +1,5 @@ (**WARNING: This is for internal use in testing only *) -module Compl=Compl -module Document =Document -module Import =Import -module Merlin_kernel =Merlin_kernel -module Position =Position -module Prefix_parser =Prefix_parser \ No newline at end of file +module Compl = Compl +module Merlin_kernel = Merlin_kernel +module Prefix_parser = Prefix_parser diff --git a/ocaml-lsp-server/test/dune b/ocaml-lsp-server/test/dune index adc8cb7d6..e2c3b9866 100644 --- a/ocaml-lsp-server/test/dune +++ b/ocaml-lsp-server/test/dune @@ -1,7 +1,6 @@ (dirs :standard \ e2e) (library - (modules ocaml_lsp_tests position_prefix_tests) (name ocaml_lsp_tests) (enabled_if @@ -11,7 +10,6 @@ stdune ocaml_lsp_server merlin-lib.kernel - lsp yojson ;; This is because of the (implicit_transitive_deps false) diff --git a/ocaml-lsp-server/test/e2e/__tests__/textDocument-completion.test.ts b/ocaml-lsp-server/test/e2e/__tests__/textDocument-completion.test.ts index b87ea4758..58198f396 100644 --- a/ocaml-lsp-server/test/e2e/__tests__/textDocument-completion.test.ts +++ b/ocaml-lsp-server/test/e2e/__tests__/textDocument-completion.test.ts @@ -208,7 +208,6 @@ describe_opt("textDocument/completion", () => { }, ] `); - }); it("can start completion after operator with space", async () => { @@ -271,7 +270,6 @@ describe_opt("textDocument/completion", () => { `); }); - it("can start completion in dot chain with newline", async () => { openDocument(outdent` [1;2] |> List. @@ -478,7 +476,6 @@ let apple=ref 10 in }, ] `); - }); it("can complete symbol passed as a named argument", async () => { openDocument(outdent` @@ -858,7 +855,6 @@ g ?f:M.ig it("completes labels", async () => { openDocument("let f = ListLabels.map ~"); - let items = (await queryCompletion(Types.Position.create(0, 24))) ?? []; let items_top5 = items.slice(0, 10); expect(items_top5).toMatchInlineSnapshot(` diff --git a/ocaml-lsp-server/test/position_prefix_tests.ml b/ocaml-lsp-server/test/position_prefix_tests.ml index f61bf6678..2a66e4293 100644 --- a/ocaml-lsp-server/test/position_prefix_tests.ml +++ b/ocaml-lsp-server/test/position_prefix_tests.ml @@ -80,3 +80,7 @@ let%expect_test "let%lwt thing" = let%expect_test "let+ thing" = prefix_test "let+" (`Logical (1, 4)); [%expect "let+"] + +let%expect_test "let+$% thing" = + prefix_test "let+$%" (`Logical (1, 6)); + [%expect "let+$%"] From 59e82fa74c3fbd2d63ddd6b792728b340807282a Mon Sep 17 00:00:00 2001 From: faldor20 Date: Mon, 25 Sep 2023 22:03:09 +1000 Subject: [PATCH 10/23] removed old prefix_parser --- ocaml-lsp-server/src/compl.ml | 77 ---------------------------------- ocaml-lsp-server/src/compl.mli | 3 -- 2 files changed, 80 deletions(-) diff --git a/ocaml-lsp-server/src/compl.ml b/ocaml-lsp-server/src/compl.ml index b7d69fbcd..57d690f40 100644 --- a/ocaml-lsp-server/src/compl.ml +++ b/ocaml-lsp-server/src/compl.ml @@ -26,83 +26,6 @@ let completion_kind kind : CompletionItemKind.t option = | `Constructor -> Some Constructor | `Type -> Some TypeParameter -(* I should just rewrite all of this so that it uses a nice for loop. This - current soluction is a nice try but overall crap we need to be able to look - ahead and behind - - Split it into name and infix name is obvious infix can be either a dot, a - label or an I could possibly do a regex based parser. - - Name regex: ((\w)|\w.)*$ *) - -let prefix_of_position_old ~short_path source position = - match Msource.text source with - | "" -> "" - | text -> - let from = - let (`Offset index) = Msource.get_offset source position in - min (String.length text - 1) (index - 1) - in - let pos = - let should_terminate = ref false in - let has_seen_dot = ref false in - let is_prefix_char c = - if !should_terminate then false - else - match c with - | 'a' .. 'z' - | 'A' .. 'Z' - | '0' .. '9' - | '\'' - | '_' - (* Infix function characters *) - | '$' - | '&' - | '*' - | '+' - | '-' - | '/' - | '=' - | '>' - | '@' - | '^' - | '!' - | '?' - | '%' - | '<' - | ':' - | '~' - | '#' -> true - | '`' -> - if !has_seen_dot then false - else ( - should_terminate := true; - true) - | '.' -> - has_seen_dot := true; - not short_path - | _ -> false - in - String.rfindi text ~from ~f:(fun c -> not (is_prefix_char c)) - in - let pos = - match pos with - | None -> 0 - | Some pos -> pos + 1 - in - let len = from - pos + 1 in - let reconstructed_prefix = String.sub text ~pos ~len in - (* if we reconstructed [~f:ignore] or [?f:ignore], we should take only - [ignore], so: *) - if - String.is_prefix reconstructed_prefix ~prefix:"~" - || String.is_prefix reconstructed_prefix ~prefix:"?" - then - match String.lsplit2 reconstructed_prefix ~on:':' with - | Some (_, s) -> s - | None -> reconstructed_prefix - else reconstructed_prefix - let prefix_of_position ~short_path source position = let open Prefix_parser in match Msource.text source with diff --git a/ocaml-lsp-server/src/compl.mli b/ocaml-lsp-server/src/compl.mli index b595844a1..589bd6600 100644 --- a/ocaml-lsp-server/src/compl.mli +++ b/ocaml-lsp-server/src/compl.mli @@ -40,9 +40,6 @@ val resolve : val prefix_of_position : short_path:bool -> Msource.t -> [< Msource.position ] -> string -val prefix_of_position_old : - short_path:bool -> Msource.t -> [< Msource.position ] -> string - (** [reconstruct_ident source position] returns the identifier at [position]. Note: [position] can be in the middle of the identifier. From a4c690b118129bcb2f5eb3a60cb3a52bfc642660 Mon Sep 17 00:00:00 2001 From: faldor20 Date: Mon, 2 Oct 2023 04:58:55 +1000 Subject: [PATCH 11/23] renamed regexes --- ocaml-lsp-server/src/prefix_parser.ml | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/ocaml-lsp-server/src/prefix_parser.ml b/ocaml-lsp-server/src/prefix_parser.ml index 8ea6f1dd0..224da76f7 100644 --- a/ocaml-lsp-server/src/prefix_parser.ml +++ b/ocaml-lsp-server/src/prefix_parser.ml @@ -1,12 +1,13 @@ open Re (*Regex based parser*) +let whiteSpace = set "\n\t " let name_char = Re.alt [ rg 'a' 'z'; rg 'A' 'Z'; rg '0' '9'; char '_'; char '\'' ] let name_with_dot = - Re.seq [ char ' ' |> rep; char '.'; char ' ' |> rep; name_char ] + Re.seq [ whiteSpace |> rep; char '.'; whiteSpace |> rep; name_char ] let core_operator_str = {|$&*+-/=>@^||} @@ -14,7 +15,7 @@ let operator = core_operator_str ^ {|~!?%<:.|} let infix = set (operator ^ "#") -let name_or_label_regex_rev_2 = +let name_or_label = compile (seq [ start @@ -24,7 +25,7 @@ let name_or_label_regex_rev_2 = (** matches let%lwt and let* style expressions. See here:https://v2.ocaml.org/manual/bindingops.html *) -let monadic_bind_rev_2 = +let monadic_bind = compile (seq [ start @@ -32,7 +33,7 @@ let monadic_bind_rev_2 = ; alt [ str "tel"; str "dna" ] ]) -let infix_regex_rev_2 = compile (seq [ start; infix |> rep1 ]) +let infix_operator = compile (seq [ start; infix |> rep1 ]) open Import @@ -47,8 +48,8 @@ end let try_parse_with_regex text = let matched = - Re.exec_opt name_or_label_regex_rev_2 text - |> Option.none_bind (fun () -> Re.exec_opt monadic_bind_rev_2 text) - |> Option.none_bind (fun () -> Re.exec_opt infix_regex_rev_2 text) + Re.exec_opt name_or_label text + |> Option.none_bind (fun () -> Re.exec_opt monadic_bind text) + |> Option.none_bind (fun () -> Re.exec_opt infix_operator text) in matched |> Option.map ~f:(fun x -> Group.get x 0) From abb05c9543e51a55b5ceaf063204f5b75f268677 Mon Sep 17 00:00:00 2001 From: faldor20 Date: Mon, 2 Oct 2023 05:12:40 +1000 Subject: [PATCH 12/23] Removed unnecessary Option extension --- ocaml-lsp-server/src/prefix_parser.ml | 17 +++++------------ 1 file changed, 5 insertions(+), 12 deletions(-) diff --git a/ocaml-lsp-server/src/prefix_parser.ml b/ocaml-lsp-server/src/prefix_parser.ml index 224da76f7..bf959283c 100644 --- a/ocaml-lsp-server/src/prefix_parser.ml +++ b/ocaml-lsp-server/src/prefix_parser.ml @@ -37,19 +37,12 @@ let infix_operator = compile (seq [ start; infix |> rep1 ]) open Import -module Option = struct - include Option - - let none_bind func option = - match option with - | None -> func () - | Some x -> Some x -end - let try_parse_with_regex text = + (*Attempt to match each of our possible prefix types, the order is important + because there is some overlap between the regexs*) let matched = - Re.exec_opt name_or_label text - |> Option.none_bind (fun () -> Re.exec_opt monadic_bind text) - |> Option.none_bind (fun () -> Re.exec_opt infix_operator text) + List.find_map + [ name_or_label; monadic_bind; infix_operator ] + ~f:(fun regex -> Re.exec_opt regex text) in matched |> Option.map ~f:(fun x -> Group.get x 0) From 5b07acac530b3c505fa9b4b33c3b50c598c6c4a4 Mon Sep 17 00:00:00 2001 From: faldor20 Date: Mon, 2 Oct 2023 05:12:59 +1000 Subject: [PATCH 13/23] spelling --- ocaml-lsp-server/src/import.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ocaml-lsp-server/src/import.ml b/ocaml-lsp-server/src/import.ml index 53a42c95d..a10e1a784 100644 --- a/ocaml-lsp-server/src/import.ml +++ b/ocaml-lsp-server/src/import.ml @@ -47,7 +47,7 @@ include struct let s : string = Buffer.contents buffer in s - (**reverses a stirng and maps over the content at the same time*) + (**reverses a string and maps over the content at the same time*) let rev_map str ~f = let string = Bytes.unsafe_of_string str in let len = Bytes.length string in From 96c104e8cf28e744884a6768be07584e1d7d1988 Mon Sep 17 00:00:00 2001 From: faldor20 Date: Mon, 2 Oct 2023 22:31:23 +1000 Subject: [PATCH 14/23] converted to forward regex for simplicity converted to forward regex --- ocaml-lsp-server/src/compl.ml | 14 +++++--------- ocaml-lsp-server/src/import.ml | 23 +++++------------------ ocaml-lsp-server/src/prefix_parser.ml | 18 ++++++++++-------- ocaml-lsp-server/src/prefix_parser.mli | 8 ++++---- 4 files changed, 24 insertions(+), 39 deletions(-) diff --git a/ocaml-lsp-server/src/compl.ml b/ocaml-lsp-server/src/compl.ml index 57d690f40..692fe2f40 100644 --- a/ocaml-lsp-server/src/compl.ml +++ b/ocaml-lsp-server/src/compl.ml @@ -1,6 +1,7 @@ open Import open Fiber.O + module Resolve = struct type t = CompletionParams.t @@ -35,22 +36,17 @@ let prefix_of_position ~short_path source position = let (`Offset index) = Msource.get_offset source position in min (String.length text - 1) (index - 1) in - let prefix_text = let pos = (*clamp the length of a line to process at 500 chars, this is just a reasonable limit for regex performance*) max 0 (end_of_prefix - 500) in - String.sub text ~pos ~len:(end_of_prefix + 1 - pos) - (*because all whitespace is semantically the same we convert it all to - spaces for easier regex matching*) - |> String.rev_map ~f:(fun x -> if x = '\n' || x = '\t' then ' ' else x) - in - + let reconstructed_prefix = - try_parse_with_regex prefix_text + try_parse_with_regex ~pos ~len:(end_of_prefix + 1 - pos) text |> Option.value ~default:"" - |> String.rev_filter ~f:(fun x -> x <> ' ') + (*We remove the whitespace because merlin expects no whitespace and it's semantically meaningless*) + |> String.filter (fun x -> not(x = ' '||x= '\n' ||x = '\t')) in if short_path then diff --git a/ocaml-lsp-server/src/import.ml b/ocaml-lsp-server/src/import.ml index a10e1a784..1ddf3f4b4 100644 --- a/ocaml-lsp-server/src/import.ml +++ b/ocaml-lsp-server/src/import.ml @@ -34,25 +34,12 @@ include struct module String = struct include String - (**reverses and Filters a string keeping any chars for which f returns true + (**Filters a string keeping any chars for which f returns true and discarding those for which it returns false*) - let rev_filter str ~f = - let buffer = Buffer.create (str |> String.length) in - let len = str |> String.length in - - for i = 0 to len - 1 do - let s = String.unsafe_get str (len - 1 - i) in - if f s then Buffer.add_char buffer s else () - done; - let s : string = Buffer.contents buffer in - s - - (**reverses a string and maps over the content at the same time*) - let rev_map str ~f = - let string = Bytes.unsafe_of_string str in - let len = Bytes.length string in - Bytes.init len ~f:(fun i -> f (Bytes.unsafe_get string (len - 1 - i))) - |> Bytes.unsafe_to_string + let filter f s = + let buf = Buffer.create (String.length s) in + iter ~f:(fun c -> if f c then Buffer.add_char buf c) s; + Buffer.contents buf let findi = let rec loop s len ~f i = diff --git a/ocaml-lsp-server/src/prefix_parser.ml b/ocaml-lsp-server/src/prefix_parser.ml index bf959283c..acc58c834 100644 --- a/ocaml-lsp-server/src/prefix_parser.ml +++ b/ocaml-lsp-server/src/prefix_parser.ml @@ -7,7 +7,7 @@ let name_char = Re.alt [ rg 'a' 'z'; rg 'A' 'Z'; rg '0' '9'; char '_'; char '\'' ] let name_with_dot = - Re.seq [ whiteSpace |> rep; char '.'; whiteSpace |> rep; name_char ] + Re.seq [ name_char;whiteSpace |> rep;char '.' ;whiteSpace |> rep;] let core_operator_str = {|$&*+-/=>@^||} @@ -18,9 +18,10 @@ let infix = set (operator ^ "#") let name_or_label = compile (seq - [ start + [ + alt [ set "~?``"; str "let%"; str "and%" ] |> opt ; alt [ name_char; name_with_dot ] |> rep1 - ; alt [ set "~?``"; str "%tel"; str "%dna" ] |> opt + ; stop ]) (** matches let%lwt and let* style expressions. See @@ -28,21 +29,22 @@ let name_or_label = let monadic_bind = compile (seq - [ start + [ + alt [ str "let"; str "and" ] ; alt [ infix |> rep1; seq [ name_char |> rep1; char '%' ] ] - ; alt [ str "tel"; str "dna" ] + ;stop ]) -let infix_operator = compile (seq [ start; infix |> rep1 ]) +let infix_operator = compile (seq [ infix |> rep1 ;stop]) open Import -let try_parse_with_regex text = +let try_parse_with_regex ?pos ?len text = (*Attempt to match each of our possible prefix types, the order is important because there is some overlap between the regexs*) let matched = List.find_map [ name_or_label; monadic_bind; infix_operator ] - ~f:(fun regex -> Re.exec_opt regex text) + ~f:(fun regex -> Re.exec_opt ?pos ?len regex text) in matched |> Option.map ~f:(fun x -> Group.get x 0) diff --git a/ocaml-lsp-server/src/prefix_parser.mli b/ocaml-lsp-server/src/prefix_parser.mli index 6a7b28422..7913dafd3 100644 --- a/ocaml-lsp-server/src/prefix_parser.mli +++ b/ocaml-lsp-server/src/prefix_parser.mli @@ -1,4 +1,4 @@ -(**Try's the parse the incoming string for a prefix. The string should be a - reversed copy of the line, starting at the position where the prefix ends and - continuing backwards from there. Does not handle whitespace other than spaces *) -val try_parse_with_regex : string -> string option +(**Try's the parse the incoming string for a prefix. The string should be the source code + ending at the prefix position. + pos and len set the range for the regex to operate on*) +val try_parse_with_regex : ?pos:int -> ?len:int -> string -> string option From cbaa820932050455e2241f2ce4574bddac22f1d5 Mon Sep 17 00:00:00 2001 From: faldor20 Date: Tue, 10 Oct 2023 02:18:55 +1000 Subject: [PATCH 15/23] Added Long file for benchmarking and removed unused benchmarks --- ocaml-lsp-server/bench/documents.ml | 98 +++++++++++++++++++++++ ocaml-lsp-server/bench/ocaml_lsp_bench.ml | 49 +++--------- 2 files changed, 109 insertions(+), 38 deletions(-) create mode 100644 ocaml-lsp-server/bench/documents.ml diff --git a/ocaml-lsp-server/bench/documents.ml b/ocaml-lsp-server/bench/documents.ml new file mode 100644 index 000000000..6b262e9e7 --- /dev/null +++ b/ocaml-lsp-server/bench/documents.ml @@ -0,0 +1,98 @@ +let document = + "let mem = ListLabels.mem\n\nlet _ = mem ~se" |> Merlin_kernel.Msource.make + +let long_document_text = + {|let prefix_of_position ~short_path source position = + let open Prefix_parser in + match Msource.text source with + | "" -> "" + | text -> + let end_of_prefix = + let (`Offset index) = Msource.get_offset source position in + min (String.length text - 1) (index - 1) + in + let prefix_text = + let pos = + (*clamp the length of a line to process at 500 chars, this is just a + reasonable limit for regex performance*) + max 0 (end_of_prefix - 500) + in + String.sub text ~pos ~len:(end_of_prefix + 1 - pos) + (*because all whitespace is semantically the same we convert it all to + spaces for easier regex matching*) + |> String.rev_map ~f:(fun x -> if x = '\n' || x = '\t' then ' ' else x) + in + + let reconstructed_prefix = + try_parse_with_regex prefix_text + |> Option.value ~default:"" + |> String.rev_filter ~f:(fun x -> x <> ' ') + in + + if short_path then + match String.split_on_char reconstructed_prefix ~sep:'.' |> List.last with + | Some s -> s + | None -> reconstructed_prefix + else reconstructed_prefix + +let suffix_of_position source position = + match Msource.text source with + | "" -> "" + | text -> + let (`Offset index) = Msource.get_offset source position in + let len = String.length text in + if index >= len then "" + else + let from = index in + let len = + let ident_char = function + | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '\'' | '_' -> true + | _ -> false + in + let until = + String.findi ~from text ~f:(fun c -> not (ident_char c)) + |> Option.value ~default:len + in + until - from + in + String.sub text ~pos:from ~len + +let reconstruct_ident source position = + let prefix = prefix_of_position ~short_path:false source position in + let suffix = suffix_of_position source position in + let ident = prefix ^ suffix in + Option.some_if (ident <> "") ident + +let range_prefix (lsp_position : Position.t) prefix : Range.t = + let start = + let len = String.length prefix in + let character = lsp_position.character - len in + { lsp_position with character } + in + { Range.start; end_ = lsp_position } + +let sortText_of_index idx = Printf.sprintf "%04d" idx + +module Complete_by_prefix = struct + let completionItem_of_completion_entry idx + (entry : Query_protocol.Compl.entry) ~compl_params ~range ~deprecated = + let kind = completion_kind entry.kind in + let textEdit = `TextEdit { TextEdit.range; newText = entry.name } in + CompletionItem.create + ~label:entry.name + ?kind + ~detail:entry.desc + ?deprecated:(Option.some_if deprecated entry.deprecated) + (* Without this field the client is not forced to respect the order + provided by merlin. *) + ~sortText:(sortText_of_index idx) + ?data:compl_params + ~textEdit + () + + let dispatch_cmd ~prefix position pipeline = + let complete = + Query_protocol.Complete_prefix (prefix, position, [], false, true) + in + Query_commands.dispatch pipeline comp + |} diff --git a/ocaml-lsp-server/bench/ocaml_lsp_bench.ml b/ocaml-lsp-server/bench/ocaml_lsp_bench.ml index caba0337d..3f7a8145f 100644 --- a/ocaml-lsp-server/bench/ocaml_lsp_bench.ml +++ b/ocaml-lsp-server/bench/ocaml_lsp_bench.ml @@ -1,57 +1,30 @@ +open Ocaml_lsp_server + + + open Core open Core_bench -open Ocaml_lsp_server let () = - let document = - "let mem = ListLabels.mem\n\nlet _ = mem ~se" |> Merlin_kernel.Msource.make - in - let long_document_text = - "pam .tsiL se~\n\ - \ arosietnaorisetnoarisent\n\ - \ arsotienarositen\n\ - \ arsotinarsotienarst\n\ - \ aoris noarisetnaoiresnt aorisent aoierns\n\ - \ ast. rienrst .rst \n\ - \ let b a= 5234 n oienar. rsoien . iri i... r\n\ - \ !@#&984@#$ <><|||>>\n\ - \ let mem = ListLabels.mem\n\n\ - let _ = mem ~se" - in + let open Documents in let long_document = long_document_text |> Merlin_kernel.Msource.make in - let position = `Logical (3, 15) in + let long_position = `Logical (92, 41) in Command_unix.run (Bench.make_command - [ Bench.Test.create ~name:"regex" (fun _ -> + [ Bench.Test.create ~name:"get_prefix" (fun _ -> Testing.Compl.prefix_of_position ~short_path:false document position |> ignore) - ; Bench.Test.create ~name:"regex_long" (fun _ -> + ; Bench.Test.create ~name:"get_prefix_long" (fun _ -> Testing.Compl.prefix_of_position ~short_path:false long_document - position - |> ignore) - ; Bench.Test.create ~name:"regex_only" (fun _ -> - Testing.Prefix_parser.try_parse_with_regex - (document |> Merlin_kernel.Msource.text) + long_position |> ignore) - ; Bench.Test.create ~name:"regex_only_long" (fun _ -> - Testing.Prefix_parser.try_parse_with_regex long_document_text - |> ignore) - ; Bench.Test.create ~name:"old" (fun _ -> - Testing.Compl.prefix_of_position_old - ~short_path:false - document - position - |> ignore) - ; Bench.Test.create ~name:"old_long" (fun _ -> - Testing.Compl.prefix_of_position_old - ~short_path:false - document - position + ; Bench.Test.create ~name:"get_offset_long" (fun _ -> + Merlin_kernel.Msource.get_offset long_document long_position |> ignore) ]) From 26476a65670940c564360de032d695a3293470de Mon Sep 17 00:00:00 2001 From: faldor20 Date: Tue, 10 Oct 2023 06:45:36 +1000 Subject: [PATCH 16/23] Initial code for new-e2e tests for completion --- ocaml-lsp-server/test/e2e-new/code_actions.ml | 59 +++---------------- ocaml-lsp-server/test/e2e-new/completion.ml | 54 +++++++++++++++++ ocaml-lsp-server/test/e2e-new/dune | 1 + ocaml-lsp-server/test/e2e-new/lsp_helpers.ml | 57 ++++++++++++++++++ 4 files changed, 119 insertions(+), 52 deletions(-) create mode 100644 ocaml-lsp-server/test/e2e-new/completion.ml create mode 100644 ocaml-lsp-server/test/e2e-new/lsp_helpers.ml diff --git a/ocaml-lsp-server/test/e2e-new/code_actions.ml b/ocaml-lsp-server/test/e2e-new/code_actions.ml index 41789e39e..d0e91331e 100644 --- a/ocaml-lsp-server/test/e2e-new/code_actions.ml +++ b/ocaml-lsp-server/test/e2e-new/code_actions.ml @@ -1,58 +1,13 @@ open Test.Import +open Lsp_helpers -let openDocument ~client ~uri ~source = - let textDocument = - TextDocumentItem.create ~uri ~languageId:"ocaml" ~version:0 ~text:source - in - Client.notification - client - (TextDocumentDidOpen (DidOpenTextDocumentParams.create ~textDocument)) - -let iter_code_actions ?(prep = fun _ -> Fiber.return ()) ?(path = "foo.ml") - ?(diagnostics = []) ~source range k = - let got_diagnostics = Fiber.Ivar.create () in - let handler = - Client.Handler.make - ~on_notification: - (fun _ -> function - | PublishDiagnostics _ -> ( - let* diag = Fiber.Ivar.peek got_diagnostics in - match diag with - | Some _ -> Fiber.return () - | None -> Fiber.Ivar.fill got_diagnostics ()) - | _ -> Fiber.return ()) - () - in - Test.run ~handler @@ fun client -> - let run_client () = - let capabilities = - let window = - let showDocument = - ShowDocumentClientCapabilities.create ~support:true - in - WindowClientCapabilities.create ~showDocument () - in - ClientCapabilities.create ~window () - in - Client.start client (InitializeParams.create ~capabilities ()) - in - let run = - let* (_ : InitializeResult.t) = Client.initialized client in - let uri = DocumentUri.of_path path in - let* () = prep client in - let* () = openDocument ~client ~uri ~source in - let+ resp = - let context = CodeActionContext.create ~diagnostics () in - let request = - let textDocument = TextDocumentIdentifier.create ~uri in - CodeActionParams.create ~textDocument ~range ~context () - in - Client.request client (CodeAction request) - in - k resp +let iter_code_actions ?prep ?path ?(diagnostics = []) ~source range = + let makeRequest textDocument = + let context = CodeActionContext.create ~diagnostics () in + Lsp.Client_request.CodeAction + (CodeActionParams.create ~textDocument ~range ~context ()) in - Fiber.fork_and_join_unit run_client (fun () -> - run >>> Fiber.Ivar.read got_diagnostics >>> Client.stop client) + iter_LspResponse ?prep ?path ~makeRequest ~source let print_code_actions ?(prep = fun _ -> Fiber.return ()) ?(path = "foo.ml") ?(filter = fun _ -> true) source range = diff --git a/ocaml-lsp-server/test/e2e-new/completion.ml b/ocaml-lsp-server/test/e2e-new/completion.ml new file mode 100644 index 000000000..83c8440c3 --- /dev/null +++ b/ocaml-lsp-server/test/e2e-new/completion.ml @@ -0,0 +1,54 @@ +open Test.Import + +let iter_completions ?prep ?path ?(triggerCharacter = "") + ?(triggerKind = CompletionTriggerKind.Invoked) ~position = + let makeRequest textDocument = + let context = CompletionContext.create ~triggerCharacter ~triggerKind () in + Lsp.Client_request.TextDocumentCompletion + (CompletionParams.create ~textDocument ~position ~context ()) + in + Lsp_helpers.iter_LspResponse ?prep ?path ~makeRequest + +let print_completions ?(prep = fun _ -> Fiber.return ()) ?(path = "foo.ml") + ?(filter = fun _ -> true) source position = + iter_completions ~prep ~path ~source ~position (function + | None -> print_endline "No completion Items" + | Some completions -> ( + let items = + match completions with + | `CompletionList comp -> comp.items + | `List comp -> comp + in + items |> List.filter ~f:filter |> function + | [] -> print_endline "No completions" + | items -> + print_endline "Completions:"; + List.iter items ~f:(fun item -> + item |> CompletionItem.yojson_of_t + |> Yojson.Safe.pretty_to_string ~std:false + |> print_endline))) + +let%expect_test "completions" = + let source = {ocaml| +let testNum=11 in +test +|ocaml} in + let position = Position.create ~line:2 ~character:4 in + print_completions source position; + [%expect + {| +Completions: +{ + "detail": "int", + "kind": 12, + "label": "testNum", + "sortText": "0000", + "textEdit": { + "newText": "testNum", + "range": { + "end": { "character": 4, "line": 2 }, + "start": { "character": 0, "line": 2 } + } + } +} +|}] diff --git a/ocaml-lsp-server/test/e2e-new/dune b/ocaml-lsp-server/test/e2e-new/dune index 8dcc1dd78..af95fd801 100644 --- a/ocaml-lsp-server/test/e2e-new/dune +++ b/ocaml-lsp-server/test/e2e-new/dune @@ -43,6 +43,7 @@ action_inline action_mark_remove code_actions + completion doc_to_md document_flow for_ppx diff --git a/ocaml-lsp-server/test/e2e-new/lsp_helpers.ml b/ocaml-lsp-server/test/e2e-new/lsp_helpers.ml new file mode 100644 index 000000000..47691f366 --- /dev/null +++ b/ocaml-lsp-server/test/e2e-new/lsp_helpers.ml @@ -0,0 +1,57 @@ +open Test.Import + +(**Opens a document with the language server. This must be done before trying to access it*) +let openDocument ~client ~uri ~source = + let textDocument = + TextDocumentItem.create ~uri ~languageId:"ocaml" ~version:0 ~text:source + in + Client.notification + client + (TextDocumentDidOpen (DidOpenTextDocumentParams.create ~textDocument)) + +(**Performs the request you return from the makeRequest function and then gives it the the handler function + you provide*) +let iter_LspResponse ?(prep = fun _ -> Fiber.return ()) ?(path = "foo.ml") + ~makeRequest ~source k = + let got_diagnostics = Fiber.Ivar.create () in + let handler = + Client.Handler.make + ~on_notification:(fun _ -> function + | PublishDiagnostics _ -> ( + let* diag = Fiber.Ivar.peek got_diagnostics in + match diag with + | Some _ -> Fiber.return () + | None -> Fiber.Ivar.fill got_diagnostics ()) + | _ -> Fiber.return ()) + () + in + Test.run ~handler @@ fun client -> + let run_client () = + let capabilities = + let window = + let showDocument = + ShowDocumentClientCapabilities.create ~support:true + in + WindowClientCapabilities.create ~showDocument () + in + ClientCapabilities.create ~window () + in + Client.start client (InitializeParams.create ~capabilities ()) + in + let run = + let* (_ : InitializeResult.t) = Client.initialized client in + let uri = DocumentUri.of_path path in + let* () = prep client in + let* () = openDocument ~client ~uri ~source in + let+ resp = + let request = + let textDocument = TextDocumentIdentifier.create ~uri in + makeRequest textDocument + in + + Client.request client request + in + k resp + in + Fiber.fork_and_join_unit run_client (fun () -> + run >>> Fiber.Ivar.read got_diagnostics >>> Client.stop client) From 766509c7891ca4add5f18882327baba3602221b6 Mon Sep 17 00:00:00 2001 From: faldor20 Date: Tue, 10 Oct 2023 21:13:56 +1000 Subject: [PATCH 17/23] Finished adding completion tests --- ocaml-lsp-server/test/e2e-new/completion.ml | 939 +++++++++++++++++++- 1 file changed, 933 insertions(+), 6 deletions(-) diff --git a/ocaml-lsp-server/test/e2e-new/completion.ml b/ocaml-lsp-server/test/e2e-new/completion.ml index 83c8440c3..49981cece 100644 --- a/ocaml-lsp-server/test/e2e-new/completion.ml +++ b/ocaml-lsp-server/test/e2e-new/completion.ml @@ -10,7 +10,7 @@ let iter_completions ?prep ?path ?(triggerCharacter = "") Lsp_helpers.iter_LspResponse ?prep ?path ~makeRequest let print_completions ?(prep = fun _ -> Fiber.return ()) ?(path = "foo.ml") - ?(filter = fun _ -> true) source position = + ?(limit = 10) ?(pre_print = fun x -> x) source position = iter_completions ~prep ~path ~source ~position (function | None -> print_endline "No completion Items" | Some completions -> ( @@ -19,14 +19,19 @@ let print_completions ?(prep = fun _ -> Fiber.return ()) ?(path = "foo.ml") | `CompletionList comp -> comp.items | `List comp -> comp in - items |> List.filter ~f:filter |> function + items |> pre_print |> function | [] -> print_endline "No completions" | items -> print_endline "Completions:"; - List.iter items ~f:(fun item -> - item |> CompletionItem.yojson_of_t - |> Yojson.Safe.pretty_to_string ~std:false - |> print_endline))) + + let originalLength = List.length items in + items + |> List.take (min limit originalLength) + |> List.iter ~f:(fun item -> + item |> CompletionItem.yojson_of_t + |> Yojson.Safe.pretty_to_string ~std:false + |> print_endline); + if originalLength > limit then print_endline ".............")) let%expect_test "completions" = let source = {ocaml| @@ -52,3 +57,925 @@ Completions: } } |}] + +let%expect_test "can start completion after operator with space" = + let source = {ocaml|[1;2] |> List.ma|ocaml} in + let position = Position.create ~line:0 ~character:16 in + print_completions source position; + [%expect + {| + Completions: + { + "detail": "('a -> 'b) -> 'a list -> 'b list", + "kind": 12, + "label": "map", + "sortText": "0000", + "textEdit": { + "newText": "map", + "range": { + "end": { "character": 16, "line": 0 }, + "start": { "character": 14, "line": 0 } + } + } + } + { + "detail": "(int -> 'a -> 'b) -> 'a list -> 'b list", + "kind": 12, + "label": "mapi", + "sortText": "0001", + "textEdit": { + "newText": "mapi", + "range": { + "end": { "character": 16, "line": 0 }, + "start": { "character": 14, "line": 0 } + } + } + } + { + "detail": "('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list", + "kind": 12, + "label": "map2", + "sortText": "0002", + "textEdit": { + "newText": "map2", + "range": { + "end": { "character": 16, "line": 0 }, + "start": { "character": 14, "line": 0 } + } + } + } + |}] + +let%expect_test "can start completion in dot chain with newline" = + let source = {ocaml|[1;2] |> List. +ma|ocaml} in + let position = Position.create ~line:1 ~character:2 in + print_completions source position; + [%expect + {| + Completions: + { + "detail": "('a -> 'b) -> 'a list -> 'b list", + "kind": 12, + "label": "map", + "sortText": "0000", + "textEdit": { + "newText": "map", + "range": { + "end": { "character": 2, "line": 1 }, + "start": { "character": 0, "line": 1 } + } + } + } + { + "detail": "(int -> 'a -> 'b) -> 'a list -> 'b list", + "kind": 12, + "label": "mapi", + "sortText": "0001", + "textEdit": { + "newText": "mapi", + "range": { + "end": { "character": 2, "line": 1 }, + "start": { "character": 0, "line": 1 } + } + } + } + { + "detail": "('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list", + "kind": 12, + "label": "map2", + "sortText": "0002", + "textEdit": { + "newText": "map2", + "range": { + "end": { "character": 2, "line": 1 }, + "start": { "character": 0, "line": 1 } + } + } + } + |}] + +let%expect_test "can start completion in dot chain with newline" = + let source = {ocaml|[1;2] |> List. +ma|ocaml} in + let position = Position.create ~line:1 ~character:2 in + print_completions source position; + [%expect + {| + Completions: + { + "detail": "('a -> 'b) -> 'a list -> 'b list", + "kind": 12, + "label": "map", + "sortText": "0000", + "textEdit": { + "newText": "map", + "range": { + "end": { "character": 2, "line": 1 }, + "start": { "character": 0, "line": 1 } + } + } + } + { + "detail": "(int -> 'a -> 'b) -> 'a list -> 'b list", + "kind": 12, + "label": "mapi", + "sortText": "0001", + "textEdit": { + "newText": "mapi", + "range": { + "end": { "character": 2, "line": 1 }, + "start": { "character": 0, "line": 1 } + } + } + } + { + "detail": "('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list", + "kind": 12, + "label": "map2", + "sortText": "0002", + "textEdit": { + "newText": "map2", + "range": { + "end": { "character": 2, "line": 1 }, + "start": { "character": 0, "line": 1 } + } + } + } + |}] + +let%expect_test "can start completion after dereference" = + let source = {ocaml|let apple=ref 10 in +!ap|ocaml} in + let position = Position.create ~line:1 ~character:3 in + print_completions source position; + [%expect + {| + Completions: + { + "detail": "int ref", + "kind": 12, + "label": "apple", + "sortText": "0000", + "textEdit": { + "newText": "apple", + "range": { + "end": { "character": 3, "line": 1 }, + "start": { "character": 1, "line": 1 } + } + } + } + |}] + +let%expect_test "can complete symbol passed as a named argument" = + let source = {ocaml|let g ~f = f 0 in +g ~f:ig|ocaml} in + let position = Position.create ~line:1 ~character:7 in + print_completions source position; + [%expect + {| + Completions: + { + "detail": "'a -> unit", + "kind": 12, + "label": "ignore", + "sortText": "0000", + "textEdit": { + "newText": "ignore", + "range": { + "end": { "character": 7, "line": 1 }, + "start": { "character": 5, "line": 1 } + } + } + } + |}] + +let%expect_test "can complete symbol passed as a named argument - 2" = + let source = + {ocaml|module M = struct let igfoo _x = () end +let g ~f = f 0 in +g ~f:M.ig|ocaml} + in + let position = Position.create ~line:2 ~character:9 in + print_completions source position; + [%expect + {| + Completions: + { + "detail": "'a -> unit", + "kind": 12, + "label": "igfoo", + "sortText": "0000", + "textEdit": { + "newText": "igfoo", + "range": { + "end": { "character": 9, "line": 2 }, + "start": { "character": 7, "line": 2 } + } + } + } + |}] + +let%expect_test "can complete symbol passed as an optional argument - 2" = + let source = + {ocaml|module M = struct let igfoo _x = () end +let g ?f = f in +g ?f:M.ig|ocaml} + in + let position = Position.create ~line:2 ~character:9 in + print_completions source position; + [%expect + {| + Completions: + { + "detail": "'a -> unit", + "kind": 12, + "label": "igfoo", + "sortText": "0000", + "textEdit": { + "newText": "igfoo", + "range": { + "end": { "character": 9, "line": 2 }, + "start": { "character": 7, "line": 2 } + } + } + } + |}] + +let%expect_test "completes identifier after completion-triggering character" = + let source = + {ocaml| +module Test = struct + let somenum = 42 + let somestring = "hello" +end + +let x = Test. + |ocaml} + in + let position = Position.create ~line:6 ~character:13 in + print_completions source position; + [%expect + {| + Completions: + { + "detail": "int", + "kind": 12, + "label": "somenum", + "sortText": "0000", + "textEdit": { + "newText": "somenum", + "range": { + "end": { "character": 13, "line": 6 }, + "start": { "character": 13, "line": 6 } + } + } + } + { + "detail": "string", + "kind": 12, + "label": "somestring", + "sortText": "0001", + "textEdit": { + "newText": "somestring", + "range": { + "end": { "character": 13, "line": 6 }, + "start": { "character": 13, "line": 6 } + } + } + } + |}] + +let%expect_test "completes infix operators" = + let source = {ocaml| +let (>>|) = (+) +let y = 1 > +|ocaml} in + let position = Position.create ~line:2 ~character:11 in + print_completions source position; + [%expect + {| + Completions: + { + "detail": "int -> int -> int", + "kind": 12, + "label": ">>|", + "sortText": "0000", + "textEdit": { + "newText": ">>|", + "range": { + "end": { "character": 11, "line": 2 }, + "start": { "character": 10, "line": 2 } + } + } + } + { + "detail": "'a -> 'a -> bool", + "kind": 12, + "label": ">", + "sortText": "0001", + "textEdit": { + "newText": ">", + "range": { + "end": { "character": 11, "line": 2 }, + "start": { "character": 10, "line": 2 } + } + } + } + { + "detail": "'a -> 'a -> bool", + "kind": 12, + "label": ">=", + "sortText": "0002", + "textEdit": { + "newText": ">=", + "range": { + "end": { "character": 11, "line": 2 }, + "start": { "character": 10, "line": 2 } + } + } + } + |}] + +let%expect_test "completes without prefix" = + let source = + {ocaml| +let somenum = 42 +let somestring = "hello" + +let plus_42 (x:int) (y:int) = + somenum + +|ocaml} + in + let position = Position.create ~line:5 ~character:12 in + print_completions source position; + [%expect + {| + Completions: + { + "detail": "int", + "kind": 12, + "label": "somenum", + "sortText": "0000", + "textEdit": { + "newText": "somenum", + "range": { + "end": { "character": 12, "line": 5 }, + "start": { "character": 12, "line": 5 } + } + } + } + { + "detail": "int", + "kind": 12, + "label": "x", + "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", + "range": { + "end": { "character": 12, "line": 5 }, + "start": { "character": 12, "line": 5 } + } + } + } + { + "detail": "char -> int", + "kind": 12, + "label": "int_of_char", + "sortText": "0009", + "textEdit": { + "newText": "int_of_char", + "range": { + "end": { "character": 12, "line": 5 }, + "start": { "character": 12, "line": 5 } + } + } + } + ............. + |}] + +let%expect_test "completes labels" = + let source = {ocaml|let f = ListLabels.map ~|ocaml} in + let position = Position.create ~line:0 ~character:24 in + print_completions source position; + [%expect + {| + Completions: + { + "detail": "int -> int", + "kind": 12, + "label": "~+", + "sortText": "0000", + "textEdit": { + "newText": "~+", + "range": { + "end": { "character": 24, "line": 0 }, + "start": { "character": 23, "line": 0 } + } + } + } + { + "detail": "float -> float", + "kind": 12, + "label": "~+.", + "sortText": "0001", + "textEdit": { + "newText": "~+.", + "range": { + "end": { "character": 24, "line": 0 }, + "start": { "character": 23, "line": 0 } + } + } + } + { + "detail": "int -> int", + "kind": 12, + "label": "~-", + "sortText": "0002", + "textEdit": { + "newText": "~-", + "range": { + "end": { "character": 24, "line": 0 }, + "start": { "character": 23, "line": 0 } + } + } + } + { + "detail": "float -> float", + "kind": 12, + "label": "~-.", + "sortText": "0003", + "textEdit": { + "newText": "~-.", + "range": { + "end": { "character": 24, "line": 0 }, + "start": { "character": 23, "line": 0 } + } + } + } + { + "detail": "'a -> 'b", + "kind": 5, + "label": "~f", + "sortText": "0004", + "textEdit": { + "newText": "~f", + "range": { + "end": { "character": 24, "line": 0 }, + "start": { "character": 23, "line": 0 } + } + } + } + |}] + +let%expect_test "works for polymorphic variants - function application context \ + - 1" = + let source = + {ocaml| +let f (_a: [`String | `Int of int]) = () + +let u = f `Str + |ocaml} + in + let position = Position.create ~line:3 ~character:14 in + print_completions source position; + [%expect + {| + Completions: + { + "detail": "`String", + "kind": 20, + "label": "`String", + "sortText": "0000", + "textEdit": { + "newText": "`String", + "range": { + "end": { "character": 14, "line": 3 }, + "start": { "character": 10, "line": 3 } + } + } + } + |}] + +let%expect_test "works for polymorphic variants - function application context \ + - 2" = + let source = + {ocaml| +let f (_a: [`String | `Int of int]) = () + +let u = f `In + |ocaml} + in + let position = Position.create ~line:3 ~character:13 in + print_completions source position; + [%expect + {| + Completions: + { + "detail": "`Int of int", + "kind": 20, + "label": "`Int", + "sortText": "0000", + "textEdit": { + "newText": "`Int", + "range": { + "end": { "character": 13, "line": 3 }, + "start": { "character": 10, "line": 3 } + } + } + } + |}] + +let%expect_test "works for polymorphic variants" = + let source = {ocaml| +type t = [ `Int | `String ] + +let x : t = `I + |ocaml} in + let position = Position.create ~line:3 ~character:15 in + print_completions source position; + [%expect + {| + Completions: + { + "detail": "`Int", + "kind": 20, + "label": "`Int", + "sortText": "0000", + "textEdit": { + "newText": "`Int", + "range": { + "end": { "character": 15, "line": 3 }, + "start": { "character": 13, "line": 3 } + } + } + } + |}] + +let%expect_test "completion for holes" = + let source = {ocaml|let u : int = _|ocaml} in + let position = Position.create ~line:0 ~character:15 in + let filter = + List.filter ~f:(fun (item : CompletionItem.t) -> + not (String.starts_with ~prefix:"__" item.label)) + in + print_completions ~pre_print:filter source position; + [%expect + {| + Completions: + { + "filterText": "_0", + "kind": 1, + "label": "0", + "sortText": "0000", + "textEdit": { + "newText": "0", + "range": { + "end": { "character": 15, "line": 0 }, + "start": { "character": 14, "line": 0 } + } + } + } + |}] + +let%expect_test "completes identifier at top level" = + let source = + {ocaml| +let somenum = 42 +let somestring = "hello" + +let () = + some +|ocaml} + in + let position = Position.create ~line:5 ~character:6 in + print_completions source position; + [%expect + {| + Completions: + { + "detail": "int", + "kind": 12, + "label": "somenum", + "sortText": "0000", + "textEdit": { + "newText": "somenum", + "range": { + "end": { "character": 6, "line": 5 }, + "start": { "character": 2, "line": 5 } + } + } + } + { + "detail": "string", + "kind": 12, + "label": "somestring", + "sortText": "0001", + "textEdit": { + "newText": "somestring", + "range": { + "end": { "character": 6, "line": 5 }, + "start": { "character": 2, "line": 5 } + } + } + } + |}] + +let%expect_test "completes from a module" = + let source = {ocaml|let f = List.m|ocaml} in + let position = Position.create ~line:0 ~character:14 in + print_completions source position; + [%expect + {| + Completions: + { + "detail": "('a -> 'b) -> 'a list -> 'b list", + "kind": 12, + "label": "map", + "sortText": "0000", + "textEdit": { + "newText": "map", + "range": { + "end": { "character": 14, "line": 0 }, + "start": { "character": 13, "line": 0 } + } + } + } + { + "detail": "('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list", + "kind": 12, + "label": "map2", + "sortText": "0001", + "textEdit": { + "newText": "map2", + "range": { + "end": { "character": 14, "line": 0 }, + "start": { "character": 13, "line": 0 } + } + } + } + { + "detail": "(int -> 'a -> 'b) -> 'a list -> 'b list", + "kind": 12, + "label": "mapi", + "sortText": "0002", + "textEdit": { + "newText": "mapi", + "range": { + "end": { "character": 14, "line": 0 }, + "start": { "character": 13, "line": 0 } + } + } + } + { + "detail": "'a -> 'a list -> bool", + "kind": 12, + "label": "mem", + "sortText": "0003", + "textEdit": { + "newText": "mem", + "range": { + "end": { "character": 14, "line": 0 }, + "start": { "character": 13, "line": 0 } + } + } + } + { + "detail": "'a -> ('a * 'b) list -> bool", + "kind": 12, + "label": "mem_assoc", + "sortText": "0004", + "textEdit": { + "newText": "mem_assoc", + "range": { + "end": { "character": 14, "line": 0 }, + "start": { "character": 13, "line": 0 } + } + } + } + { + "detail": "'a -> ('a * 'b) list -> bool", + "kind": 12, + "label": "mem_assq", + "sortText": "0005", + "textEdit": { + "newText": "mem_assq", + "range": { + "end": { "character": 14, "line": 0 }, + "start": { "character": 13, "line": 0 } + } + } + } + { + "detail": "'a -> 'a list -> bool", + "kind": 12, + "label": "memq", + "sortText": "0006", + "textEdit": { + "newText": "memq", + "range": { + "end": { "character": 14, "line": 0 }, + "start": { "character": 13, "line": 0 } + } + } + } + { + "detail": "('a -> 'a -> int) -> 'a list -> 'a list -> 'a list", + "kind": 12, + "label": "merge", + "sortText": "0007", + "textEdit": { + "newText": "merge", + "range": { + "end": { "character": 14, "line": 0 }, + "start": { "character": 13, "line": 0 } + } + } + }|}] + +let%expect_test "completes a module name" = + let source = {ocaml|let f = L|ocaml} in + let position = Position.create ~line:0 ~character:9 in + print_completions ~pre_print:(List.take 5) source position; + [%expect + {| + Completions: + { + "detail": "", + "kind": 9, + "label": "LargeFile", + "sortText": "0000", + "textEdit": { + "newText": "LargeFile", + "range": { + "end": { "character": 9, "line": 0 }, + "start": { "character": 8, "line": 0 } + } + } + } + { + "detail": "", + "kind": 9, + "label": "Lazy", + "sortText": "0001", + "textEdit": { + "newText": "Lazy", + "range": { + "end": { "character": 9, "line": 0 }, + "start": { "character": 8, "line": 0 } + } + } + } + { + "detail": "", + "kind": 9, + "label": "Lexing", + "sortText": "0002", + "textEdit": { + "newText": "Lexing", + "range": { + "end": { "character": 9, "line": 0 }, + "start": { "character": 8, "line": 0 } + } + } + } + { + "detail": "", + "kind": 9, + "label": "List", + "sortText": "0003", + "textEdit": { + "newText": "List", + "range": { + "end": { "character": 9, "line": 0 }, + "start": { "character": 8, "line": 0 } + } + } + } + { + "detail": "", + "kind": 9, + "label": "ListLabels", + "sortText": "0004", + "textEdit": { + "newText": "ListLabels", + "range": { + "end": { "character": 9, "line": 0 }, + "start": { "character": 8, "line": 0 } + } + } + } + |}] + +let%expect_test "completion doesn't autocomplete record fields" = + let source = + {ocaml| + type r = { + x: int; + y: string + } + + let _ = + |ocaml} + in + let position = Position.create ~line:5 ~character:8 in + print_completions + ~pre_print: + (List.filter ~f:(fun (compl : CompletionItem.t) -> + compl.label = "x" || compl.label = "y")) + source + position; + + (* We expect 0 completions*) + [%expect {| No completions |}] From 0fbea392966eee6ca76723ef57e1f42ee784f772 Mon Sep 17 00:00:00 2001 From: faldor20 Date: Tue, 10 Oct 2023 22:50:50 +1000 Subject: [PATCH 18/23] converted last few missed tests --- ocaml-lsp-server/test/e2e-new/completion.ml | 309 ++++++++++++++++---- 1 file changed, 246 insertions(+), 63 deletions(-) diff --git a/ocaml-lsp-server/test/e2e-new/completion.ml b/ocaml-lsp-server/test/e2e-new/completion.ml index 49981cece..bdeee06dd 100644 --- a/ocaml-lsp-server/test/e2e-new/completion.ml +++ b/ocaml-lsp-server/test/e2e-new/completion.ml @@ -33,30 +33,141 @@ let print_completions ?(prep = fun _ -> Fiber.return ()) ?(path = "foo.ml") |> print_endline); if originalLength > limit then print_endline ".............")) -let%expect_test "completions" = - let source = {ocaml| -let testNum=11 in -test -|ocaml} in - let position = Position.create ~line:2 ~character:4 in +let%expect_test "can start completion at arbitrary position (before the dot)" = + let source = {ocaml|Strin.func|ocaml} in + let position = Position.create ~line:0 ~character:5 in print_completions source position; [%expect - {| -Completions: -{ - "detail": "int", - "kind": 12, - "label": "testNum", - "sortText": "0000", - "textEdit": { - "newText": "testNum", - "range": { - "end": { "character": 4, "line": 2 }, - "start": { "character": 0, "line": 2 } - } - } -} -|}] + {| + Completions: + { + "detail": "", + "kind": 9, + "label": "String", + "sortText": "0000", + "textEdit": { + "newText": "String", + "range": { + "end": { "character": 5, "line": 0 }, + "start": { "character": 0, "line": 0 } + } + } + } + { + "detail": "", + "kind": 9, + "label": "StringLabels", + "sortText": "0001", + "textEdit": { + "newText": "StringLabels", + "range": { + "end": { "character": 5, "line": 0 }, + "start": { "character": 0, "line": 0 } + } + } + } |}] + +let%expect_test "can start completion at arbitrary position" = + let source = {ocaml|StringLabels|ocaml} in + let position = Position.create ~line:0 ~character:6 in + print_completions source position; + [%expect + {| + Completions: + { + "detail": "", + "kind": 9, + "label": "String", + "sortText": "0000", + "textEdit": { + "newText": "String", + "range": { + "end": { "character": 6, "line": 0 }, + "start": { "character": 0, "line": 0 } + } + } + } + { + "detail": "", + "kind": 9, + "label": "StringLabels", + "sortText": "0001", + "textEdit": { + "newText": "StringLabels", + "range": { + "end": { "character": 6, "line": 0 }, + "start": { "character": 0, "line": 0 } + } + } + } |}] + +let%expect_test "can start completion at arbitrary position 2" = + let source = {ocaml|StringLabels|ocaml} in + let position = Position.create ~line:0 ~character:7 in + print_completions source position; + [%expect + {| + Completions: + { + "detail": "", + "kind": 9, + "label": "StringLabels", + "sortText": "0000", + "textEdit": { + "newText": "StringLabels", + "range": { + "end": { "character": 7, "line": 0 }, + "start": { "character": 0, "line": 0 } + } + } + } |}] + +let%expect_test "can start completion after operator without space" = + let source = {ocaml|[1;2]|>List.ma|ocaml} in + let position = Position.create ~line:0 ~character:14 in + print_completions source position; + [%expect + {| + Completions: + { + "detail": "('a -> 'b) -> 'a list -> 'b list", + "kind": 12, + "label": "map", + "sortText": "0000", + "textEdit": { + "newText": "map", + "range": { + "end": { "character": 14, "line": 0 }, + "start": { "character": 12, "line": 0 } + } + } + } + { + "detail": "(int -> 'a -> 'b) -> 'a list -> 'b list", + "kind": 12, + "label": "mapi", + "sortText": "0001", + "textEdit": { + "newText": "mapi", + "range": { + "end": { "character": 14, "line": 0 }, + "start": { "character": 12, "line": 0 } + } + } + } + { + "detail": "('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list", + "kind": 12, + "label": "map2", + "sortText": "0002", + "textEdit": { + "newText": "map2", + "range": { + "end": { "character": 14, "line": 0 }, + "start": { "character": 12, "line": 0 } + } + } + } |}] let%expect_test "can start completion after operator with space" = let source = {ocaml|[1;2] |> List.ma|ocaml} in @@ -106,53 +217,52 @@ let%expect_test "can start completion after operator with space" = } |}] -let%expect_test "can start completion in dot chain with newline" = - let source = {ocaml|[1;2] |> List. -ma|ocaml} in - let position = Position.create ~line:1 ~character:2 in +let%expect_test "can start completion in dot chain with tab" = + let source = {ocaml|[1;2] |> List. ma|ocaml} in + let position = Position.create ~line:0 ~character:17 in print_completions source position; [%expect {| - Completions: - { - "detail": "('a -> 'b) -> 'a list -> 'b list", - "kind": 12, - "label": "map", - "sortText": "0000", - "textEdit": { - "newText": "map", - "range": { - "end": { "character": 2, "line": 1 }, - "start": { "character": 0, "line": 1 } + Completions: + { + "detail": "('a -> 'b) -> 'a list -> 'b list", + "kind": 12, + "label": "map", + "sortText": "0000", + "textEdit": { + "newText": "map", + "range": { + "end": { "character": 17, "line": 0 }, + "start": { "character": 15, "line": 0 } + } + } } - } - } - { - "detail": "(int -> 'a -> 'b) -> 'a list -> 'b list", - "kind": 12, - "label": "mapi", - "sortText": "0001", - "textEdit": { - "newText": "mapi", - "range": { - "end": { "character": 2, "line": 1 }, - "start": { "character": 0, "line": 1 } + { + "detail": "(int -> 'a -> 'b) -> 'a list -> 'b list", + "kind": 12, + "label": "mapi", + "sortText": "0001", + "textEdit": { + "newText": "mapi", + "range": { + "end": { "character": 17, "line": 0 }, + "start": { "character": 15, "line": 0 } + } + } } - } - } - { - "detail": "('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list", - "kind": 12, - "label": "map2", - "sortText": "0002", - "textEdit": { - "newText": "map2", - "range": { - "end": { "character": 2, "line": 1 }, - "start": { "character": 0, "line": 1 } + { + "detail": "('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list", + "kind": 12, + "label": "map2", + "sortText": "0002", + "textEdit": { + "newText": "map2", + "range": { + "end": { "character": 17, "line": 0 }, + "start": { "character": 15, "line": 0 } + } + } } - } - } |}] let%expect_test "can start completion in dot chain with newline" = @@ -204,6 +314,53 @@ ma|ocaml} in } |}] +let%expect_test "can start completion in dot chain with space" = + let source = {ocaml|[1;2] |> List. ma|ocaml} in + let position = Position.create ~line:0 ~character:17 in + print_completions source position; + [%expect {| + Completions: + { + "detail": "('a -> 'b) -> 'a list -> 'b list", + "kind": 12, + "label": "map", + "sortText": "0000", + "textEdit": { + "newText": "map", + "range": { + "end": { "character": 17, "line": 0 }, + "start": { "character": 15, "line": 0 } + } + } + } + { + "detail": "(int -> 'a -> 'b) -> 'a list -> 'b list", + "kind": 12, + "label": "mapi", + "sortText": "0001", + "textEdit": { + "newText": "mapi", + "range": { + "end": { "character": 17, "line": 0 }, + "start": { "character": 15, "line": 0 } + } + } + } + { + "detail": "('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list", + "kind": 12, + "label": "map2", + "sortText": "0002", + "textEdit": { + "newText": "map2", + "range": { + "end": { "character": 17, "line": 0 }, + "start": { "character": 15, "line": 0 } + } + } + } + |}] + let%expect_test "can start completion after dereference" = let source = {ocaml|let apple=ref 10 in !ap|ocaml} in @@ -276,6 +433,32 @@ g ~f:M.ig|ocaml} } |}] +let%expect_test "can complete symbol passed as an optional argument" = + let source = + {ocaml| +let g ?f = f in +g ?f:ig + |ocaml} + in + let position = Position.create ~line:2 ~character:7 in + print_completions source position; + [%expect + {| + Completions: + { + "detail": "'a -> unit", + "kind": 12, + "label": "ignore", + "sortText": "0000", + "textEdit": { + "newText": "ignore", + "range": { + "end": { "character": 7, "line": 2 }, + "start": { "character": 5, "line": 2 } + } + } + } + |}] let%expect_test "can complete symbol passed as an optional argument - 2" = let source = {ocaml|module M = struct let igfoo _x = () end From b27e3cc2e76dbbada72f3726b04752f3a6562cbe Mon Sep 17 00:00:00 2001 From: faldor20 Date: Tue, 10 Oct 2023 22:52:01 +1000 Subject: [PATCH 19/23] formatting --- ocaml-lsp-server/bench/ocaml_lsp_bench.ml | 3 --- ocaml-lsp-server/src/compl.ml | 18 ++++++++-------- ocaml-lsp-server/src/import.ml | 4 ++-- ocaml-lsp-server/src/prefix_parser.ml | 14 ++++++------- ocaml-lsp-server/src/prefix_parser.mli | 8 +++---- ocaml-lsp-server/test/e2e-new/completion.ml | 10 ++++----- ocaml-lsp-server/test/e2e-new/lsp_helpers.ml | 22 +++++++++++--------- 7 files changed, 38 insertions(+), 41 deletions(-) diff --git a/ocaml-lsp-server/bench/ocaml_lsp_bench.ml b/ocaml-lsp-server/bench/ocaml_lsp_bench.ml index 3f7a8145f..b7607feb5 100644 --- a/ocaml-lsp-server/bench/ocaml_lsp_bench.ml +++ b/ocaml-lsp-server/bench/ocaml_lsp_bench.ml @@ -1,7 +1,4 @@ open Ocaml_lsp_server - - - open Core open Core_bench diff --git a/ocaml-lsp-server/src/compl.ml b/ocaml-lsp-server/src/compl.ml index 692fe2f40..ff0c969ae 100644 --- a/ocaml-lsp-server/src/compl.ml +++ b/ocaml-lsp-server/src/compl.ml @@ -1,7 +1,6 @@ open Import open Fiber.O - module Resolve = struct type t = CompletionParams.t @@ -36,17 +35,18 @@ let prefix_of_position ~short_path source position = let (`Offset index) = Msource.get_offset source position in min (String.length text - 1) (index - 1) in - let pos = - (*clamp the length of a line to process at 500 chars, this is just a - reasonable limit for regex performance*) - max 0 (end_of_prefix - 500) - in - + let pos = + (*clamp the length of a line to process at 500 chars, this is just a + reasonable limit for regex performance*) + max 0 (end_of_prefix - 500) + in + let reconstructed_prefix = try_parse_with_regex ~pos ~len:(end_of_prefix + 1 - pos) text |> Option.value ~default:"" - (*We remove the whitespace because merlin expects no whitespace and it's semantically meaningless*) - |> String.filter (fun x -> not(x = ' '||x= '\n' ||x = '\t')) + (*We remove the whitespace because merlin expects no whitespace and it's + semantically meaningless*) + |> String.filter (fun x -> not (x = ' ' || x = '\n' || x = '\t')) in if short_path then diff --git a/ocaml-lsp-server/src/import.ml b/ocaml-lsp-server/src/import.ml index 1ddf3f4b4..4f621eb83 100644 --- a/ocaml-lsp-server/src/import.ml +++ b/ocaml-lsp-server/src/import.ml @@ -34,8 +34,8 @@ include struct module String = struct include String - (**Filters a string keeping any chars for which f returns true - and discarding those for which it returns false*) + (**Filters a string keeping any chars for which f returns true and + discarding those for which it returns false*) let filter f s = let buf = Buffer.create (String.length s) in iter ~f:(fun c -> if f c then Buffer.add_char buf c) s; diff --git a/ocaml-lsp-server/src/prefix_parser.ml b/ocaml-lsp-server/src/prefix_parser.ml index acc58c834..0de5cd250 100644 --- a/ocaml-lsp-server/src/prefix_parser.ml +++ b/ocaml-lsp-server/src/prefix_parser.ml @@ -7,7 +7,7 @@ let name_char = Re.alt [ rg 'a' 'z'; rg 'A' 'Z'; rg '0' '9'; char '_'; char '\'' ] let name_with_dot = - Re.seq [ name_char;whiteSpace |> rep;char '.' ;whiteSpace |> rep;] + Re.seq [ name_char; whiteSpace |> rep; char '.'; whiteSpace |> rep ] let core_operator_str = {|$&*+-/=>@^||} @@ -18,10 +18,9 @@ let infix = set (operator ^ "#") let name_or_label = compile (seq - [ - alt [ set "~?``"; str "let%"; str "and%" ] |> opt + [ alt [ set "~?``"; str "let%"; str "and%" ] |> opt ; alt [ name_char; name_with_dot ] |> rep1 - ; stop + ; stop ]) (** matches let%lwt and let* style expressions. See @@ -29,13 +28,12 @@ let name_or_label = let monadic_bind = compile (seq - [ - alt [ str "let"; str "and" ] + [ alt [ str "let"; str "and" ] ; alt [ infix |> rep1; seq [ name_char |> rep1; char '%' ] ] - ;stop + ; stop ]) -let infix_operator = compile (seq [ infix |> rep1 ;stop]) +let infix_operator = compile (seq [ infix |> rep1; stop ]) open Import diff --git a/ocaml-lsp-server/src/prefix_parser.mli b/ocaml-lsp-server/src/prefix_parser.mli index 7913dafd3..0cc814f0f 100644 --- a/ocaml-lsp-server/src/prefix_parser.mli +++ b/ocaml-lsp-server/src/prefix_parser.mli @@ -1,4 +1,4 @@ -(**Try's the parse the incoming string for a prefix. The string should be the source code - ending at the prefix position. - pos and len set the range for the regex to operate on*) -val try_parse_with_regex : ?pos:int -> ?len:int -> string -> string option +(**Try's the parse the incoming string for a prefix. The string should be the + source code ending at the prefix position. pos and len set the range for the + regex to operate on*) +val try_parse_with_regex : ?pos:int -> ?len:int -> string -> string option diff --git a/ocaml-lsp-server/test/e2e-new/completion.ml b/ocaml-lsp-server/test/e2e-new/completion.ml index bdeee06dd..9c59f1394 100644 --- a/ocaml-lsp-server/test/e2e-new/completion.ml +++ b/ocaml-lsp-server/test/e2e-new/completion.ml @@ -318,7 +318,8 @@ let%expect_test "can start completion in dot chain with space" = let source = {ocaml|[1;2] |> List. ma|ocaml} in let position = Position.create ~line:0 ~character:17 in print_completions source position; - [%expect {| + [%expect + {| Completions: { "detail": "('a -> 'b) -> 'a list -> 'b list", @@ -434,12 +435,10 @@ g ~f:M.ig|ocaml} |}] let%expect_test "can complete symbol passed as an optional argument" = - let source = - {ocaml| + let source = {ocaml| let g ?f = f in g ?f:ig - |ocaml} - in + |ocaml} in let position = Position.create ~line:2 ~character:7 in print_completions source position; [%expect @@ -459,6 +458,7 @@ g ?f:ig } } |}] + let%expect_test "can complete symbol passed as an optional argument - 2" = let source = {ocaml|module M = struct let igfoo _x = () end diff --git a/ocaml-lsp-server/test/e2e-new/lsp_helpers.ml b/ocaml-lsp-server/test/e2e-new/lsp_helpers.ml index 47691f366..8f5c7153c 100644 --- a/ocaml-lsp-server/test/e2e-new/lsp_helpers.ml +++ b/ocaml-lsp-server/test/e2e-new/lsp_helpers.ml @@ -1,6 +1,7 @@ open Test.Import -(**Opens a document with the language server. This must be done before trying to access it*) +(**Opens a document with the language server. This must be done before trying to + access it*) let openDocument ~client ~uri ~source = let textDocument = TextDocumentItem.create ~uri ~languageId:"ocaml" ~version:0 ~text:source @@ -9,20 +10,21 @@ let openDocument ~client ~uri ~source = client (TextDocumentDidOpen (DidOpenTextDocumentParams.create ~textDocument)) -(**Performs the request you return from the makeRequest function and then gives it the the handler function - you provide*) +(**Performs the request you return from the makeRequest function and then gives + it the the handler function you provide*) let iter_LspResponse ?(prep = fun _ -> Fiber.return ()) ?(path = "foo.ml") ~makeRequest ~source k = let got_diagnostics = Fiber.Ivar.create () in let handler = Client.Handler.make - ~on_notification:(fun _ -> function - | PublishDiagnostics _ -> ( - let* diag = Fiber.Ivar.peek got_diagnostics in - match diag with - | Some _ -> Fiber.return () - | None -> Fiber.Ivar.fill got_diagnostics ()) - | _ -> Fiber.return ()) + ~on_notification: + (fun _ -> function + | PublishDiagnostics _ -> ( + let* diag = Fiber.Ivar.peek got_diagnostics in + match diag with + | Some _ -> Fiber.return () + | None -> Fiber.Ivar.fill got_diagnostics ()) + | _ -> Fiber.return ()) () in Test.run ~handler @@ fun client -> From b746bd577a394a73de831e8fdb8cbff30a7b1fc1 Mon Sep 17 00:00:00 2001 From: faldor20 Date: Tue, 10 Oct 2023 23:04:01 +1000 Subject: [PATCH 20/23] removed old tests --- .../__tests__/textDocument-completion.test.ts | 1087 ----------------- 1 file changed, 1087 deletions(-) delete mode 100644 ocaml-lsp-server/test/e2e/__tests__/textDocument-completion.test.ts diff --git a/ocaml-lsp-server/test/e2e/__tests__/textDocument-completion.test.ts b/ocaml-lsp-server/test/e2e/__tests__/textDocument-completion.test.ts deleted file mode 100644 index 58198f396..000000000 --- a/ocaml-lsp-server/test/e2e/__tests__/textDocument-completion.test.ts +++ /dev/null @@ -1,1087 +0,0 @@ -import outdent from "outdent"; -import * as LanguageServer from "./../src/LanguageServer"; -import * as Protocol from "vscode-languageserver-protocol"; - -import * as Types from "vscode-languageserver-types"; -import { Position } from "vscode-languageserver-types"; - -const describe_opt = LanguageServer.ocamlVersionGEq("4.08.0") - ? describe - : xdescribe; - -describe_opt("textDocument/completion", () => { - let languageServer: LanguageServer.LanguageServer; - - function openDocument(source: string) { - return languageServer.sendNotification( - Protocol.DidOpenTextDocumentNotification.type, - { - textDocument: Types.TextDocumentItem.create( - "file:///test.ml", - "ocaml", - 0, - source, - ), - }, - ); - } - - async function queryCompletion(position: Types.Position) { - let result = - (await languageServer.sendRequest(Protocol.CompletionRequest.type, { - textDocument: Types.TextDocumentIdentifier.create("file:///test.ml"), - position, - })) ?? []; - - if ("items" in result) { - return result.items.map((item) => { - return { - label: item.label, - textEdit: item.textEdit, - }; - }); - } else { - result.map((item) => { - return { - label: item.label, - textEdit: item.textEdit, - }; - }); - } - } - - beforeEach(async () => { - languageServer = await LanguageServer.startAndInitialize(); - }); - - afterEach(async () => { - await LanguageServer.exit(languageServer); - }); - - it("can start completion at arbitrary position (before the dot)", async () => { - openDocument(outdent` - Strin.func - `); - - let items = await queryCompletion(Types.Position.create(0, 5)); - expect(items).toMatchObject([ - { label: "String" }, - { label: "StringLabels" }, - ]); - }); - - it("can start completion at arbitrary position", async () => { - openDocument(outdent` - StringLabels - `); - - let items = await queryCompletion(Types.Position.create(0, 6)); - expect(items).toMatchObject([ - { label: "String" }, - { label: "StringLabels" }, - ]); - }); - - it("can start completion at arbitrary position 2", async () => { - openDocument(outdent` - StringLabels - `); - - let items = await queryCompletion(Types.Position.create(0, 7)); - expect(items).toMatchObject([{ label: "StringLabels" }]); - }); - - it("can start completion after operator with space", async () => { - openDocument(outdent` -[1;2] |> List.ma - `); - - let items = await queryCompletion(Types.Position.create(0, 16)); - expect(items).toMatchInlineSnapshot(` - Array [ - Object { - "label": "map", - "textEdit": Object { - "newText": "map", - "range": Object { - "end": Object { - "character": 16, - "line": 0, - }, - "start": Object { - "character": 14, - "line": 0, - }, - }, - }, - }, - Object { - "label": "mapi", - "textEdit": Object { - "newText": "mapi", - "range": Object { - "end": Object { - "character": 16, - "line": 0, - }, - "start": Object { - "character": 14, - "line": 0, - }, - }, - }, - }, - Object { - "label": "map2", - "textEdit": Object { - "newText": "map2", - "range": Object { - "end": Object { - "character": 16, - "line": 0, - }, - "start": Object { - "character": 14, - "line": 0, - }, - }, - }, - }, - ] - `); - }); - it("can start completion after operator without space", async () => { - openDocument(outdent` -[1;2]|>List.ma - `); - - let items = await queryCompletion(Types.Position.create(0, 14)); - expect(items).toMatchInlineSnapshot(` - Array [ - Object { - "label": "map", - "textEdit": Object { - "newText": "map", - "range": Object { - "end": Object { - "character": 14, - "line": 0, - }, - "start": Object { - "character": 12, - "line": 0, - }, - }, - }, - }, - Object { - "label": "mapi", - "textEdit": Object { - "newText": "mapi", - "range": Object { - "end": Object { - "character": 14, - "line": 0, - }, - "start": Object { - "character": 12, - "line": 0, - }, - }, - }, - }, - Object { - "label": "map2", - "textEdit": Object { - "newText": "map2", - "range": Object { - "end": Object { - "character": 14, - "line": 0, - }, - "start": Object { - "character": 12, - "line": 0, - }, - }, - }, - }, - ] - `); - }); - - it("can start completion after operator with space", async () => { - openDocument(outdent` -[1;2] |> List.ma - `); - - let items = await queryCompletion(Types.Position.create(0, 16)); - expect(items).toMatchInlineSnapshot(` - Array [ - Object { - "label": "map", - "textEdit": Object { - "newText": "map", - "range": Object { - "end": Object { - "character": 16, - "line": 0, - }, - "start": Object { - "character": 14, - "line": 0, - }, - }, - }, - }, - Object { - "label": "mapi", - "textEdit": Object { - "newText": "mapi", - "range": Object { - "end": Object { - "character": 16, - "line": 0, - }, - "start": Object { - "character": 14, - "line": 0, - }, - }, - }, - }, - Object { - "label": "map2", - "textEdit": Object { - "newText": "map2", - "range": Object { - "end": Object { - "character": 16, - "line": 0, - }, - "start": Object { - "character": 14, - "line": 0, - }, - }, - }, - }, - ] - `); - }); - - it("can start completion in dot chain with newline", async () => { - openDocument(outdent` -[1;2] |> List. -ma - `); - - let items = await queryCompletion(Types.Position.create(1, 2)); - expect(items).toMatchInlineSnapshot(` - Array [ - Object { - "label": "map", - "textEdit": Object { - "newText": "map", - "range": Object { - "end": Object { - "character": 2, - "line": 1, - }, - "start": Object { - "character": 0, - "line": 1, - }, - }, - }, - }, - Object { - "label": "mapi", - "textEdit": Object { - "newText": "mapi", - "range": Object { - "end": Object { - "character": 2, - "line": 1, - }, - "start": Object { - "character": 0, - "line": 1, - }, - }, - }, - }, - Object { - "label": "map2", - "textEdit": Object { - "newText": "map2", - "range": Object { - "end": Object { - "character": 2, - "line": 1, - }, - "start": Object { - "character": 0, - "line": 1, - }, - }, - }, - }, - ] - `); - }); - it("can start completion in dot chain with tab", async () => { - openDocument(outdent` -[1;2] |> List. ma - `); - - let items = await queryCompletion(Types.Position.create(0, 17)); - expect(items).toMatchInlineSnapshot(` - Array [ - Object { - "label": "map", - "textEdit": Object { - "newText": "map", - "range": Object { - "end": Object { - "character": 17, - "line": 0, - }, - "start": Object { - "character": 15, - "line": 0, - }, - }, - }, - }, - Object { - "label": "mapi", - "textEdit": Object { - "newText": "mapi", - "range": Object { - "end": Object { - "character": 17, - "line": 0, - }, - "start": Object { - "character": 15, - "line": 0, - }, - }, - }, - }, - Object { - "label": "map2", - "textEdit": Object { - "newText": "map2", - "range": Object { - "end": Object { - "character": 17, - "line": 0, - }, - "start": Object { - "character": 15, - "line": 0, - }, - }, - }, - }, - ] - `); - }); - it("can start completion in dot chain with space", async () => { - openDocument(outdent` -[1;2] |> List. ma - `); - - let items = await queryCompletion(Types.Position.create(0, 17)); - expect(items).toMatchInlineSnapshot(` - Array [ - Object { - "label": "map", - "textEdit": Object { - "newText": "map", - "range": Object { - "end": Object { - "character": 17, - "line": 0, - }, - "start": Object { - "character": 15, - "line": 0, - }, - }, - }, - }, - Object { - "label": "mapi", - "textEdit": Object { - "newText": "mapi", - "range": Object { - "end": Object { - "character": 17, - "line": 0, - }, - "start": Object { - "character": 15, - "line": 0, - }, - }, - }, - }, - Object { - "label": "map2", - "textEdit": Object { - "newText": "map2", - "range": Object { - "end": Object { - "character": 17, - "line": 0, - }, - "start": Object { - "character": 15, - "line": 0, - }, - }, - }, - }, - ] - `); - }); - - it("can start completion after dereference", async () => { - openDocument(outdent` -let apple=ref 10 in -!ap - `); - - let items = await queryCompletion(Types.Position.create(1, 3)); - expect(items).toMatchInlineSnapshot(` - Array [ - Object { - "label": "apple", - "textEdit": Object { - "newText": "apple", - "range": Object { - "end": Object { - "character": 3, - "line": 1, - }, - "start": Object { - "character": 1, - "line": 1, - }, - }, - }, - }, - ] - `); - }); - it("can complete symbol passed as a named argument", async () => { - openDocument(outdent` -let g ~f = f 0 in -g ~f:ig - `); - - let items = await queryCompletion(Types.Position.create(1, 7)); - expect(items).toMatchInlineSnapshot(` - Array [ - Object { - "label": "ignore", - "textEdit": Object { - "newText": "ignore", - "range": Object { - "end": Object { - "character": 7, - "line": 1, - }, - "start": Object { - "character": 5, - "line": 1, - }, - }, - }, - }, - ] - `); - }); - - it("can complete symbol passed as a named argument - 2", async () => { - openDocument(outdent` -module M = struct let igfoo _x = () end -let g ~f = f 0 in -g ~f:M.ig - `); - - let items = await queryCompletion(Types.Position.create(2, 9)); - expect(items).toMatchInlineSnapshot(` - Array [ - Object { - "label": "igfoo", - "textEdit": Object { - "newText": "igfoo", - "range": Object { - "end": Object { - "character": 9, - "line": 2, - }, - "start": Object { - "character": 7, - "line": 2, - }, - }, - }, - }, - ] - `); - }); - - it("can complete symbol passed as an optional argument", async () => { - openDocument(outdent` -let g ?f = f in -g ?f:ig - `); - - let items = await queryCompletion(Types.Position.create(1, 7)); - expect(items).toMatchInlineSnapshot(` - Array [ - Object { - "label": "ignore", - "textEdit": Object { - "newText": "ignore", - "range": Object { - "end": Object { - "character": 7, - "line": 1, - }, - "start": Object { - "character": 5, - "line": 1, - }, - }, - }, - }, - ] - `); - }); - - it("can complete symbol passed as a optional argument - 2", async () => { - openDocument(outdent` -module M = struct let igfoo _x = () end -let g ?f = f in -g ?f:M.ig - `); - - let items = await queryCompletion(Types.Position.create(2, 9)); - expect(items).toMatchInlineSnapshot(` - Array [ - Object { - "label": "igfoo", - "textEdit": Object { - "newText": "igfoo", - "range": Object { - "end": Object { - "character": 9, - "line": 2, - }, - "start": Object { - "character": 7, - "line": 2, - }, - }, - }, - }, - ] - `); - }); - - it("completes identifier at top level", async () => { - openDocument(outdent` - let somenum = 42 - let somestring = "hello" - - let () = - some - `); - - let items = await queryCompletion(Types.Position.create(4, 6)); - expect(items).toMatchObject([ - { label: "somenum" }, - { label: "somestring" }, - ]); - }); - - it("completes identifier after completion-triggering character", async () => { - openDocument(outdent` - module Test = struct - let somenum = 42 - let somestring = "hello" - end - - let x = Test. - `); - - let items = await queryCompletion(Types.Position.create(5, 13)); - - expect(items).toMatchInlineSnapshot(` - Array [ - Object { - "label": "somenum", - "textEdit": Object { - "newText": "somenum", - "range": Object { - "end": Object { - "character": 13, - "line": 5, - }, - "start": Object { - "character": 13, - "line": 5, - }, - }, - }, - }, - Object { - "label": "somestring", - "textEdit": Object { - "newText": "somestring", - "range": Object { - "end": Object { - "character": 13, - "line": 5, - }, - "start": Object { - "character": 13, - "line": 5, - }, - }, - }, - }, - ] - `); - }); - - it("completes infix operators", async () => { - openDocument(outdent` - let (>>|) = (+) - let y = 1 > - `); - - let items = await queryCompletion(Types.Position.create(1, 11)); - expect(items).toMatchInlineSnapshot(` - Array [ - Object { - "label": ">>|", - "textEdit": Object { - "newText": ">>|", - "range": Object { - "end": Object { - "character": 11, - "line": 1, - }, - "start": Object { - "character": 10, - "line": 1, - }, - }, - }, - }, - Object { - "label": ">", - "textEdit": Object { - "newText": ">", - "range": Object { - "end": Object { - "character": 11, - "line": 1, - }, - "start": Object { - "character": 10, - "line": 1, - }, - }, - }, - }, - Object { - "label": ">=", - "textEdit": Object { - "newText": ">=", - "range": Object { - "end": Object { - "character": 11, - "line": 1, - }, - "start": Object { - "character": 10, - "line": 1, - }, - }, - }, - }, - ] - `); - }); - - it("completes from a module", async () => { - openDocument(outdent` - let f = List.m - `); - - let items = await queryCompletion(Types.Position.create(0, 14)); - expect(items).toMatchObject([ - { label: "map" }, - { label: "map2" }, - { label: "mapi" }, - { label: "mem" }, - { label: "mem_assoc" }, - { label: "mem_assq" }, - { label: "memq" }, - { label: "merge" }, - ]); - }); - - it("completes a module name", async () => { - openDocument(outdent` - let f = L - `); - - let items = (await queryCompletion(Types.Position.create(0, 9))) ?? []; - let items_top5 = items.slice(0, 5); - expect(items_top5).toMatchObject([ - { label: "LargeFile" }, - { label: "Lazy" }, - { label: "Lexing" }, - { label: "List" }, - { label: "ListLabels" }, - ]); - }); - - it("completes without prefix", async () => { - openDocument(outdent` - let somenum = 42 - let somestring = "hello" - - let plus_42 (x:int) (y:int) = - somenum + `); - - let items = (await queryCompletion(Types.Position.create(4, 12))) ?? []; - let items_top5 = items.slice(0, 5); - expect(items_top5).toMatchInlineSnapshot(` - Array [ - Object { - "label": "somenum", - "textEdit": Object { - "newText": "somenum", - "range": Object { - "end": Object { - "character": 12, - "line": 4, - }, - "start": Object { - "character": 12, - "line": 4, - }, - }, - }, - }, - Object { - "label": "x", - "textEdit": Object { - "newText": "x", - "range": Object { - "end": Object { - "character": 12, - "line": 4, - }, - "start": Object { - "character": 12, - "line": 4, - }, - }, - }, - }, - Object { - "label": "y", - "textEdit": Object { - "newText": "y", - "range": Object { - "end": Object { - "character": 12, - "line": 4, - }, - "start": Object { - "character": 12, - "line": 4, - }, - }, - }, - }, - Object { - "label": "max_int", - "textEdit": Object { - "newText": "max_int", - "range": Object { - "end": Object { - "character": 12, - "line": 4, - }, - "start": Object { - "character": 12, - "line": 4, - }, - }, - }, - }, - Object { - "label": "min_int", - "textEdit": Object { - "newText": "min_int", - "range": Object { - "end": Object { - "character": 12, - "line": 4, - }, - "start": Object { - "character": 12, - "line": 4, - }, - }, - }, - }, - ] - `); - }); - - it("completes labels", async () => { - openDocument("let f = ListLabels.map ~"); - - let items = (await queryCompletion(Types.Position.create(0, 24))) ?? []; - let items_top5 = items.slice(0, 10); - expect(items_top5).toMatchInlineSnapshot(` - Array [ - Object { - "label": "~+", - "textEdit": Object { - "newText": "~+", - "range": Object { - "end": Object { - "character": 24, - "line": 0, - }, - "start": Object { - "character": 23, - "line": 0, - }, - }, - }, - }, - Object { - "label": "~+.", - "textEdit": Object { - "newText": "~+.", - "range": Object { - "end": Object { - "character": 24, - "line": 0, - }, - "start": Object { - "character": 23, - "line": 0, - }, - }, - }, - }, - Object { - "label": "~-", - "textEdit": Object { - "newText": "~-", - "range": Object { - "end": Object { - "character": 24, - "line": 0, - }, - "start": Object { - "character": 23, - "line": 0, - }, - }, - }, - }, - Object { - "label": "~-.", - "textEdit": Object { - "newText": "~-.", - "range": Object { - "end": Object { - "character": 24, - "line": 0, - }, - "start": Object { - "character": 23, - "line": 0, - }, - }, - }, - }, - Object { - "label": "~f", - "textEdit": Object { - "newText": "~f", - "range": Object { - "end": Object { - "character": 24, - "line": 0, - }, - "start": Object { - "character": 23, - "line": 0, - }, - }, - }, - }, - ] - `); - }); - - it("completion doesn't autocomplete record fields", async () => { - openDocument(outdent` - type r = { - x: int; - y: string - } - - let _ = - `); - - let items = (await queryCompletion(Types.Position.create(5, 8))) ?? []; - expect( - items.filter((compl) => compl.label === "x" || compl.label === "y"), - ).toHaveLength(0); - }); - - it("works for polymorphic variants - function application context - 1", async () => { - openDocument(outdent` -let f (_a: [\`String | \`Int of int]) = () - -let u = f \`Str - `); - - let items = await queryCompletion(Position.create(2, 15)); - - expect(items).toMatchInlineSnapshot(` - Array [ - Object { - "label": "\`String", - "textEdit": Object { - "newText": "\`String", - "range": Object { - "end": Object { - "character": 15, - "line": 2, - }, - "start": Object { - "character": 11, - "line": 2, - }, - }, - }, - }, - ] - `); - }); - - it("works for polymorphic variants - function application context - 2", async () => { - openDocument(outdent` -let f (_a: [\`String | \`Int of int]) = () - -let u = f \`In - `); - - let items = await queryCompletion(Position.create(2, 14)); - - expect(items).toMatchInlineSnapshot(` - Array [ - Object { - "label": "\`Int", - "textEdit": Object { - "newText": "\`Int", - "range": Object { - "end": Object { - "character": 14, - "line": 2, - }, - "start": Object { - "character": 11, - "line": 2, - }, - }, - }, - }, - ] - `); - }); - - it("works for polymorphic variants", async () => { - openDocument(outdent` -type t = [ \`Int | \`String ] - -let x : t = \`I - `); - - let items = await queryCompletion(Position.create(2, 15)); - - expect(items).toMatchInlineSnapshot(` - Array [ - Object { - "label": "\`Int", - "textEdit": Object { - "newText": "\`Int", - "range": Object { - "end": Object { - "character": 15, - "line": 2, - }, - "start": Object { - "character": 13, - "line": 2, - }, - }, - }, - }, - ] - `); - }); - - it("completion for holes", async () => { - openDocument(outdent` -let u : int = _ -`); - - let items = (await queryCompletion(Types.Position.create(0, 15))) ?? []; - - items = items.filter( - (completionItem) => !completionItem.label.startsWith("__"), - ); - - expect(items).toMatchInlineSnapshot(` - Array [ - Object { - "label": "0", - "textEdit": Object { - "newText": "0", - "range": Object { - "end": Object { - "character": 15, - "line": 0, - }, - "start": Object { - "character": 14, - "line": 0, - }, - }, - }, - }, - ] - `); - }); -}); From e7008b9dae71e6d045ec95cdf93d0e97095a7692 Mon Sep 17 00:00:00 2001 From: faldor20 Date: Tue, 10 Oct 2023 23:21:02 +1000 Subject: [PATCH 21/23] added interface --- ocaml-lsp-server/test/e2e-new/lsp_helpers.ml | 4 ---- ocaml-lsp-server/test/e2e-new/lsp_helpers.mli | 19 +++++++++++++++++++ 2 files changed, 19 insertions(+), 4 deletions(-) create mode 100644 ocaml-lsp-server/test/e2e-new/lsp_helpers.mli diff --git a/ocaml-lsp-server/test/e2e-new/lsp_helpers.ml b/ocaml-lsp-server/test/e2e-new/lsp_helpers.ml index 8f5c7153c..62378b4f8 100644 --- a/ocaml-lsp-server/test/e2e-new/lsp_helpers.ml +++ b/ocaml-lsp-server/test/e2e-new/lsp_helpers.ml @@ -1,7 +1,5 @@ open Test.Import -(**Opens a document with the language server. This must be done before trying to - access it*) let openDocument ~client ~uri ~source = let textDocument = TextDocumentItem.create ~uri ~languageId:"ocaml" ~version:0 ~text:source @@ -10,8 +8,6 @@ let openDocument ~client ~uri ~source = client (TextDocumentDidOpen (DidOpenTextDocumentParams.create ~textDocument)) -(**Performs the request you return from the makeRequest function and then gives - it the the handler function you provide*) let iter_LspResponse ?(prep = fun _ -> Fiber.return ()) ?(path = "foo.ml") ~makeRequest ~source k = let got_diagnostics = Fiber.Ivar.create () in diff --git a/ocaml-lsp-server/test/e2e-new/lsp_helpers.mli b/ocaml-lsp-server/test/e2e-new/lsp_helpers.mli new file mode 100644 index 000000000..024b54933 --- /dev/null +++ b/ocaml-lsp-server/test/e2e-new/lsp_helpers.mli @@ -0,0 +1,19 @@ +(**Opens a document with the language server. This must be done before trying to + access it*) +val openDocument : + client:'a Ocaml_lsp_e2e.Test.Import.Client.t + -> uri:Lsp__Types.DocumentUri.t + -> source:string + -> unit Fiber.t + +(**Performs the request you return from the makeRequest function and then gives + it the the handler function you provide*) +val iter_LspResponse : + ?prep:(unit Ocaml_lsp_e2e.Test.Import.Client.t -> unit Fiber.t) + -> ?path:string + -> makeRequest: + ( Ocaml_lsp_e2e.Test.Import.TextDocumentIdentifier.t + -> 'a Ocaml_lsp_e2e.Test.Import.Client.out_request) + -> source:string + -> ('a -> unit) + -> unit From c4249a80a3e304288064e90c590ab2e56062ea4e Mon Sep 17 00:00:00 2001 From: faldor20 Date: Sun, 15 Oct 2023 07:20:23 +1000 Subject: [PATCH 22/23] fix bad interface --- ocaml-lsp-server/test/e2e-new/lsp_helpers.mli | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/ocaml-lsp-server/test/e2e-new/lsp_helpers.mli b/ocaml-lsp-server/test/e2e-new/lsp_helpers.mli index 024b54933..b0ebc81a1 100644 --- a/ocaml-lsp-server/test/e2e-new/lsp_helpers.mli +++ b/ocaml-lsp-server/test/e2e-new/lsp_helpers.mli @@ -1,7 +1,9 @@ +open Test.Import + (**Opens a document with the language server. This must be done before trying to access it*) val openDocument : - client:'a Ocaml_lsp_e2e.Test.Import.Client.t + client:'a Client.t -> uri:Lsp__Types.DocumentUri.t -> source:string -> unit Fiber.t @@ -9,11 +11,11 @@ val openDocument : (**Performs the request you return from the makeRequest function and then gives it the the handler function you provide*) val iter_LspResponse : - ?prep:(unit Ocaml_lsp_e2e.Test.Import.Client.t -> unit Fiber.t) + ?prep:(unit Client.t -> unit Fiber.t) -> ?path:string -> makeRequest: - ( Ocaml_lsp_e2e.Test.Import.TextDocumentIdentifier.t - -> 'a Ocaml_lsp_e2e.Test.Import.Client.out_request) + ( TextDocumentIdentifier.t + -> 'a Client.out_request) -> source:string -> ('a -> unit) -> unit From bdaa47cf1af1595243307cbf000f58736796c24f Mon Sep 17 00:00:00 2001 From: faldor20 Date: Tue, 24 Oct 2023 03:13:35 +1000 Subject: [PATCH 23/23] Trying to get benchmarks to build fine --- Makefile | 5 +++++ dune-project | 1 + 2 files changed, 6 insertions(+) diff --git a/Makefile b/Makefile index 77e869bd3..be8f6217c 100644 --- a/Makefile +++ b/Makefile @@ -35,6 +35,11 @@ install: ## Install the packages on the system lock: ## Generate the lock files opam lock -y . +.PHONY: bench +bench: ## + dune exec ocaml-lsp-server/bench/ocaml_lsp_bench.exe --profile release + + .PHONY: test-ocaml test-ocaml: ## Run the unit tests dune build @lsp/test/runtest @lsp-fiber/runtest @jsonrpc-fiber/runtest @ocaml-lsp-server/runtest diff --git a/dune-project b/dune-project index 7b59875c6..e569cd560 100644 --- a/dune-project +++ b/dune-project @@ -59,6 +59,7 @@ possible and does not make any assumptions about IO. (odoc-parser (and (>= 2.0.0) (< 2.3.0))) (ppx_expect (and (>= v0.15.0) :with-test)) (ocamlformat (and :with-test (= 0.24.1))) + (ppx_bench (and :with-test (>= 0.16.0))) (ocamlc-loc (>= 3.7.0)) (uutf (>= 1.0.2)) (pp (>= 1.1.2))