refactor: separate notification type

Signed-off-by: Rudi Grinberg <[email protected]>

jsonrpc-fiber/src/jsonrpc_fiber.ml

@@ -252,7 +252,7 @@ struct
       | Error errors ->
         Format.eprintf
           "Uncaught error when handling notification:@.%[email protected]:@.%s@." Json.pp
-          (Notification.yojson_of_t r)
+          (Notification.yojson_of_t (Notification.of_message r))
           (Dyn.to_string (Dyn.list Exn_with_backtrace.to_dyn errors));
         loop ()
     in
@@ -271,11 +271,10 @@ struct
     (* TODO we should also error out when making requests after a disconnect. *)
     if not t.running then Code_error.raise "jsonrpc must be running" []
 
-  let notification t (req : Notification.t) =
+  let notification t (n : Notification.t) =
     Fiber.of_thunk (fun () ->
         check_running t;
-        let req = { req with Message.id = None } in
-        Chan.send t.chan [ Message req ])
+        Chan.send t.chan [ Message (Jsonrpc.Notification.to_message_either n) ])
 
   let register_request_ivar t id ivar =
     match Id.Table.find_opt t.pending id with
@@ -327,7 +326,8 @@ struct
           List.fold_left pending ~init:([], []) ~f:(fun (pending, ivars) ->
             function
             | `Notification n ->
-              (Jsonrpc.Message { n with Message.id = None } :: pending, ivars)
+              ( Jsonrpc.Message (Notification.to_message_either n) :: pending
+              , ivars )
             | `Request ((r : Request.t), ivar) ->
               ( Jsonrpc.Message { r with Message.id = Some r.id } :: pending
               , (r.id, ivar) :: ivars ))

jsonrpc-fiber/test/jsonrpc_fiber_tests.ml

@@ -215,7 +215,7 @@ let%expect_test "test from jsonrpc_test.ml" =
   let on_notification ctx =
     let n = Context.message ctx in
     if n.method_ = "raise" then failwith "special failure";
-    let json = Notification.yojson_of_t n in
+    let json = Notification.yojson_of_t (Notification.of_message n) in
     print_endline ">> received notification";
     print_json json;
     Fiber.return (Jsonrpc_fiber.Notify.Continue, ())

jsonrpc/src/jsonrpc.ml

@@ -103,13 +103,20 @@ module Message = struct
 end
 
 module Notification = struct
-  type t = unit Message.t
+  type t =
+    { method_ : string
+    ; params : Structured.t option
+    }
+
+  let create ?params ~method_ () = { params; method_ }
 
-  let create ?params ~method_ () = { Message.params; id = (); method_ }
+  let of_message { Message.params; method_; id = () } = { params; method_ }
 
-  let yojson_of_t = Message.yojson_of_t (fun () -> None)
+  let to_message_either { method_; params } =
+    { Message.id = None; method_; params }
 
-  let to_message_either t = { t with Message.id = None }
+  let yojson_of_t (t : t) =
+    Message.yojson_of_t (fun () -> None) { (to_message_either t) with id = () }
 end
 
 module Request = struct

jsonrpc/src/jsonrpc.mli

@@ -68,12 +68,17 @@ module Message : sig
 end
 
 module Notification : sig
-  type t = unit Message.t
+  type t =
+    { method_ : string
+    ; params : Structured.t option
+    }
 
   val create : ?params:Structured.t -> method_:string -> unit -> t
 
   val yojson_of_t : t -> Json.t
 
+  val of_message : unit Message.t -> t
+
   val to_message_either : t -> Message.either
 end
 

lsp-fiber/src/rpc.ml

@@ -238,7 +238,7 @@ struct
     in
     let on_notification ctx =
       let r = Session.Context.message ctx in
-      match In_notification.of_jsonrpc r with
+      match In_notification.of_jsonrpc (Jsonrpc.Notification.of_message r) with
       | Ok r -> h_on_notification t r
       | Error error ->
         Log.log ~section:"lsp" (fun () ->

lsp/src/client_notification.ml

@@ -111,4 +111,4 @@ let of_jsonrpc (r : Jsonrpc.Notification.t) =
 let to_jsonrpc t =
   let method_ = method_ t in
   let params = yojson_of_t t |> Option.map Jsonrpc.Structured.t_of_yojson in
-  { Jsonrpc.Message.id = (); params; method_ }
+  { Jsonrpc.Notification.params; method_ }

lsp/src/client_request.ml

@@ -171,7 +171,7 @@ type packed = E : 'r t -> packed
 
 let of_jsonrpc (r : Jsonrpc.Request.t) =
   let open Result.O in
-  let parse f = Json.message_params r f in
+  let parse f = Json.message_params r.params f in
   match r.method_ with
   | "initialize" ->
     let+ params = parse InitializeParams.t_of_yojson in

lsp/src/server_notification.ml

@@ -57,7 +57,7 @@ let to_jsonrpc t =
     | None -> None
     | Some s -> Some (Jsonrpc.Structured.t_of_yojson s)
   in
-  { Jsonrpc.Message.id = (); params; method_ }
+  { Jsonrpc.Notification.params; method_ }
 
 let of_jsonrpc (r : Jsonrpc.Notification.t) =
   let open Result.O in

lsp/src/server_request.ml

@@ -60,7 +60,7 @@ let to_jsonrpc_request t ~id =
 
 let of_jsonrpc (r : Jsonrpc.Request.t) : (packed, string) Result.t =
   let open Result.O in
-  let parse f = Json.message_params r f in
+  let parse f = Json.message_params r.params f in
   match r.method_ with
   | "workspace/configuration" ->
     let+ params = parse ConfigurationParams.t_of_yojson in