simon/linol
1
0
Fork 0
mirror of https://github.com/c-cube/linol.git synced 2025-12-05 19:00:34 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

Merge pull request #41 from wintersteiger/christoph/more-error-handlers

Browse source 
Add more error handlers and exception catchers
This commit is contained in:
Simon Cruanes 2024-07-31 12:34:30 -04:00 • committed by GitHub
commit f09e36523f
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
7 changed files with 147 additions and 61 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

11
src/blocking_IO.ml
View file

@ -10,7 +10,9 @@ let ( let* ) x f = f x
let ( and+ ) a b = a, b
let return x = x
let failwith = failwith
let fail = raise
let fail = Printexc.raise_with_backtrace
let stdin = fun () -> stdin
let stdout = fun () -> stdout
@ -25,7 +27,12 @@ let default_spawn f =
in
ignore (Thread.create run ())
let catch f g = try f () with e -> g e
let catch f g =
try f ()
with e ->
let bt = Printexc.get_raw_backtrace () in
g e bt
let n_bytes_written = Atomic.make 0
let n_bytes_read = Atomic.make 0

1
src/common_.ml
View file

@ -1,3 +1,4 @@
module Trace = Trace_core
let ( let@ ) = ( @@ )
let spf = Printf.sprintf

5
src/eio/linol_eio.ml
View file

@ -14,7 +14,10 @@ module IO_eio :
let return x = x
let failwith = failwith
let fail = raise
let catch f handler = try f () with exn -> handler exn
let catch f handler = try f () with exn ->
let bt = Printexc.get_raw_backtrace () in
handler exn bt
let stdin env = Eio.Buf_read.of_flow ~max_size:1_000_000 (Eio.Stdenv.stdin env)
let stdout = Eio.Stdenv.stdout

64
src/jsonrpc2.ml
View file

@ -42,8 +42,6 @@ module Make (IO : IO) : S with module IO = IO = struct
type json = J.t
let spf = Printf.sprintf
module ErrorCode = Jsonrpc.Response.Error.Code
(*
module Err = struct
@ -138,7 +136,7 @@ module Make (IO : IO) : S with module IO = IO = struct
(fun () ->
let+ x = f () in
Ok x)
(fun e -> IO.return (Error e))
(fun e bt -> IO.return (Error (e, bt)))
(** Sends a server notification to the LSP client. *)
let send_server_notification (self : t) (n : Lsp.Server_notification.t) :
@ -166,10 +164,15 @@ module Make (IO : IO) : S with module IO = IO = struct
(** Wraps some action and, in case the [IO.t] request has failed, logs the
failure to the LSP client. *)
let with_error_handler (self : t) (action : unit -> unit IO.t) : unit IO.t =
IO.catch action (fun e ->
IO.catch action (fun exn bt ->
let message =
spf "LSP handler failed with %s\n%s" (Printexc.to_string exn)
(Printexc.raw_backtrace_to_string bt)
in
Log.err (fun k -> k "%s" message);
let msg =
Lsp.Types.LogMessageParams.create ~type_:Lsp.Types.MessageType.Error
~message:(Printexc.to_string e)
~message
in
let msg =
Lsp.Server_notification.LogMessage msg
@ -191,11 +194,12 @@ module Make (IO : IO) : S with module IO = IO = struct
let handle_request (self : t) (r : Jsonrpc.Request.t) : unit IO.t =
let protect ~id f =
IO.catch f (fun e ->
IO.catch f (fun e bt ->
let message =
spf "%s\n%s" (Printexc.to_string e) (Printexc.get_backtrace ())
spf "%s\n%s" (Printexc.to_string e)
(Printexc.raw_backtrace_to_string bt)
in
Log.err (fun k -> k "error: %s" message);
Log.err (fun k -> k "error in request handler: %s" message);
let r =
Jsonrpc.Response.error id
(Jsonrpc.Response.Error.make
@ -215,13 +219,23 @@ module Make (IO : IO) : S with module IO = IO = struct
~notify_back:(send_server_notification self)
~server_request:(server_request self)
in
let reply_json = Lsp.Client_request.yojson_of_result r reply in
let response = Jsonrpc.Response.ok id reply_json in
let response =
match reply with
| Ok reply ->
let reply_json = Lsp.Client_request.yojson_of_result r reply in
Jsonrpc.Response.ok id reply_json
| Error message ->
Jsonrpc.Response.error id
(Jsonrpc.Response.Error.make
~code:Jsonrpc.Response.Error.Code.InternalError ~message ())
in
send_response self response
| Error e -> IO.failwith (spf "cannot decode request: %s" e))
(fun e ->
(fun e bt ->
let message =
spf "%s\n%s" (Printexc.to_string e) (Printexc.get_backtrace ())
spf "%s\n%s" (Printexc.to_string e)
(Printexc.raw_backtrace_to_string bt)
in
Log.err (fun k -> k "error: %s" message);
let r =
@ -273,7 +287,8 @@ module Make (IO : IO) : S with module IO = IO = struct
| _ -> j
(* read a full message *)
let read_msg (self : t) : (Jsonrpc.Packet.t, exn) result IO.t =
let read_msg (self : t) :
(Jsonrpc.Packet.t, exn * Printexc.raw_backtrace) result IO.t =
let rec read_headers acc =
let*? line = try_ @@ fun () -> IO.read_line self.ic in
match String.trim line with
@ -292,8 +307,9 @@ module Make (IO : IO) : S with module IO = IO = struct
with
| pair -> read_headers (pair :: acc)
| exception _ ->
IO.return
(Error (E (ErrorCode.ParseError, spf "invalid header: %S" line))))
let bt = Printexc.get_raw_backtrace () in
let exn = E (ErrorCode.ParseError, spf "invalid header: %S" line) in
IO.return (Error (exn, bt)))
in
let*? headers = read_headers [] in
Log.debug (fun k ->
@ -323,15 +339,21 @@ module Make (IO : IO) : S with module IO = IO = struct
(match Jsonrpc.Packet.t_of_yojson @@ fix_null_in_params j with
| m -> IO.return @@ Ok m
| exception exn ->
let bt = Printexc.get_raw_backtrace () in
Log.err (fun k ->
k "cannot decode json message: %s" (Printexc.to_string exn));
IO.return (Error (E (ErrorCode.ParseError, "cannot decode json"))))
k "cannot decode json message: %s\n%s" (Printexc.to_string exn)
(Printexc.raw_backtrace_to_string bt));
let exn = E (ErrorCode.ParseError, "cannot decode json") in
IO.return (Error (exn, bt)))
| exception _ ->
let bt = Printexc.get_raw_backtrace () in
IO.return
@@ Error (E (ErrorCode.ParseError, "missing content-length' header"))
) else
@@ Error (E (ErrorCode.ParseError, "missing content-length' header"), bt)
) else (
let bt = Printexc.get_callstack 10 in
IO.return
@@ Error (E (ErrorCode.InvalidRequest, "content-type must be 'utf-8'"))
@@ Error (E (ErrorCode.InvalidRequest, "content-type must be 'utf-8'"), bt)
)
let send_server_request (self : t) (req : 'from_server Lsp.Server_request.t)
(cb : ('from_server, Jsonrpc.Response.Error.t) result -> unit IO.t) :
@ -369,7 +391,7 @@ module Make (IO : IO) : S with module IO = IO = struct
| Ok r ->
let* () = process_msg r in
loop ()
| Error e -> IO.fail e
| Error (e, bt) -> IO.fail e bt
in
loop ()
end

8
src/lwt/linol_lwt.ml
View file

@ -29,8 +29,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 catch f g =
let bt = Printexc.get_callstack 10 in
Lwt.catch f (fun exn -> g exn bt)
let fail e _bt = Lwt.fail e
end
(** Spawn function.

115
src/server.ml
View file

@ -60,7 +60,7 @@ module Make (IO : IO) = struct
server_request:send_request ->
id:Req_id.t ->
'a Lsp.Client_request.t ->
'a IO.t
('a, string) result IO.t
(** Method called to handle client requests.
@param notify_back an object used to reply to the client, send progress
messages, diagnostics, etc.
@ -76,7 +76,14 @@ module Make (IO : IO) = struct
end
let async (self : #base_server) f : unit IO.t =
self#spawn_query_handler f;
self#spawn_query_handler (fun () ->
IO.catch f (fun exn bt ->
let msg =
spf "LSP async notification handler failed with %s\n%s"
(Printexc.to_string exn)
(Printexc.raw_backtrace_to_string bt)
in
IO.return @@ Log.err (fun k -> k "%s" msg)));
IO.return ()
(** A wrapper to more easily reply to notifications *)
@ -150,6 +157,11 @@ module Make (IO : IO) = struct
}
(** Current state of a document. *)
let[@inline] lift_ok x =
let open IO in
let+ x = x in
Ok x
(** 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
@ -211,7 +223,7 @@ module Make (IO : IO) = struct
| `InlayHintOptions of InlayHintOptions.t
| `InlayHintRegistrationOptions of InlayHintRegistrationOptions.t
]
option =
option =
None
(** Configuration for the inlay hints API. *)
@ -337,10 +349,24 @@ module Make (IO : IO) = struct
server_request:_ ->
id:Req_id.t ->
r Lsp.Client_request.t ->
r IO.t =
(r, string) result IO.t =
fun ~notify_back ~server_request ~id (r : _ Lsp.Client_request.t) ->
Trace.with_span ~__FILE__ ~__LINE__ "linol.on-request"
@@ fun _sp : r IO.t ->
@@ fun _sp : (r, string) result IO.t ->
(* handler to catch all errors *)
let try_catch : (unit -> (r, _) result IO.t) -> (r, _) result IO.t =
fun f ->
IO.catch f (fun exn bt ->
let msg =
spf "LSP request handler failed with %s\n%s"
(Printexc.to_string exn)
(Printexc.raw_backtrace_to_string bt)
in
Log.err (fun k -> k "%s" msg);
IO.return @@ Error msg)
in
try_catch @@ fun () ->
Log.debug (fun k ->
k "handle request[id=%s] <opaque>" (Req_id.to_string id));
@ -353,7 +379,7 @@ module Make (IO : IO) = struct
~server_request ()
in
status <- `ReceivedShutdown;
self#on_req_shutdown ~notify_back ~id
lift_ok @@ self#on_req_shutdown ~notify_back ~id
| Lsp.Client_request.Initialize i ->
Log.debug (fun k -> k "req: initialize");
let notify_back =
@ -361,22 +387,23 @@ module Make (IO : IO) = struct
~partialResultToken:None ~workDoneToken:i.workDoneToken
~notify_back ~server_request ()
in
self#on_req_initialize ~notify_back i
lift_ok @@ self#on_req_initialize ~notify_back i
| Lsp.Client_request.TextDocumentHover
{ textDocument; position; workDoneToken } ->
let uri = textDocument.uri in
Log.debug (fun k -> k "req: hover '%s'" (DocumentUri.to_path uri));
(match Hashtbl.find_opt docs uri with
| None -> IO.return None
| None -> IO.return @@ Ok None
| Some doc_st ->
let notify_back =
new notify_back
~workDoneToken ~partialResultToken:None ~uri ~notify_back
~server_request ()
in
self#on_req_hover ~notify_back ~id ~uri ~pos:position
~workDoneToken doc_st)
lift_ok
@@ self#on_req_hover ~notify_back ~id ~uri ~pos:position
~workDoneToken doc_st)
| Lsp.Client_request.TextDocumentCompletion
{
textDocument;
@ -389,15 +416,16 @@ module Make (IO : IO) = struct
Log.debug (fun k ->
k "req: complete '%s'" (DocumentUri.to_path uri));
(match Hashtbl.find_opt docs uri with
| None -> IO.return None
| None -> IO.return @@ Ok None
| Some doc_st ->
let notify_back =
new notify_back
~partialResultToken ~workDoneToken ~uri ~notify_back
~server_request ()
in
self#on_req_completion ~notify_back ~id ~uri ~workDoneToken
~partialResultToken ~pos:position ~ctx:context doc_st)
lift_ok
@@ self#on_req_completion ~notify_back ~id ~uri ~workDoneToken
~partialResultToken ~pos:position ~ctx:context doc_st)
| Lsp.Client_request.TextDocumentDefinition
{ textDocument; position; workDoneToken; partialResultToken } ->
let uri = textDocument.uri in
@ -410,10 +438,11 @@ module Make (IO : IO) = struct
in
(match Hashtbl.find_opt docs uri with
| None -> IO.return None
| None -> IO.return @@ Ok None
| Some doc_st ->
self#on_req_definition ~notify_back ~id ~workDoneToken
~partialResultToken ~uri ~pos:position doc_st)
lift_ok
@@ self#on_req_definition ~notify_back ~id ~workDoneToken
~partialResultToken ~uri ~pos:position doc_st)
| Lsp.Client_request.TextDocumentCodeLens
{ textDocument; workDoneToken; partialResultToken } ->
let uri = textDocument.uri in
@ -426,10 +455,11 @@ module Make (IO : IO) = struct
in
(match Hashtbl.find_opt docs uri with
| None -> IO.return []
| None -> IO.return @@ Ok []
| Some doc_st ->
self#on_req_code_lens ~notify_back ~id ~uri ~workDoneToken
~partialResultToken doc_st)
lift_ok
@@ self#on_req_code_lens ~notify_back ~id ~uri ~workDoneToken
~partialResultToken doc_st)
| Lsp.Client_request.TextDocumentCodeLensResolve cl ->
Log.debug (fun k -> k "req: codelens resolve");
let notify_back =
@ -437,7 +467,7 @@ module Make (IO : IO) = struct
~workDoneToken:None ~partialResultToken:None ~notify_back
~server_request ()
in
self#on_req_code_lens_resolve ~notify_back ~id cl
lift_ok @@ self#on_req_code_lens_resolve ~notify_back ~id cl
| Lsp.Client_request.ExecuteCommand
{ command; arguments; workDoneToken } ->
Log.debug (fun k -> k "req: execute command '%s'" command);
@ -446,8 +476,9 @@ module Make (IO : IO) = struct
~workDoneToken ~partialResultToken:None ~notify_back
~server_request ()
in
self#on_req_execute_command ~notify_back ~id ~workDoneToken command
arguments
lift_ok
@@ self#on_req_execute_command ~notify_back ~id ~workDoneToken
command arguments
| Lsp.Client_request.DocumentSymbol
{ textDocument = d; workDoneToken; partialResultToken } ->
let notify_back =
@ -455,8 +486,9 @@ module Make (IO : IO) = struct
~workDoneToken ~partialResultToken ~notify_back ~server_request
()
in
self#on_req_symbol ~notify_back ~id ~uri:d.uri ~workDoneToken
~partialResultToken ()
lift_ok
@@ self#on_req_symbol ~notify_back ~id ~uri:d.uri ~workDoneToken
~partialResultToken ()
| Lsp.Client_request.CodeAction a ->
let notify_back =
new notify_back
@ -464,15 +496,16 @@ module Make (IO : IO) = struct
~partialResultToken:a.partialResultToken ~notify_back
~server_request ()
in
self#on_req_code_action ~notify_back ~id a
lift_ok @@ self#on_req_code_action ~notify_back ~id a
| Lsp.Client_request.InlayHint p ->
let notify_back : notify_back =
new notify_back
~workDoneToken:p.workDoneToken ~partialResultToken:None
~notify_back ~server_request ()
in
self#on_req_inlay_hint ~notify_back ~id ~uri:p.textDocument.uri
~range:p.range ()
lift_ok
@@ self#on_req_inlay_hint ~notify_back ~id ~uri:p.textDocument.uri
~range:p.range ()
| Lsp.Client_request.CodeActionResolve _
| Lsp.Client_request.LinkedEditingRange _
| Lsp.Client_request.TextDocumentDeclaration _
@ -512,15 +545,16 @@ module Make (IO : IO) = struct
~workDoneToken:None ~partialResultToken:None ~notify_back
~server_request ()
in
self#on_request_unhandled ~notify_back ~id r
lift_ok @@ self#on_request_unhandled ~notify_back ~id r
| Lsp.Client_request.UnknownRequest r ->
let notify_back =
new notify_back
~workDoneToken:None ~partialResultToken:None ~notify_back
~server_request ()
in
self#on_unknown_request ~notify_back ~server_request ~id r.meth
r.params
lift_ok
@@ self#on_unknown_request ~notify_back ~server_request ~id r.meth
r.params
method virtual on_notif_doc_did_open
: notify_back:notify_back ->
@ -542,7 +576,7 @@ module Make (IO : IO) = struct
(** Called when the document changes. *)
method on_notif_doc_did_save ~notify_back:(_ : notify_back)
(_params : DidSaveTextDocumentParams.t ) : unit IO.t =
(_params : DidSaveTextDocumentParams.t) : unit IO.t =
IO.return ()
method on_unknown_notification ~notify_back:(_ : notify_back)
@ -559,6 +593,21 @@ module Make (IO : IO) = struct
let@ _sp =
Trace.with_span ~__FILE__ ~__LINE__ "linol.on-notification"
in
(* handler to catch all errors *)
let try_catch : (unit -> unit IO.t) -> unit IO.t =
fun f ->
IO.catch f (fun exn bt ->
let msg =
spf "LSP notification handler failed with %s\n%s"
(Printexc.to_string exn)
(Printexc.raw_backtrace_to_string bt)
in
Log.err (fun k -> k "%s" msg);
IO.return ())
in
try_catch @@ fun () ->
let open Lsp.Types in
match n with
| Lsp.Client_notification.TextDocumentDidOpen
@ -654,8 +703,8 @@ module Make (IO : IO) = struct
| Lsp.Client_notification.DidSaveTextDocument params ->
let notify_back =
new notify_back
~workDoneToken:None ~partialResultToken:None ~uri:params.textDocument.uri
~notify_back ~server_request ()
~workDoneToken:None ~partialResultToken:None
~uri:params.textDocument.uri ~notify_back ~server_request ()
in
async self (fun () ->

4
src/sigs.ml
View file

@ -18,6 +18,6 @@ module type IO = sig
val read_line : in_channel -> string t
val write : out_channel -> bytes -> int -> int -> unit t
val write_string : out_channel -> string -> unit t
val fail : exn -> unit t
val catch : (unit -> 'a t) -> (exn -> 'a t) -> 'a t
val fail : exn -> Printexc.raw_backtrace -> unit t
val catch : (unit -> 'a t) -> (exn -> Printexc.raw_backtrace -> 'a t) -> 'a t
end