I've gone too far, but it's too late to go back.

example/template-eio/main.ml

@@ -51,7 +51,7 @@ class lsp_server =
        - return the diagnostics from the new state
     *)
     method private _on_doc ~(notify_back : Linol_eio.Jsonrpc2.notify_back)
-        (uri : Lsp.Types.DocumentUri.t) (contents : string) =
+        (uri : Lsp.Types.DocumentUri.t) (contents : string) : (unit, string) result =
       let new_state = process_some_input_file contents in
       Hashtbl.replace buffers uri new_state;
       let diags = diagnostics new_state in
@@ -59,7 +59,7 @@ class lsp_server =
 
     (* We now override the [on_notify_doc_did_open] method that will be called
        by the server each time a new document is opened. *)
-    method on_notif_doc_did_open ~notify_back d ~content : unit Linol_eio.t =
+    method on_notif_doc_did_open ~notify_back d ~content : (unit, string) result Linol_eio.t =
       self#_on_doc ~notify_back d.uri content
 
     (* Similarly, we also override the [on_notify_doc_did_change] method that will be called
@@ -70,9 +70,9 @@ class lsp_server =
 
     (* On document closes, we remove the state associated to the file from the global
        hashtable state, to avoid leaking memory. *)
-    method on_notif_doc_did_close ~notify_back:_ d : unit Linol_eio.t =
+    method on_notif_doc_did_close ~notify_back:_ d : (unit, string) result Linol_eio.t =
       Hashtbl.remove buffers d.uri;
-      ()
+      Ok ()
   end
 
 (* Main code

example/template-lwt/main.ml

@@ -59,7 +59,7 @@ class lsp_server =
 
     (* We now override the [on_notify_doc_did_open] method that will be called
        by the server each time a new document is opened. *)
-    method on_notif_doc_did_open ~notify_back d ~content : unit Linol_lwt.t =
+    method on_notif_doc_did_open ~notify_back d ~content : (unit, string) result Linol_lwt.t =
       self#_on_doc ~notify_back d.uri content
 
     (* Similarly, we also override the [on_notify_doc_did_change] method that will be called
@@ -70,9 +70,9 @@ class lsp_server =
 
     (* On document closes, we remove the state associated to the file from the global
        hashtable state, to avoid leaking memory. *)
-    method on_notif_doc_did_close ~notify_back:_ d : unit Linol_lwt.t =
+    method on_notif_doc_did_close ~notify_back:_ d : (unit, string) result Linol_lwt.t =
       Hashtbl.remove buffers d.uri;
-      Linol_lwt.return ()
+      Linol_lwt.return (Ok ())
   end
 
 (* Main code

src/eio/linol_eio.ml

@@ -38,12 +38,13 @@ module IO_eio :
 end
 
 (** Spawn function. *)
-let spawn f =
+let spawn (f:unit -> (unit, string) result) : unit  =
   let promise, resolver = Eio.Promise.create () in
   begin
     try
-      f ();
+      match f () with
-      Eio.Promise.resolve_ok resolver ()
+      | Ok _ -> Eio.Promise.resolve_ok resolver ()
+      | Error _ -> ()
     with
       exn ->
       (Printf.eprintf "uncaught exception in `spawn`:\n%s\n%!"
@@ -51,7 +52,7 @@ let spawn f =
       Eio.Promise.resolve_error resolver exn
     end;
 
-  Eio.Promise.await_exn promise
+  (Eio.Promise.await_exn promise)
 
 include Lsp.Types
 include IO_eio

src/jsonrpc2.ml

@@ -24,7 +24,7 @@ module type S = sig
   val create_stdio :
     ?on_received:(json -> unit) -> ?on_sent:(json -> unit) -> env:IO.env -> server -> t
 
-  val send_server_notification : t -> Lsp.Server_notification.t -> unit IO.t
+  val send_server_notification : t -> Lsp.Server_notification.t -> (unit, string) result IO.t
 
   val send_server_request :
     t ->
@@ -56,6 +56,11 @@ module Make (IO : IO) : S with module IO = IO = struct
 
   exception E of ErrorCode.t * string
 
+  let[@inline] lift_ok x =
+    let open IO in
+    let+ x = x in
+    Ok x
+
   (* bind on IO+result *)
   let ( let*? ) x f =
     let* x = x in
@@ -110,9 +115,9 @@ module Make (IO : IO) : S with module IO = IO = struct
       [register_server_request_response_handler] before calling this method to
       ensure that [handle_response] will have a registered handler for this
       response. *)
-  let send_server_req (self : t) (m : Jsonrpc.Request.t) : unit IO.t =
+  let send_server_req (self : t) (m : Jsonrpc.Request.t) : (unit, string) result IO.t =
     let json = Jsonrpc.Request.yojson_of_t m in
-    send_json_ self json
+    lift_ok @@ send_json_ self json
 
   (** Returns a new, unused [Req_id.t] to send a server request. *)
   let fresh_lsp_id (self : t) : Req_id.t =
@@ -140,9 +145,9 @@ module Make (IO : IO) : S with module IO = IO = struct
 
   (** Sends a server notification to the LSP client. *)
   let send_server_notification (self : t) (n : Lsp.Server_notification.t) :
-      unit IO.t =
+      (unit, string) result IO.t =
     let msg = Lsp.Server_notification.to_jsonrpc n in
-    send_server_notif self msg
+    lift_ok @@ (send_server_notif self msg)
 
   (** Given a [server_request_handler_pair] consisting of some server request
       and its handler, sends this request to the LSP client and adds the handler
@@ -156,7 +161,7 @@ module Make (IO : IO) : S with module IO = IO = struct
     let msg = Lsp.Server_request.to_jsonrpc_request r ~id in
     let has_inserted = register_server_request_response_handler self id req in
     if has_inserted then
-      let* () = send_server_req self msg in
+      let* _res = send_server_req self msg in
       return id
     else
       IO.failwith "failed to register server request: id was already used"
@@ -180,19 +185,19 @@ module Make (IO : IO) : S with module IO = IO = struct
         in
         send_server_notif self msg)
 
-  let handle_notification (self : t) (n : Jsonrpc.Notification.t) : unit IO.t =
+  let handle_notification (self : t) (n : Jsonrpc.Notification.t) : (unit, string) result IO.t =
     let@ _sp =
       Trace.with_span ~__FILE__ ~__LINE__ "linol.handle-notification"
     in
     match Lsp.Client_notification.of_jsonrpc n with
     | Ok n ->
-      let@ () = with_error_handler self in
+      (* let@ () = with_error_handler self in *)
       self.s#on_notification n
         ~notify_back:(send_server_notification self)
         ~server_request:(server_request self)
     | Error e -> IO.failwith (spf "cannot decode notification: %s" e)
 
-  let handle_request (self : t) (r : Jsonrpc.Request.t) : unit IO.t =
+  let handle_request (self : t) (r : Jsonrpc.Request.t) : (unit, string) result IO.t =
     let protect ~id f =
       IO.catch f (fun e bt ->
           let message =
@@ -209,7 +214,7 @@ module Make (IO : IO) : S with module IO = IO = struct
     in
     (* request, so we need to reply *)
     let id = r.id in
-    IO.catch
+     lift_ok @@ IO.catch
       (fun () ->
         match Lsp.Client_request.of_jsonrpc r with
         | Ok (Lsp.Client_request.E r) ->
@@ -245,7 +250,7 @@ module Make (IO : IO) : S with module IO = IO = struct
         in
         send_response self r)
 
-  let handle_response (self : t) (r : Jsonrpc.Response.t) : unit IO.t =
+  let handle_response (self : t) (r : Jsonrpc.Response.t) : (unit, string) result IO.t =
     match Hashtbl.find_opt self.pending_responses r.id with
     | None ->
       IO.failwith
@@ -253,23 +258,23 @@ module Make (IO : IO) : S with module IO = IO = struct
       @@ Req_id.to_string r.id
     | Some (Request_and_handler (req, handler)) ->
       let () = Hashtbl.remove self.pending_responses r.id in
-      (match r.result with
+      lift_ok @@ (match r.result with
       | Error err -> with_error_handler self (fun () -> handler @@ Error err)
       | Ok json ->
         let r = Lsp.Server_request.response_of_json req json in
         with_error_handler self (fun () -> handler @@ Ok r))
 
   let handle_batch_response (_self : t) (_rs : Jsonrpc.Response.t list) :
-      unit IO.t =
+      (unit, string) result IO.t =
-    IO.failwith "Unhandled: jsonrpc batch response"
+      lift_ok @@ IO.failwith "Unhandled: jsonrpc batch response"
 
   let handle_batch_call (_self : t)
       (_cs :
         [ `Notification of Jsonrpc.Notification.t
         | `Request of Jsonrpc.Request.t
         ]
-        list) : unit IO.t =
+        list) : (unit, string) result IO.t =
-    IO.failwith "Unhandled: jsonrpc batch call"
+    lift_ok @@  IO.failwith "Unhandled: jsonrpc batch call"
 
   (* As in [https://github.com/c-cube/linol/issues/20],
      Jsonrpc expect "params" to be object or array,
@@ -367,7 +372,7 @@ module Make (IO : IO) : S with module IO = IO = struct
   let run ?(shutdown = fun _ -> false) (self : t) : unit IO.t =
     let async f =
       self.s#spawn_query_handler f;
-      IO.return ()
+      IO.return (Ok ())
     in
 
     let process_msg r =
@@ -389,7 +394,7 @@ module Make (IO : IO) : S with module IO = IO = struct
         let* r = read_msg self in
         match r with
         | Ok r ->
-          let* () = process_msg r in
+          let* _res = process_msg r in
           loop ()
         | Error (e, bt) -> IO.fail e bt
     in

src/jsonrpc2.mli

@@ -27,7 +27,7 @@ module type S = sig
     ?on_received:(json -> unit) -> ?on_sent:(json -> unit) -> env:IO.env -> server -> t
   (** Create a connection using stdin/stdout *)
 
-  val send_server_notification : t -> Lsp.Server_notification.t -> unit IO.t
+  val send_server_notification : t -> Lsp.Server_notification.t -> (unit, string) result IO.t
   (** Send a notification from the server.
       @since 0.5 *)
 

src/lwt/linol_lwt.ml

@@ -39,12 +39,16 @@ end
 
 (** Spawn function.
     @since 0.5 *)
-let spawn f =
+let spawn (f: unit -> (unit, string) result Lwt.t) : unit =
-  Lwt.async (fun () ->
+  let g = (fun () ->
-      Lwt.catch f (fun exn ->
+    let _ = Lwt.catch f (fun exn ->
       Printf.eprintf "uncaught exception in `spawn`:\n%s\n%!"
         (Printexc.to_string exn);
-          Lwt.return ()))
+      Lwt.return (Error (Printexc.to_string exn)))
+    in
+    Lwt.return ())
+  in
+  Lwt.async g
 
 include Lsp.Types
 include IO_lwt

src/server.ml

@@ -32,6 +32,11 @@ module Make (IO : IO) = struct
   module DiagnosticSeverity = DiagnosticSeverity
   module Req_id = Req_id
 
+  let[@inline] lift_ok x =
+    let open IO in
+    let+ x = x in
+    Ok x
+
   (** A variant carrying a [Lsp.Server_request.t] and a handler for its return
       value. The request is stored in order to allow us to discriminate its
       existential variable. *)
@@ -49,14 +54,14 @@ module Make (IO : IO) = struct
   class virtual base_server =
     object
       method virtual on_notification
-          : notify_back:(Lsp.Server_notification.t -> unit IO.t) ->
+          : notify_back:(Lsp.Server_notification.t -> (unit, string) result IO.t) ->
             server_request:send_request ->
             Lsp.Client_notification.t ->
-            unit IO.t
+            (unit, string) result IO.t
 
       method virtual on_request
           : 'a.
-            notify_back:(Lsp.Server_notification.t -> unit IO.t) ->
+            notify_back:(Lsp.Server_notification.t -> (unit, string) result IO.t) ->
             server_request:send_request ->
             id:Req_id.t ->
             'a Lsp.Client_request.t ->
@@ -69,30 +74,30 @@ module Make (IO : IO) = struct
       method must_quit = false
       (** Set to true if the client requested to exit *)
 
-      method virtual spawn_query_handler : (unit -> unit IO.t) -> unit
+      method virtual spawn_query_handler : (unit -> (unit, string) result IO.t) -> unit
       (** How to start a new future/task/thread concurrently. This is used
           to process incoming user queries.
           @since 0.5 *)
     end
 
-  let async (self : #base_server) f : unit IO.t =
+  let async (self : #base_server) f : (unit, string) result IO.t =
     self#spawn_query_handler f;
-    IO.return ()
+    IO.return (Ok ())
 
   (** A wrapper to more easily reply to notifications *)
-  class notify_back ~notify_back ~server_request ~workDoneToken
+  class notify_back ~(notify_back: Lsp.Server_notification.t -> (unit, string) result IO.t) ~server_request ~workDoneToken
     ~partialResultToken:_ ?version ?(uri : DocumentUri.t option) () =
     object
       val mutable uri = uri
       method set_uri u = uri <- Some u
       method get_uri = uri
 
-      method send_log_msg ~type_ msg : unit IO.t =
+      method send_log_msg ~type_ msg : (unit, string) result IO.t =
         let params = LogMessageParams.create ~type_ ~message:msg in
         notify_back (Lsp.Server_notification.LogMessage params)
       (** Send a log message to the editor *)
 
-      method send_diagnostic (l : Diagnostic.t list) : unit IO.t =
+      method send_diagnostic (l : Diagnostic.t list) : (unit, string) result IO.t =
         match uri with
         | None ->
           IO.failwith "notify_back: cannot publish diagnostics, no URI given"
@@ -103,33 +108,33 @@ module Make (IO : IO) = struct
           notify_back (Lsp.Server_notification.PublishDiagnostics params)
       (** Send diagnostics for the current document *)
 
-      method telemetry json : unit IO.t =
+      method telemetry json : (unit, string) result IO.t =
         notify_back @@ Lsp.Server_notification.TelemetryNotification json
 
-      method cancel_request (id : Jsonrpc.Id.t) : unit IO.t =
+      method cancel_request (id : Jsonrpc.Id.t) : (unit, string) result IO.t =
         notify_back @@ CancelRequest id
 
       method work_done_progress_begin (p : Lsp.Types.WorkDoneProgressBegin.t)
-          : unit IO.t =
+          : (unit, string) result IO.t =
         match workDoneToken with
         | Some token ->
           notify_back @@ WorkDoneProgress { token; value = Begin p }
-        | None -> IO.return ()
+        | None -> lift_ok @@ IO.return ()
 
       method work_done_progress_report (p : Lsp.Types.WorkDoneProgressReport.t)
-          : unit IO.t =
+          : (unit, string) result IO.t =
         match workDoneToken with
         | Some token ->
           notify_back @@ WorkDoneProgress { value = Report p; token }
-        | None -> IO.return ()
+        | None -> lift_ok @@ IO.return ()
 
       method work_done_progress_end (p : Lsp.Types.WorkDoneProgressEnd.t)
-          : unit IO.t =
+          : (unit, string) result IO.t =
         match workDoneToken with
         | Some token -> notify_back @@ WorkDoneProgress { value = End p; token }
-        | None -> IO.return ()
+        | None -> lift_ok @@ IO.return ()
 
-      method send_notification (n : Lsp.Server_notification.t) : unit IO.t =
+      method send_notification (n : Lsp.Server_notification.t) : (unit, string) result IO.t =
         notify_back n
       (** Send a notification from the server to the client (general purpose method) *)
 
@@ -150,11 +155,6 @@ 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
@@ -338,7 +338,7 @@ module Make (IO : IO) = struct
         @since 0.7 *)
 
       method on_request : type r.
-          notify_back:_ ->
+          notify_back:(Lsp.Server_notification.t -> (unit, string) result IO.t) ->
           server_request:_ ->
           id:Req_id.t ->
           r Lsp.Client_request.t ->
@@ -553,11 +553,11 @@ module Make (IO : IO) = struct
           : notify_back:notify_back ->
             TextDocumentItem.t ->
             content:string ->
-            unit IO.t
+            (unit, string) result IO.t
       (** Called when a document is opened *)
 
       method virtual on_notif_doc_did_close
-          : notify_back:notify_back -> TextDocumentIdentifier.t -> unit IO.t
+          : notify_back:notify_back -> TextDocumentIdentifier.t -> (unit, string) result IO.t
 
       method virtual on_notif_doc_did_change
           : notify_back:notify_back ->
@@ -565,30 +565,30 @@ module Make (IO : IO) = struct
             TextDocumentContentChangeEvent.t list ->
             old_content:string ->
             new_content:string ->
-            unit IO.t
+            (unit, string) result IO.t
       (** 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, string) result IO.t =
-        IO.return ()
+        lift_ok @@ IO.return ()
 
       method on_unknown_notification ~notify_back:(_ : notify_back)
-          (_n : Jsonrpc.Notification.t) : unit IO.t =
+          (_n : Jsonrpc.Notification.t) : (unit, string) result IO.t =
-        IO.return ()
+        lift_ok @@ IO.return ()
 
       method on_notification_unhandled ~notify_back:(_ : notify_back)
-          (_n : Lsp.Client_notification.t) : unit IO.t =
+          (_n : Lsp.Client_notification.t) : (unit, string) result IO.t =
-        IO.return ()
+        lift_ok @@ IO.return ()
       (** Override to handle unprocessed notifications *)
 
-      method on_notification ~notify_back ~server_request
+      method on_notification ~(notify_back:Lsp.Server_notification.t -> (unit, string) result IO.t) ~server_request
-          (n : Lsp.Client_notification.t) : unit IO.t =
+          (n : Lsp.Client_notification.t) : (unit, string) result IO.t =
         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 =
+        let try_catch : (unit -> (unit, string) result IO.t) -> (unit, string) result IO.t =
          fun f ->
           IO.catch f (fun exn bt ->
               let msg =
@@ -597,7 +597,7 @@ module Make (IO : IO) = struct
                   (Printexc.raw_backtrace_to_string bt)
               in
               Log.err (fun k -> k "%s" msg);
-              IO.return ())
+              lift_ok @@ IO.return ())
         in
 
         try_catch @@ fun () ->
@@ -688,11 +688,11 @@ module Make (IO : IO) = struct
           Hashtbl.replace docs doc.uri new_st;
 
           async self (fun () ->
-              self#on_notif_doc_did_change
+              (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)
+                ~new_content:new_st.content))
         | Lsp.Client_notification.DidSaveTextDocument params ->
           let notify_back =
             new notify_back
@@ -706,7 +706,7 @@ module Make (IO : IO) = struct
                 params)
         | Lsp.Client_notification.Exit ->
           status <- `ReceivedExit;
-          IO.return ()
+          lift_ok @@ IO.return ()
         | Lsp.Client_notification.WillSaveTextDocument _
         | Lsp.Client_notification.ChangeWorkspaceFolders _
         | Lsp.Client_notification.ChangeConfiguration _