test: add e2e test written in ocaml

to eventually move from typescript

Signed-off-by: Rudi Grinberg <[email protected]>

ps-id: 4CC3EB73-8829-4570-A406-CF9BAF35BFC2

Author: rgrinberg

jsonrpc-fiber/src/jsonrpc_fiber.ml

@@ -275,7 +275,6 @@ struct
         close t)
 
   let check_running t =
-    (* TODO we should also error out when making requests after a disconnect. *)
     if not t.running then Code_error.raise "jsonrpc must be running" []
 
   let notification t (n : Notification.t) =

lsp-fiber/src/rpc.ml

@@ -162,13 +162,17 @@ struct
       Format.eprintf "dropped notification@.%!";
       assert false
 
-    let make ?on_request ?(on_notification = on_notification_default) () =
-      let h_on_request =
-        match on_request with
-        | Some t -> t
-        | None -> assert false
-      in
-      { h_on_request; h_on_notification = on_notification }
+    let on_request_default =
+      { on_request =
+          (fun _ _ ->
+            Jsonrpc.Response.Error.make ~code:InternalError
+              ~message:"Not supported" ()
+            |> Jsonrpc.Response.Error.raise)
+      }
+
+    let make ?(on_request = on_request_default)
+        ?(on_notification = on_notification_default) () =
+      { h_on_request = on_request; h_on_notification = on_notification }
   end
 
   let state t = Session.state (Fdecl.get t.session)
@@ -379,7 +383,7 @@ module Client = struct
   let start (t : _ t) (p : InitializeParams.t) =
     Fiber.of_thunk (fun () ->
         assert (t.state = Waiting_for_init);
-        let loop = start_loop t in
+        let loop () = start_loop t in
         let init () =
           let* resp = request t (Client_request.Initialize p) in
           Log.log ~section:"client" (fun () ->
@@ -388,7 +392,7 @@ module Client = struct
           t.state <- Running;
           Fiber.Ivar.fill t.initialized resp
         in
-        Fiber.fork_and_join_unit (fun () -> loop) init)
+        Fiber.fork_and_join_unit loop init)
 end
 
 module Server = struct

ocaml-lsp-server/test/e2e-new/dune

@@ -0,0 +1,23 @@
+(library
+ (name ocaml_lsp_e2e)
+ (inline_tests
+  (deps
+   (package ocaml-lsp-server)))
+ (libraries
+  stdune
+  fiber
+  yojson
+  lev_fiber
+  lev
+  spawn
+  lsp
+  lsp_fiber
+  ;; This is because of the (implicit_transitive_deps false)
+  ;; in dune-project
+  base
+  ppx_expect.common
+  ppx_expect.config
+  ppx_expect.config_types
+  ppx_inline_test.config)
+ (preprocess
+  (pps ppx_expect)))

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

@@ -0,0 +1,120 @@
+open Stdune
+open Fiber.O
+
+let _PATH =
+  Bin.parse_path (Option.value ~default:"" @@ Env.get Env.initial "PATH")
+
+let bin = Bin.which "ocamllsp" ~path:_PATH |> Option.value_exn |> Path.to_string
+
+let env = Spawn.Env.of_list [ "OCAMLLSP_TEST=true" ]
+
+module Client = Lsp_fiber.Client
+open Lsp.Types
+
+let%expect_test "start/stop" =
+  let stdin_i, stdin_o = Unix.pipe ~cloexec:true () in
+  let stdout_i, stdout_o = Unix.pipe ~cloexec:true () in
+  let pid =
+    Spawn.spawn ~env ~prog:bin ~argv:[ bin ] ~stdin:stdin_i ~stdout:stdout_o ()
+  in
+  Unix.close stdin_i;
+  Unix.close stdout_o;
+  let handler = Client.Handler.make () in
+  let init =
+    let blockity =
+      if Sys.win32 then `Blocking
+      else (
+        Unix.set_nonblock stdout_i;
+        Unix.set_nonblock stdin_o;
+        `Non_blocking true)
+    in
+    let make fd what =
+      let fd = Lev_fiber.Fd.create fd blockity in
+      Lev_fiber.Io.create fd what
+    in
+    let* in_ = make stdout_i Input in
+    let* out = make stdin_o Output in
+    let io = Lsp_fiber.Fiber_io.make in_ out in
+    let client = Client.make handler io () in
+    let run_client () =
+      let capabilities = ClientCapabilities.create () in
+      Client.start client (InitializeParams.create ~capabilities ())
+    in
+    let print_init =
+      let+ resp = Client.initialized client in
+      print_endline "client: server initialized with:";
+      InitializeResult.yojson_of_t resp
+      |> Yojson.Safe.pretty_to_string ~std:false
+      |> print_endline
+    in
+    let run =
+      let* () = print_init in
+      print_endline "client: shutting down server";
+      Client.request client Shutdown
+    in
+    Fiber.fork_and_join_unit run_client (fun () -> run >>> Client.stop client)
+  in
+  let waitpid =
+    let+ (_ : Unix.process_status) = Lev_fiber.waitpid ~pid in
+    ()
+  in
+  Lev_fiber.run
+    ~f:(fun () -> Fiber.all_concurrently_unit [ init; waitpid ])
+    (Lev.Loop.default ());
+  [%expect
+    {|
+      client: server initialized with:
+      {
+        "capabilities": {
+          "textDocumentSync": {
+            "openClose": true,
+            "change": 2,
+            "willSave": false,
+            "willSaveWaitUntil": false,
+            "save": true
+          },
+          "completionProvider": {
+            "triggerCharacters": [ ".", "#" ],
+            "resolveProvider": true
+          },
+          "hoverProvider": true,
+          "signatureHelpProvider": {
+            "triggerCharacters": [ " ", "~", "?", ":", "(" ]
+          },
+          "declarationProvider": true,
+          "definitionProvider": true,
+          "typeDefinitionProvider": true,
+          "referencesProvider": true,
+          "documentHighlightProvider": true,
+          "documentSymbolProvider": true,
+          "codeActionProvider": {
+            "codeActionKinds": [
+              "quickfix", "construct", "destruct", "inferred_intf",
+              "put module name in identifiers",
+              "remove module name from identifiers", "type-annotate"
+            ]
+          },
+          "codeLensProvider": { "resolveProvider": false },
+          "documentFormattingProvider": true,
+          "renameProvider": { "prepareProvider": true },
+          "foldingRangeProvider": true,
+          "executeCommandProvider": { "commands": [ "dune/promote" ] },
+          "selectionRangeProvider": true,
+          "workspaceSymbolProvider": true,
+          "workspace": {
+            "workspaceFolders": { "supported": true, "changeNotifications": true }
+          },
+          "experimental": {
+            "ocamllsp": {
+              "interfaceSpecificLangId": true,
+              "handleSwitchImplIntf": true,
+              "handleInferIntf": true,
+              "handleTypedHoles": true,
+              "handleWrappingAstNode": true,
+              "diagnostic_promotions": true
+            }
+          }
+        },
+        "serverInfo": { "name": "ocamllsp", "version": "dev" }
+      }
+      client: shutting down server |}]