From 498c62d46fa9aa8592f817f57712ade0eb19ea89 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Fri, 6 Oct 2023 09:55:31 -0400
Subject: [PATCH] add functions in jsonrpc2 to send queries/notifs directly
 from server

---
 src/jsonrpc2.ml  | 27 ++++++++++++++++++---------
 src/jsonrpc2.mli | 13 +++++++++++++
 src/server.ml    |  3 ++-
 3 files changed, 33 insertions(+), 10 deletions(-)

diff --git a/src/jsonrpc2.ml b/src/jsonrpc2.ml
index 79b973bb..398fdd89 100644
--- a/src/jsonrpc2.ml
+++ b/src/jsonrpc2.ml
@@ -9,18 +9,20 @@ module type S = sig
   module IO : IO
 
   type t
-  (** A jsonrpc2 connection. *)
 
   include module type of Server.Make (IO)
 
   val create : 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 send_server_notification : t -> Lsp.Server_notification.t -> unit IO.t
+
+  val send_server_request :
+    t ->
+    'from_server Lsp.Server_request.t ->
+    (('from_server, Jsonrpc.Response.Error.t) result -> unit IO.t) ->
+    Req_id.t IO.t
 
   val run : ?shutdown:(unit -> bool) -> t -> unit IO.t
-  (** Listen for incoming messages and responses *)
 end
 
 module Make (IO : IO) : S with module IO = IO = struct
@@ -116,8 +118,8 @@ module Make (IO : IO) : S with module IO = IO = struct
       (fun e -> IO.return (Error e))
 
   (** Sends a server notification to the LSP client. *)
-  let server_notification (self : t) (n : Lsp.Server_notification.t) : unit IO.t
-      =
+  let send_server_notification (self : t) (n : Lsp.Server_notification.t) :
+      unit IO.t =
     let msg = Lsp.Server_notification.to_jsonrpc n in
     send_server_notif self msg
 
@@ -156,7 +158,8 @@ module Make (IO : IO) : S with module IO = IO = struct
     match Lsp.Client_notification.of_jsonrpc n with
     | Ok n ->
       with_error_handler self (fun () ->
-          self.s#on_notification n ~notify_back:(server_notification self)
+          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)
 
@@ -182,7 +185,8 @@ module Make (IO : IO) : S with module IO = IO = struct
         | Ok (Lsp.Client_request.E r) ->
           protect ~id (fun () ->
               let* reply =
-                self.s#on_request r ~id ~notify_back:(server_notification self)
+                self.s#on_request r ~id
+                  ~notify_back:(send_server_notification self)
                   ~server_request:(server_request self)
               in
               let reply_json = Lsp.Client_request.yojson_of_result r reply in
@@ -302,6 +306,11 @@ module Make (IO : IO) : S with module IO = IO = struct
       IO.return
       @@ Error (E (ErrorCode.InvalidRequest, "content-type must be 'utf-8'"))
 
+  let send_server_request (self : t) (req : 'from_server Lsp.Server_request.t)
+      (cb : ('from_server, Jsonrpc.Response.Error.t) result -> unit IO.t) :
+      Req_id.t IO.t =
+    server_request self (Request_and_handler (req, cb))
+
   (** [shutdown ()] is called after processing each request to check if the server
     could wait for new messages.
     When launching an LSP server using [Server.Make.server], the
diff --git a/src/jsonrpc2.mli b/src/jsonrpc2.mli
index 8f0bc524..2472b868 100644
--- a/src/jsonrpc2.mli
+++ b/src/jsonrpc2.mli
@@ -20,6 +20,19 @@ module type S = sig
   val create_stdio : server -> t
   (** Create a connection using stdin/stdout *)
 
+  val send_server_notification : t -> Lsp.Server_notification.t -> unit IO.t
+  (** Send a notification from the server.
+      @since NEXT_RELEASE *)
+
+  val send_server_request :
+    t ->
+    'from_server Lsp.Server_request.t ->
+    (('from_server, Jsonrpc.Response.Error.t) result -> unit IO.t) ->
+    Req_id.t IO.t
+  (** Send a request from the server, and pass a callback that will be
+      called with the result in the future.
+      @since NEXT_RELEASE *)
+
   val run : ?shutdown:(unit -> bool) -> t -> unit IO.t
   (** Listen for incoming messages and responses.
     @param shutdown if true, tells the server to shut down *)
diff --git a/src/server.ml b/src/server.ml
index cb20f4b0..372005ab 100644
--- a/src/server.ml
+++ b/src/server.ml
@@ -131,7 +131,8 @@ module Make (IO : IO) = struct
                { value = Lsp.Server_notification.Progress.End p; token }
         | None -> IO.return ()
 
-      method send_notification (n : Lsp.Server_notification.t) = notify_back n
+      method send_notification (n : Lsp.Server_notification.t) : unit IO.t =
+        notify_back n
       (** Send a notification from the server to the client (general purpose method) *)
 
       method send_request