diff --git a/ocaml-lsp-server/test/e2e-new/dune b/ocaml-lsp-server/test/e2e-new/dune index 0418b5c70..08e085aa5 100644 --- a/ocaml-lsp-server/test/e2e-new/dune +++ b/ocaml-lsp-server/test/e2e-new/dune @@ -9,6 +9,7 @@ stdune fiber yojson + ppx_yojson_conv_lib lev_fiber lev spawn diff --git a/ocaml-lsp-server/test/e2e-new/metrics.ml b/ocaml-lsp-server/test/e2e-new/metrics.ml new file mode 100644 index 000000000..71be5138e --- /dev/null +++ b/ocaml-lsp-server/test/e2e-new/metrics.ml @@ -0,0 +1,48 @@ +open Test.Import + +let%expect_test "start/stop" = + let handler = + let on_request (type r) _ (r : r Lsp.Server_request.t) : + (r Lsp_fiber.Rpc.Reply.t * unit) Fiber.t = + match r with + | ShowDocumentRequest p -> + print_endline "client: received show document parms"; + let json = + ShowDocumentParams.yojson_of_t { p with uri = "" } + in + Yojson.Safe.to_channel stdout json; + print_endline ""; + print_endline "metrics contents:"; + print_endline (Stdune.Io.String_path.read_file p.uri); + let res = ShowDocumentResult.create ~success:true in + Fiber.return (Lsp_fiber.Rpc.Reply.now res, ()) + | _ -> assert false + in + let on_request = { Client.Handler.on_request } in + Client.Handler.make ~on_request () + in + ( Test.run ~handler @@ fun client -> + let run_client () = + let capabilities = ClientCapabilities.create () in + Client.start client (InitializeParams.create ~capabilities ()) + in + let run = + let* (_ : InitializeResult.t) = Client.initialized client in + let view_metrics = + ExecuteCommandParams.create ~command:"ocamllsp/view-metrics" () + in + let+ res = Client.request client (ExecuteCommand view_metrics) in + print_endline "server: receiving response"; + Yojson.Safe.to_channel stdout res; + print_endline "" + in + Fiber.fork_and_join_unit run_client (fun () -> run >>> Client.stop client) + ); + [%expect + {| + client: received show document parms + {"uri":"","takeFocus":true} + metrics contents: + {"traceEvents":[]} + server: receiving response + null |}] diff --git a/ocaml-lsp-server/test/e2e-new/test.ml b/ocaml-lsp-server/test/e2e-new/test.ml index cdb2d25aa..795a98497 100644 --- a/ocaml-lsp-server/test/e2e-new/test.ml +++ b/ocaml-lsp-server/test/e2e-new/test.ml @@ -8,7 +8,8 @@ end open Import module T : sig - val run : (unit Client.t -> unit Fiber.t) -> unit + val run : + ?handler:unit Client.Handler.t -> (unit Client.t -> unit Fiber.t) -> unit end = struct let _PATH = Bin.parse_path (Option.value ~default:"" @@ Env.get Env.initial "PATH") @@ -18,7 +19,7 @@ end = struct let env = Spawn.Env.of_list [ "OCAMLLSP_TEST=true" ] - let run f = + let run ?handler f = let stdin_i, stdin_o = Unix.pipe ~cloexec:true () in let stdout_i, stdout_o = Unix.pipe ~cloexec:true () in let pid = @@ -27,7 +28,11 @@ end = struct in Unix.close stdin_i; Unix.close stdout_o; - let handler = Client.Handler.make () in + let handler = + match handler with + | Some h -> h + | None -> Client.Handler.make () + in let init = let blockity = if Sys.win32 then `Blocking diff --git a/ocaml-lsp-server/test/e2e-new/uri.ml b/ocaml-lsp-server/test/e2e-new/uri.ml new file mode 100644 index 000000000..5a5ac7270 --- /dev/null +++ b/ocaml-lsp-server/test/e2e-new/uri.ml @@ -0,0 +1,44 @@ +open Test.Import + +let%expect_test "uri" = + let notif_received = Fiber.Ivar.create () in + let handler = + let on_notification _ (notification : Lsp.Server_notification.t) = + (match notification with + | PublishDiagnostics d -> + print_endline "client: received publish diagnostics notification"; + Printf.printf "uri received from the server: %s\n" (d.uri |> DocumentUri.to_string) + | ShowMessage _ + | LogMessage _ + | TelemetryNotification _ + | CancelRequest _ + | WorkDoneProgress _ + | UnknownNotification _ -> ()); + let* () = Fiber.Ivar.fill notif_received () in + Fiber.return () + in + Client.Handler.make ~on_notification () + in + ( Test.run ~handler @@ fun client -> + let run_client () = + let capabilities = ClientCapabilities.create () in + Client.start client (InitializeParams.create ~capabilities ()) + in + let run = + let* (_ : InitializeResult.t) = Client.initialized client in + let uri = DocumentUri.of_path "src/néw/Mödel + Other Thîngß/test.ml" in + Printf.printf "uri sent to the server: %s\n" (DocumentUri.to_string uri); + let textDocument = + TextDocumentItem.create ~uri ~languageId:"ocaml" ~text:"" ~version:0 + in + let params = DidOpenTextDocumentParams.create ~textDocument in + let* () = Client.notification client (TextDocumentDidOpen params) in + Fiber.Ivar.read notif_received + in + Fiber.fork_and_join_unit run_client (fun () -> run >>> Client.stop client) + ); + [%expect + {| + uri sent to the server: file:///src/néw/Mödel + Other Thîngß/test.ml + client: received publish diagnostics notification + uri received from the server: file:///src/néw/Mödel + Other Thîngß/test.ml |}] diff --git a/ocaml-lsp-server/test/e2e/__tests__/uri.test.ts b/ocaml-lsp-server/test/e2e/__tests__/uri.test.ts new file mode 100644 index 000000000..ff910a3b6 --- /dev/null +++ b/ocaml-lsp-server/test/e2e/__tests__/uri.test.ts @@ -0,0 +1,48 @@ +import outdent from "outdent"; +import * as rpc from "vscode-jsonrpc/node"; +import * as LanguageServer from "../src/LanguageServer"; +import * as Protocol from "vscode-languageserver-protocol"; +import * as Types from "vscode-languageserver-types"; +import { URI } from "vscode-uri"; + +describe("uri", () => { + let languageServer: rpc.MessageConnection; + const uri = URI.file("src/néw/Mödel + Other Thîngß/test.ml").toString(); + + function openDocument(source: string) { + languageServer.sendNotification( + Protocol.DidOpenTextDocumentNotification.type, + { + textDocument: Types.TextDocumentItem.create(uri, "ocaml", 0, source), + }, + ); + } + + beforeEach(async () => { + languageServer = await LanguageServer.startAndInitialize(); + }); + + afterEach(async () => { + await LanguageServer.exit(languageServer); + }); + + it("handles uri with special characters", async () => { + let receivedDiganostics: Promise = + new Promise((resolve, _reject) => + languageServer.onNotification( + Protocol.PublishDiagnosticsNotification.type, + (params) => { + resolve(params); + }, + ), + ); + openDocument(outdent` + let () = + let x = 123 in + () + `); + const params = await receivedDiganostics; + + expect(params.uri).toBe(uri); + }); +});