diff --git a/src/jsonrpc2.ml b/src/jsonrpc2.ml index 398fdd89..63891c9e 100644 --- a/src/jsonrpc2.ml +++ b/src/jsonrpc2.ml @@ -316,14 +316,22 @@ module Make (IO : IO) : S with module IO = IO = struct When launching an LSP server using [Server.Make.server], the natural choice for it is [s#get_status = `ReceivedExit] *) let run ?(shutdown = fun _ -> false) (self : t) : unit IO.t = + let async f = + self.s#spawn_query_handler f; + IO.return () + in + let process_msg r = let module M = Jsonrpc.Packet in match r with - | M.Notification n -> handle_notification self n - | M.Request r -> handle_request self r - | M.Response r -> handle_response self r - | M.Batch_response rs -> handle_batch_response self rs - | M.Batch_call cs -> handle_batch_call self cs + | M.Notification n -> + (* NOTE: we handle some notifications sequentially, because + they do not commute (e.g. "TextDocumentDidChange" with incremental sync) *) + handle_notification self n + | M.Request r -> async (fun () -> handle_request self r) + | M.Response r -> async (fun () -> handle_response self r) + | M.Batch_response rs -> async (fun () -> handle_batch_response self rs) + | M.Batch_call cs -> async (fun () -> handle_batch_call self cs) in let rec loop () = if shutdown () then @@ -332,7 +340,7 @@ module Make (IO : IO) : S with module IO = IO = struct let* r = read_msg self in match r with | Ok r -> - self.s#spawn_query_handler (fun () -> process_msg r); + let* () = process_msg r in loop () | Error e -> IO.fail e in diff --git a/src/server.ml b/src/server.ml index c529f5ef..bb49c6e2 100644 --- a/src/server.ml +++ b/src/server.ml @@ -74,6 +74,10 @@ module Make (IO : IO) = struct @since NEXT_RELEASE *) end + let async (self : #base_server) f : unit IO.t = + self#spawn_query_handler f; + IO.return () + (** A wrapper to more easily reply to notifications *) class notify_back ~notify_back ~server_request ~workDoneToken ~partialResultToken:_ ?version ?(uri : DocumentUri.t option) () = @@ -308,8 +312,8 @@ module Make (IO : IO) = struct (** List symbols in this document. @since 0.3 *) - method on_unknown_request ~notify_back:(_ : notify_back) ~server_request:_ ~id:_ meth params - : Yojson.Safe.t IO.t = + method on_unknown_request ~notify_back:(_ : notify_back) ~server_request:_ + ~id:_ _meth _params : Yojson.Safe.t IO.t = IO.failwith "unhandled request" method on_request : type r. @@ -484,7 +488,8 @@ module Make (IO : IO) = struct ~workDoneToken:None ~partialResultToken:None ~notify_back ~server_request () in - self#on_unknown_request ~notify_back ~server_request ~id r.meth r.params + self#on_unknown_request ~notify_back ~server_request ~id r.meth + r.params method virtual on_notif_doc_did_open : notify_back:notify_back -> @@ -536,9 +541,11 @@ module Make (IO : IO) = struct } in Hashtbl.replace docs doc.uri st; - self#on_notif_doc_did_open - ~notify_back:(notify_back : notify_back) - doc ~content:st.content + + async self (fun () -> + self#on_notif_doc_did_open + ~notify_back:(notify_back : 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)); @@ -547,9 +554,11 @@ module Make (IO : IO) = struct ~workDoneToken:None ~partialResultToken:None ~uri:doc.uri ~notify_back ~server_request () in - self#on_notif_doc_did_close - ~notify_back:(notify_back : notify_back) - doc + + async self (fun () -> + self#on_notif_doc_did_close + ~notify_back:(notify_back : notify_back) + doc) | Lsp.Client_notification.TextDocumentDidChange { textDocument = doc; contentChanges = c } -> Log.debug (fun k -> @@ -599,11 +608,13 @@ module Make (IO : IO) = struct in Hashtbl.replace docs doc.uri new_st; - self#on_notif_doc_did_change - ~notify_back:(notify_back : notify_back) - doc c - ~old_content:(Lsp.Text_document.text old_doc) - ~new_content:new_st.content + + async self (fun () -> + self#on_notif_doc_did_change + ~notify_back:(notify_back : notify_back) + doc c + ~old_content:(Lsp.Text_document.text old_doc) + ~new_content:new_st.content) | Lsp.Client_notification.Exit -> status <- `ReceivedExit; IO.return () @@ -625,15 +636,18 @@ module Make (IO : IO) = struct ~workDoneToken:None ~partialResultToken:None ~notify_back ~server_request () in - self#on_notification_unhandled - ~notify_back:(notify_back : notify_back) - n + + async self (fun () -> + self#on_notification_unhandled + ~notify_back:(notify_back : notify_back) + n) | Lsp.Client_notification.UnknownNotification n -> let notify_back = new notify_back ~workDoneToken:None ~partialResultToken:None ~notify_back ~server_request () in - self#on_unknown_notification ~notify_back n + + async self (fun () -> self#on_unknown_notification ~notify_back n) end end