autoformat

example/template/dune

@@ -2,13 +2,12 @@
  (name main)
  (libraries
   ; Deps on linol + LWT backend
-    linol linol-lwt
+  linol
+  linol-lwt
   ; Types from the lsp library are exposed by the linol libs,
   ; and thus almost guaranteed to be used by code using linol;
   ; it is thus better to explicitly list lsp as a dep rather
   ; than rely on its inclusion as a transitive dep of linol
   ; since it would for instance generate errors if the
   ; implicit-transitive-deps option of dune is set to false
-    lsp
+  lsp))
-    )
- )

example/template/main.ml

@@ -20,10 +20,10 @@ type state_after_processing = unit
 let process_some_input_file (_file_contents : string) : state_after_processing =
   ()
 
-let diagnostics (_state : state_after_processing) : Lsp.Types.Diagnostic.t list =
+let diagnostics (_state : state_after_processing) : Lsp.Types.Diagnostic.t list
+    =
   []
 
-
 (* Lsp server class
 
    This is the main point of interaction beetween the code checking documents
@@ -40,16 +40,15 @@ class lsp_server =
     inherit Linol_lwt.Jsonrpc2.server
 
     (* one env per document *)
-    val buffers: (Lsp.Types.DocumentUri.t, state_after_processing) Hashtbl.t
+    val buffers : (Lsp.Types.DocumentUri.t, state_after_processing) Hashtbl.t =
-      = Hashtbl.create 32
+      Hashtbl.create 32
 
     (* We define here a helper method that will:
        - process a document
        - store the state resulting from the processing
        - return the diagnostics from the new state
     *)
-    method private _on_doc
+    method private _on_doc ~(notify_back : Linol_lwt.Jsonrpc2.notify_back)
-        ~(notify_back:Linol_lwt.Jsonrpc2.notify_back)
         (uri : Lsp.Types.DocumentUri.t) (contents : string) =
       let new_state = process_some_input_file contents in
       Hashtbl.replace buffers uri new_state;
@@ -63,7 +62,8 @@ class lsp_server =
 
     (* Similarly, we also override the [on_notify_doc_did_change] method that will be called
        by the server each time a new document is opened. *)
-    method on_notif_doc_did_change ~notify_back d _c ~old_content:_old ~new_content =
+    method on_notif_doc_did_change ~notify_back d _c ~old_content:_old
+        ~new_content =
       self#_on_doc ~notify_back d.uri new_content
 
     (* On document closes, we remove the state associated to the file from the global
@@ -71,7 +71,6 @@ class lsp_server =
     method on_notif_doc_did_close ~notify_back:_ d : unit Linol_lwt.t =
       Hashtbl.remove buffers d.uri;
       Linol_lwt.return ()
-
   end
 
 (* Main code
@@ -90,4 +89,3 @@ let run () =
 
 (* Finally, we actually run the server *)
 let () = run ()
-

src/blocking_IO.ml

@@ -1,4 +1,3 @@
-
 type 'a t = 'a
 type nonrec in_channel = in_channel
 type nonrec out_channel = out_channel
@@ -7,10 +6,8 @@ let (let+) x f = f x
 let ( let* ) x f = f x
 let ( and+ ) a b = a, b
 let return x = x
-
 let failwith = failwith
 let fail = raise
-
 let stdin = stdin
 let stdout = stdout
 
@@ -18,21 +15,16 @@ let default_spawn_ f =
   let run () =
     try f ()
     with e ->
-      Log.err (fun k->k
+      Log.err (fun k ->
-        "uncaught exception in `spawn`:\n%s\n%!"
+          k "uncaught exception in `spawn`:\n%s\n%!" (Printexc.to_string e));
-        (Printexc.to_string e));
       raise e
   in
   ignore (Thread.create run ())
 
 let spawn_ref_ = ref default_spawn_
-
 let set_spawn_function f = spawn_ref_ := f
 let spawn f = !spawn_ref_ f
-
+let catch f g = try f () with e -> g e
-let catch f g =
-  try f()
-  with e -> g e
 
 let rec read ic buf i len =
   if len > 0 then (
@@ -43,6 +35,9 @@ let rec read ic buf i len =
 let read_line = input_line
 
 let write oc b i len =
-  output oc b i len; flush oc
+  output oc b i len;
+  flush oc
+
 let write_string oc s =
-  output_string oc s; flush oc
+  output_string oc s;
+  flush oc

src/blocking_IO.mli

@@ -1,7 +1,8 @@
-
 (** {1 Blocking IO with a new thread for each [spawn]} *)
 
-include Sigs.IO with type 'a t = 'a
+include
+  Sigs.IO
+    with type 'a t = 'a
      and type in_channel = in_channel
      and type out_channel = out_channel
 

src/dune

@@ -1,4 +1,3 @@
-
 (library
  (name linol)
  (public_name linol)

src/jsonrpc2.mli

@@ -1,5 +1,3 @@
-
-
 type json = Yojson.Safe.t
 
 module type IO = Sigs.IO
@@ -12,22 +10,15 @@ module type S = sig
 
   include module type of Server.Make (IO)
 
-  val create :
+  val create : ic:IO.in_channel -> oc:IO.out_channel -> server -> t
-    ic:IO.in_channel ->
-    oc:IO.out_channel ->
-    server ->
-    t
   (** Create a connection from the pair of channels *)
 
   val create_stdio : server -> t
   (** Create a connection using stdin/stdout *)
 
-  val run :
+  val run : ?shutdown:(unit -> bool) -> t -> unit IO.t
-    ?shutdown:(unit -> bool) ->
-    t -> unit IO.t
   (** Listen for incoming messages and responses.
     @param shutdown if true, tells the server to shut down *)
 end
 
 module Make (IO : IO) : S with module IO = IO
-

src/linol.ml

@@ -1,13 +1,12 @@
-
 (** {1 Linol}
 
     Abstraction over The "Lsp" library, to make it easier to develop
     LSP servers in OCaml (but not necessarily {b for} OCaml). *)
 
 module type IO = Sigs.IO
+
 module Jsonrpc2 = Jsonrpc2
 module Server = Server
 module Blocking_IO = Blocking_IO
 module Log = Log
-
 module Make = Jsonrpc2.Make

src/log.ml

@@ -1,2 +1 @@
-
 include (val Logs.src_log (Logs.Src.create ~doc:"linol (LSP library)" "linol"))

src/lwt/dune

@@ -1,4 +1,3 @@
-
 (library
  (name linol_lwt)
  (public_name linol-lwt)

src/lwt/linol_lwt.ml

@@ -1,20 +1,22 @@
-
 module type IO = Linol.IO
 
-module IO_lwt
+module IO_lwt :
-  : IO with type 'a t = 'a Lwt.t
+  IO
+    with type 'a t = 'a Lwt.t
      and type in_channel = Lwt_io.input Lwt_io.channel
-        and type out_channel = Lwt_io.output Lwt_io.channel
+     and type out_channel = Lwt_io.output Lwt_io.channel = struct
-= struct
   type 'a t = 'a Lwt.t
+
   let ( let+ ) = Lwt.( >|= )
   let ( let* ) = Lwt.( >>= )
+
   let ( and+ ) a b =
     let open Lwt in
-    a >>= fun x -> b >|= fun y -> x,y
+    a >>= fun x ->
+    b >|= fun y -> x, y
+
   let return = Lwt.return
   let failwith = Lwt.fail_with
-
   let stdin = Lwt_io.stdin
   let stdout = Lwt_io.stdout
 
@@ -25,15 +27,12 @@ module IO_lwt
   let write = Lwt_io.write_from_exactly
   let read = Lwt_io.read_into_exactly
   let read_line = Lwt_io.read_line
-
   let catch = Lwt.catch
   let fail = Lwt.fail
 
   let spawn f =
-    Lwt.async
+    Lwt.async (fun () ->
-      (fun () ->
+        Lwt.catch f (fun exn ->
-         Lwt.catch f
-           (fun exn ->
             Printf.eprintf "uncaught exception in `spawn`:\n%s\n%!"
               (Printexc.to_string exn);
             Lwt.return ()))
@@ -41,6 +40,7 @@ end
 
 include Lsp.Types
 include IO_lwt
+
 type doc_state = Linol.Server.doc_state
 
 module Jsonrpc2 = Linol.Jsonrpc2.Make (IO_lwt)

src/server.ml

@@ -1,13 +1,12 @@
-
 open Sigs
 
-(** Current state of a document. *)
 type nonrec doc_state = {
   uri: Lsp.Types.DocumentUri.t;
   languageId: string;
   version: int;
   content: string;
 }
+(** Current state of a document. *)
 
 (** {2 Request ID}
 
@@ -24,7 +23,6 @@ end
 (** {2 Server interface for some IO substrate} *)
 module Make (IO : IO) = struct
   open Lsp.Types
-
   module Position = Position
   module Range = Range
   module Diagnostic = Diagnostic
@@ -32,13 +30,15 @@ module Make(IO : IO) = struct
   module Req_id = Req_id
 
   (** The server baseclass *)
-  class virtual base_server = object
+  class virtual base_server =
-    method virtual on_notification :
+    object
-      notify_back:(Lsp.Server_notification.t -> unit IO.t) ->
+      method virtual on_notification
+          : notify_back:(Lsp.Server_notification.t -> unit IO.t) ->
             Lsp.Client_notification.t ->
             unit IO.t
 
-    method virtual on_request : 'a.
+      method virtual on_request
+          : 'a.
             notify_back:(Lsp.Server_notification.t -> unit IO.t) ->
             id:Req_id.t ->
             'a Lsp.Client_request.t ->
@@ -48,72 +48,75 @@ module Make(IO : IO) = struct
         messages, diagnostics, etc.
         @param id the query RPC ID, can be used for tracing, cancellation, etc. *)
 
-    (** Set to true if the client requested to exit *)
       method must_quit = false
+      (** Set to true if the client requested to exit *)
     end
 
   (** A wrapper to more easily reply to notifications *)
-  class notify_back ~notify_back ?version ?(uri:DocumentUri.t option) () = object
+  class notify_back ~notify_back ?version ?(uri : DocumentUri.t option) () =
+    object
       val mutable uri = uri
       method set_uri u = uri <- Some u
 
-    (** Send a log message to the editor *)
       method send_log_msg ~type_ msg : unit IO.t =
         let params = LogMessageParams.create ~type_ ~message:msg in
         notify_back (Lsp.Server_notification.LogMessage params)
+      (** Send a log message to the editor *)
 
-    (** Send diagnostics for the current document *)
       method send_diagnostic (l : Diagnostic.t list) : unit IO.t =
         match uri with
-      | None -> IO.failwith "notify_back: cannot publish diagnostics, no URI given"
+        | None ->
+          IO.failwith "notify_back: cannot publish diagnostics, no URI given"
         | Some uri ->
-        let params = PublishDiagnosticsParams.create
+          let params =
-            ~uri ?version ~diagnostics:l () in
+            PublishDiagnosticsParams.create ~uri ?version ~diagnostics:l ()
+          in
           notify_back (Lsp.Server_notification.PublishDiagnostics params)
+      (** Send diagnostics for the current document *)
 
+      method send_notification (n : Lsp.Server_notification.t) = notify_back n
       (** Send a notification (general purpose method) *)
-    method send_notification (n:Lsp.Server_notification.t) =
-      notify_back n
     end
 
-  (** Current state of a document. *)
   type nonrec doc_state = doc_state = {
     uri: DocumentUri.t;
     languageId: string;
     version: int;
     content: string;
   }
+  (** Current state of a document. *)
 
   (** An easily overloadable class. Pick the methods you want to support.
       The user must provide at least the callbacks for document lifecycle:
       open, close, update. The most basic LSP server should check documents
       when they're updated and report diagnostics back to the editor. *)
-  class virtual server = object(self)
+  class virtual server =
+    object (self)
       inherit base_server
       val mutable _quit = false
       val docs : (DocumentUri.t, doc_state) Hashtbl.t = Hashtbl.create 16
-
       method! must_quit = _quit
 
-    (** Find current state of the given document, if present. *)
       method find_doc (uri : DocumentUri.t) : doc_state option =
-      try Some (Hashtbl.find docs uri)
+        try Some (Hashtbl.find docs uri) with Not_found -> None
-      with Not_found -> None
+      (** Find current state of the given document, if present. *)
 
-    (** Override to process other requests *)
+      method on_request_unhandled : type r.
-    method on_request_unhandled
+          notify_back:notify_back ->
-      : type r. notify_back:notify_back ->
+          id:Req_id.t ->
-        id:Req_id.t -> r Lsp.Client_request.t -> r IO.t
+          r Lsp.Client_request.t ->
-      = fun ~notify_back:_ ~id:_ _r ->
+          r IO.t =
+        fun ~notify_back:_ ~id:_ _r ->
           Log.debug (fun k -> k "req: unhandled request");
           IO.failwith "TODO: handle this request"
+      (** Override to process other requests *)
 
-    (** Parameter for how to synchronize content with the editor *)
       method config_sync_opts : TextDocumentSyncOptions.t =
-      TextDocumentSyncOptions.create
+        TextDocumentSyncOptions.create ~change:TextDocumentSyncKind.Incremental
-        ~change:TextDocumentSyncKind.Incremental ~openClose:true
+          ~openClose:true
           ~save:(`SaveOptions (SaveOptions.create ~includeText:false ()))
           ~willSave:false ()
+      (** Parameter for how to synchronize content with the editor *)
 
       method config_completion : CompletionOptions.t option = None
       (** Configuration for the completion API.
@@ -122,39 +125,50 @@ module Make(IO : IO) = struct
       method config_code_lens_options : CodeLensOptions.t option = None
       (** @since 0.3 *)
 
-    method config_definition :
+      method config_definition
-      [`Bool of bool | `DefinitionOptions of DefinitionOptions.t ] option = None
+          : [ `Bool of bool | `DefinitionOptions of DefinitionOptions.t ] option
+          =
+        None
       (** @since 0.3 *)
 
-    method config_hover :
+      method config_hover
-      [`Bool of bool | `HoverOptions of HoverOptions.t ] option = None
+          : [ `Bool of bool | `HoverOptions of HoverOptions.t ] option =
+        None
       (** @since 0.3 *)
 
-    method config_symbol :
+      method config_symbol
-      [`Bool of bool | `DocumentSymbolOptions of DocumentSymbolOptions.t ] option = None
+          : [ `Bool of bool
+            | `DocumentSymbolOptions of DocumentSymbolOptions.t
+            ]
+            option =
+        None
       (** @since 0.3 *)
 
-    method config_code_action_provider :
+      method config_code_action_provider
-      [`CodeActionOptions of CodeActionOptions.t | `Bool of bool] = `Bool false
+          : [ `CodeActionOptions of CodeActionOptions.t | `Bool of bool ] =
+        `Bool false
       (** @since 0.3 *)
 
+      method config_modify_capabilities (c : ServerCapabilities.t)
+          : ServerCapabilities.t =
+        c
       (** Modify capabilities before sending them back to the client.
         By default we just return them unmodified.
         @since 0.3 *)
-    method config_modify_capabilities (c:ServerCapabilities.t) : ServerCapabilities.t = c
 
-    (** List of commands available *)
       method config_list_commands : string list = []
+      (** List of commands available *)
 
-    method on_req_initialize ~notify_back:_
+      method on_req_initialize ~notify_back:_ (_i : InitializeParams.t)
-        (_i:InitializeParams.t) : InitializeResult.t IO.t =
+          : InitializeResult.t IO.t =
         let sync_opts = self#config_sync_opts in
         let capabilities =
           ServerCapabilities.create
             ?codeLensProvider:self#config_code_lens_options
             ~codeActionProvider:self#config_code_action_provider
-          ~executeCommandProvider:(ExecuteCommandOptions.create
+            ~executeCommandProvider:
-                                     ~commands:self#config_list_commands ())
+              (ExecuteCommandOptions.create ~commands:self#config_list_commands
+                 ())
             ?completionProvider:self#config_completion
             ?definitionProvider:self#config_definition
             ?hoverProvider:self#config_hover
@@ -164,143 +178,145 @@ module Make(IO : IO) = struct
         in
         IO.return @@ InitializeResult.create ~capabilities ()
 
-    (** Called when the user hovers on some identifier in the document *)
       method on_req_hover ~notify_back:_ ~id:_ ~uri:_ ~pos:_ ~workDoneToken:_
           (_ : doc_state) : Hover.t option IO.t =
         IO.return None
+      (** Called when the user hovers on some identifier in the document *)
 
-    (** Called when the user requests completion in the document *)
       method on_req_completion ~notify_back:_ ~id:_ ~uri:_ ~pos:_ ~ctx:_
-        ~workDoneToken:_ ~partialResultToken:_
+          ~workDoneToken:_ ~partialResultToken:_ (_ : doc_state)
-        (_ : doc_state) :
+          : [ `CompletionList of CompletionList.t
-          [ `CompletionList of CompletionList.t
+            | `List of CompletionItem.t list
-          | `List of CompletionItem.t list ] option IO.t =
+            ]
+            option
+            IO.t =
         IO.return None
+      (** Called when the user requests completion in the document *)
 
-    (** Called when the user wants to jump-to-definition  *)
       method on_req_definition ~notify_back:_ ~id:_ ~uri:_ ~pos:_
-        ~workDoneToken:_ ~partialResultToken:_
+          ~workDoneToken:_ ~partialResultToken:_ (_ : doc_state)
-        (_ : doc_state) : Locations.t option IO.t =
+          : Locations.t option IO.t =
         IO.return None
+      (** Called when the user wants to jump-to-definition  *)
 
+      method on_req_code_lens ~notify_back:_ ~id:_ ~uri:_ ~workDoneToken:_
+          ~partialResultToken:_ (_ : doc_state) : CodeLens.t list IO.t =
+        IO.return []
       (** List code lenses for the given document
         @since 0.3 *)
-    method on_req_code_lens  ~notify_back:_ ~id:_ ~uri:_
-        ~workDoneToken:_ ~partialResultToken:_
-        (_ : doc_state) : CodeLens.t list IO.t =
-      IO.return []
 
-    (** Code lens resolution, must return a code lens with non null "command"
+      method on_req_code_lens_resolve ~notify_back:(_ : notify_back) ~id:_
-        @since 0.3 *)
-    method on_req_code_lens_resolve
-        ~notify_back:(_:notify_back) ~id:_
           (cl : CodeLens.t) : CodeLens.t IO.t =
         IO.return cl
+      (** Code lens resolution, must return a code lens with non null "command"
+        @since 0.3 *)
 
+      method on_req_code_action ~notify_back:(_ : notify_back) ~id:_
+          (_c : CodeActionParams.t) : CodeActionResult.t IO.t =
+        IO.return None
       (** Code action.
         @since 0.3 *)
-    method on_req_code_action ~notify_back:(_:notify_back) ~id:_
-        (_c:CodeActionParams.t)
-      : CodeActionResult.t IO.t =
-      IO.return None
 
+      method on_req_execute_command ~notify_back:_ ~id:_ ~workDoneToken:_
+          (_c : string) (_args : Yojson.Safe.t list option) : Yojson.Safe.t IO.t
+          =
+        IO.return `Null
       (** Execute a command with given arguments.
         @since 0.3 *)
-    method on_req_execute_command ~notify_back:_ ~id:_ ~workDoneToken:_
-        (_c:string) (_args:Yojson.Safe.t list option) : Yojson.Safe.t IO.t =
-      IO.return `Null
 
+      method on_req_symbol ~notify_back:_ ~id:_ ~uri:_ ~workDoneToken:_
+          ~partialResultToken:_ ()
+          : [ `DocumentSymbol of DocumentSymbol.t list
+            | `SymbolInformation of SymbolInformation.t list
+            ]
+            option
+            IO.t =
+        IO.return None
       (** List symbols in this document.
         @since 0.3 *)
-    method on_req_symbol ~notify_back:_ ~id:_ ~uri:_
-        ~workDoneToken:_ ~partialResultToken:_
-        () : [ `DocumentSymbol of DocumentSymbol.t list
-             | `SymbolInformation of SymbolInformation.t list ] option IO.t =
-      IO.return None
 
-    method on_request
+      method on_request : type r.
-    : type r. notify_back:_ -> id:Req_id.t -> r Lsp.Client_request.t -> r IO.t
+          notify_back:_ -> id:Req_id.t -> r Lsp.Client_request.t -> r IO.t =
-    = fun ~notify_back ~id (r:_ Lsp.Client_request.t) ->
+        fun ~notify_back ~id (r : _ Lsp.Client_request.t) ->
-      Log.debug (fun k->k "handle request[id=%s] <opaque>" (Req_id.to_string id));
+          Log.debug (fun k ->
+              k "handle request[id=%s] <opaque>" (Req_id.to_string id));
 
-      begin match r with
+          match r with
           | Lsp.Client_request.Shutdown ->
             Log.info (fun k -> k "shutdown");
-          _quit <- true; IO.return ()
+            _quit <- true;
-
+            IO.return ()
           | Lsp.Client_request.Initialize i ->
             Log.debug (fun k -> k "req: initialize");
             let notify_back = new notify_back ~notify_back () in
             self#on_req_initialize ~notify_back i
-
+          | Lsp.Client_request.TextDocumentHover
-        | Lsp.Client_request.TextDocumentHover { textDocument; position; workDoneToken } ->
+              { textDocument; position; workDoneToken } ->
             let uri = textDocument.uri in
             Log.debug (fun k -> k "req: hover '%s'" (DocumentUri.to_path uri));
 
-          begin match Hashtbl.find_opt docs uri with
+            (match Hashtbl.find_opt docs uri with
             | None -> IO.return None
             | Some doc_st ->
               let notify_back = new notify_back ~uri ~notify_back () in
-              self#on_req_hover ~notify_back ~id ~uri ~pos:position ~workDoneToken doc_st
+              self#on_req_hover ~notify_back ~id ~uri ~pos:position
-          end
+                ~workDoneToken doc_st)
-
+          | Lsp.Client_request.TextDocumentCompletion
-        | Lsp.Client_request.TextDocumentCompletion {
+              {
-            textDocument; position; context; workDoneToken; partialResultToken;
+                textDocument;
+                position;
+                context;
+                workDoneToken;
+                partialResultToken;
               } ->
             let uri = textDocument.uri in
-          Log.debug (fun k->k "req: complete '%s'" (DocumentUri.to_path uri));
+            Log.debug (fun k ->
-          begin match Hashtbl.find_opt docs uri with
+                k "req: complete '%s'" (DocumentUri.to_path uri));
+            (match Hashtbl.find_opt docs uri with
             | None -> IO.return None
             | Some doc_st ->
               let notify_back = new notify_back ~uri ~notify_back () in
-              self#on_req_completion ~notify_back ~id ~uri
+              self#on_req_completion ~notify_back ~id ~uri ~workDoneToken
-                ~workDoneToken ~partialResultToken
+                ~partialResultToken ~pos:position ~ctx:context doc_st)
-                ~pos:position ~ctx:context doc_st
+          | Lsp.Client_request.TextDocumentDefinition
-          end
+              { textDocument; position; workDoneToken; partialResultToken } ->
-        | Lsp.Client_request.TextDocumentDefinition {
-            textDocument; position; workDoneToken; partialResultToken;
-          } ->
             let uri = textDocument.uri in
-          Log.debug (fun k->k "req: definition '%s'" (DocumentUri.to_path uri));
+            Log.debug (fun k ->
+                k "req: definition '%s'" (DocumentUri.to_path uri));
             let notify_back = new notify_back ~uri ~notify_back () in
 
-          begin match Hashtbl.find_opt docs uri with
+            (match Hashtbl.find_opt docs uri with
             | None -> IO.return None
             | Some doc_st ->
-              self#on_req_definition ~notify_back ~id
+              self#on_req_definition ~notify_back ~id ~workDoneToken
-                ~workDoneToken ~partialResultToken
+                ~partialResultToken ~uri ~pos:position doc_st)
-                ~uri ~pos:position doc_st
+          | Lsp.Client_request.TextDocumentCodeLens
-          end
+              { textDocument; workDoneToken; partialResultToken } ->
-
-        | Lsp.Client_request.TextDocumentCodeLens {
-            textDocument; workDoneToken; partialResultToken;
-          } ->
             let uri = textDocument.uri in
-          Log.debug (fun k->k "req: codelens '%s'" (DocumentUri.to_path uri));
+            Log.debug (fun k ->
+                k "req: codelens '%s'" (DocumentUri.to_path uri));
             let notify_back = new notify_back ~uri ~notify_back () in
 
-          begin match Hashtbl.find_opt docs uri with
+            (match Hashtbl.find_opt docs uri with
             | None -> IO.return []
             | Some doc_st ->
-              self#on_req_code_lens ~notify_back ~id ~uri
+              self#on_req_code_lens ~notify_back ~id ~uri ~workDoneToken
-                ~workDoneToken ~partialResultToken doc_st
+                ~partialResultToken doc_st)
-          end
-
           | Lsp.Client_request.TextDocumentCodeLensResolve cl ->
             Log.debug (fun k -> k "req: codelens resolve");
             let notify_back = new notify_back ~notify_back () in
             self#on_req_code_lens_resolve ~notify_back ~id cl
-
+          | Lsp.Client_request.ExecuteCommand
-        | Lsp.Client_request.ExecuteCommand { command; arguments; workDoneToken } ->
+              { command; arguments; workDoneToken } ->
             Log.debug (fun k -> k "req: execute command '%s'" command);
             let notify_back = new notify_back ~notify_back () in
-          self#on_req_execute_command ~notify_back ~id ~workDoneToken command arguments
+            self#on_req_execute_command ~notify_back ~id ~workDoneToken command
-
+              arguments
-        | Lsp.Client_request.DocumentSymbol { textDocument=d; workDoneToken; partialResultToken } ->
+          | Lsp.Client_request.DocumentSymbol
+              { textDocument = d; workDoneToken; partialResultToken } ->
             let notify_back = new notify_back ~notify_back () in
-          self#on_req_symbol ~notify_back ~id ~uri:d.uri
+            self#on_req_symbol ~notify_back ~id ~uri:d.uri ~workDoneToken
-            ~workDoneToken ~partialResultToken ()
+              ~partialResultToken ()
-
           | Lsp.Client_request.CodeAction a ->
             let notify_back = new notify_back ~notify_back () in
             self#on_req_code_action ~notify_back ~id a
@@ -341,78 +357,83 @@ module Make(IO : IO) = struct
           | Lsp.Client_request.UnknownRequest _ ->
             let notify_back = new notify_back ~notify_back () in
             self#on_request_unhandled ~notify_back ~id r
-      end
 
-    (** Called when a document is opened *)
+      method virtual on_notif_doc_did_open
-    method virtual on_notif_doc_did_open :
+          : notify_back:notify_back ->
-      notify_back:notify_back ->
             TextDocumentItem.t ->
             content:string ->
             unit IO.t
+      (** Called when a document is opened *)
 
-    method virtual on_notif_doc_did_close :
+      method virtual on_notif_doc_did_close
-      notify_back:notify_back ->
+          : notify_back:notify_back -> TextDocumentIdentifier.t -> unit IO.t
-      TextDocumentIdentifier.t ->
-      unit IO.t
 
-    (** Called when the document changes. *)
+      method virtual on_notif_doc_did_change
-    method virtual on_notif_doc_did_change :
+          : notify_back:notify_back ->
-      notify_back:notify_back ->
             VersionedTextDocumentIdentifier.t ->
             TextDocumentContentChangeEvent.t list ->
             old_content:string ->
             new_content:string ->
             unit IO.t
+      (** Called when the document changes. *)
 
-    (** Override to handle unprocessed notifications *)
+      method on_notification_unhandled ~notify_back:_
-    method on_notification_unhandled
+          (_n : Lsp.Client_notification.t) : unit IO.t =
-        ~notify_back:_ (_n:Lsp.Client_notification.t) : unit IO.t =
         IO.return ()
+      (** Override to handle unprocessed notifications *)
 
-    method on_notification
+      method on_notification ~notify_back (n : Lsp.Client_notification.t)
-        ~notify_back (n:Lsp.Client_notification.t) : unit IO.t =
+          : unit IO.t =
         let open Lsp.Types in
-
+        match n with
-      begin match n with
         | Lsp.Client_notification.TextDocumentDidOpen
             { DidOpenTextDocumentParams.textDocument = doc } ->
-          Log.debug (fun k->k "notif: did open '%s'" (DocumentUri.to_path doc.uri));
+          Log.debug (fun k ->
+              k "notif: did open '%s'" (DocumentUri.to_path doc.uri));
           let notify_back =
-            new notify_back ~uri:doc.uri ~version:doc.version ~notify_back () in
+            new notify_back ~uri:doc.uri ~version:doc.version ~notify_back ()
-          let st = {
+          in
-            uri=doc.uri; version=doc.version; content=doc.text;
+          let st =
+            {
+              uri = doc.uri;
+              version = doc.version;
+              content = doc.text;
               languageId = doc.languageId;
-          } in
+            }
+          in
           Hashtbl.replace docs doc.uri st;
           self#on_notif_doc_did_open ~notify_back doc ~content:st.content
-
         | Lsp.Client_notification.TextDocumentDidClose { textDocument = doc } ->
-          Log.debug (fun k->k "notif: did close '%s'" (DocumentUri.to_path doc.uri));
+          Log.debug (fun k ->
+              k "notif: did close '%s'" (DocumentUri.to_path doc.uri));
           let notify_back = new notify_back ~uri:doc.uri ~notify_back () in
           self#on_notif_doc_did_close ~notify_back doc
-
+        | Lsp.Client_notification.TextDocumentDidChange
-        | Lsp.Client_notification.TextDocumentDidChange {textDocument=doc; contentChanges=c} ->
+            { textDocument = doc; contentChanges = c } ->
-          Log.debug (fun k->k "notif: did change '%s'" (DocumentUri.to_path doc.uri));
+          Log.debug (fun k ->
+              k "notif: did change '%s'" (DocumentUri.to_path doc.uri));
           let notify_back = new notify_back ~uri:doc.uri ~notify_back () in
 
           let old_doc =
             match Hashtbl.find_opt docs doc.uri with
             | None ->
               (* WTF vscode. Well let's try and deal with it. *)
-              Log.err (fun k->k "unknown document: '%s'" (DocumentUri.to_path doc.uri));
+              Log.err (fun k ->
+                  k "unknown document: '%s'" (DocumentUri.to_path doc.uri));
               let version = doc.version in
 
-              let languageId = "" in (* FIXME*)
+              let languageId = "" in
+              (* FIXME*)
               Lsp.Text_document.make
                 (DidOpenTextDocumentParams.create
-                   ~textDocument:(
+                   ~textDocument:
-                     TextDocumentItem.create ~languageId
+                     (TextDocumentItem.create ~languageId ~uri:doc.uri ~version
-                       ~uri:doc.uri ~version ~text:""))
+                        ~text:""))
             | Some st ->
               Lsp.Text_document.make
                 (DidOpenTextDocumentParams.create
-                     ~textDocument:(
+                   ~textDocument:
-                       TextDocumentItem.create ~languageId:st.languageId
+                     (TextDocumentItem.create ~languageId:st.languageId
                         ~uri:doc.uri ~version:st.version ~text:st.content))
           in
 
@@ -422,18 +443,22 @@ module Make(IO : IO) = struct
               old_doc c
           in
 
-          let new_st : doc_state = {
+          let new_st : doc_state =
-            uri=doc.uri; languageId=Lsp.Text_document.languageId new_doc;
+            {
+              uri = doc.uri;
+              languageId = Lsp.Text_document.languageId new_doc;
               content = Lsp.Text_document.text new_doc;
               version = Lsp.Text_document.version new_doc;
-          } in
+            }
+          in
 
           Hashtbl.replace docs doc.uri new_st;
           self#on_notif_doc_did_change ~notify_back doc c
             ~old_content:(Lsp.Text_document.text old_doc)
             ~new_content:new_st.content
-
+        | Lsp.Client_notification.Exit ->
-        | Lsp.Client_notification.Exit -> _quit <- true; IO.return ()
+          _quit <- true;
+          IO.return ()
         | Lsp.Client_notification.DidSaveTextDocument _
         | Lsp.Client_notification.WillSaveTextDocument _
         | Lsp.Client_notification.ChangeWorkspaceFolders _
@@ -447,10 +472,8 @@ module Make(IO : IO) = struct
         | Lsp.Client_notification.DidCreateFiles _
         | Lsp.Client_notification.DidDeleteFiles _
         | Lsp.Client_notification.DidRenameFiles _
-        | Lsp.Client_notification.LogTrace _
+        | Lsp.Client_notification.LogTrace _ ->
-          ->
           let notify_back = new notify_back ~notify_back () in
           self#on_notification_unhandled ~notify_back n
     end
 end
-end

src/sigs.ml

@@ -1,12 +1,9 @@
-
-
 (** {2 Parametrized IO Interface} *)
 module type IO = sig
   type 'a t
 
   val return : 'a -> 'a t
   val failwith : string -> 'a t
-
   val ( let+ ) : 'a t -> ('a -> 'b) -> 'b t
   val ( let* ) : 'a t -> ('a -> 'b t) -> 'b t
   val ( and+ ) : 'a t -> 'b t -> ('a * 'b) t
@@ -16,10 +13,8 @@ module type IO = sig
 
   val stdin : in_channel
   val stdout : out_channel
-
   val read : in_channel -> bytes -> int -> int -> unit t
   val read_line : in_channel -> string t
-
   val write : out_channel -> bytes -> int -> int -> unit t
   val write_string : out_channel -> string -> unit t