[petanque] Log strange incoming messages.

This can help debugging as sometimes messages can be parsed in
unexpected ways..

petanque/json_shell/interp.ml

@@ -35,12 +35,16 @@ let handle_request ~token ~id ~method_ ~params =
     let message = "method not found" in
     Lsp.Base.Response.mk_error ~id ~code ~message
 
-let interp ~token (r : Lsp.Base.Message.t) : Lsp.Base.Response.t option =
+let interp ~token (r : Lsp.Base.Message.t) : Lsp.Base.Message.t option =
   match r with
   | Request { id; method_; params } ->
     let response = handle_request ~token ~id ~method_ ~params in
-    Some response
-  | Notification { method_ = _; params = _ } -> None
-  | Response _ ->
-    (* XXX: to implement *)
-    None
+    Some (Lsp.Base.Message.response response)
+  | Notification { method_; params = _ } ->
+    let message = "unhandled notification: " ^ method_ in
+    let log = Trace.(make Params.{ message; verbose = None }) in
+    Some log
+  | Response (Ok { id; _ }) | Response (Error { id; _ }) ->
+    let message = "unhandled response: " ^ string_of_int id in
+    let log = Trace.(make Params.{ message; verbose = None }) in
+    Some log

petanque/json_shell/pet.ml

@@ -31,7 +31,7 @@ let send_message msg =
 let interp ~token request =
   match Interp.interp ~token request with
   | None -> ()
-  | Some response -> Lsp.Base.Message.response response |> send_message
+  | Some message -> send_message message
 
 let rec loop ~token : unit =
   match read_message stdin with
@@ -45,24 +45,16 @@ let rec loop ~token : unit =
 
 let trace_notification hdr ?extra msg =
   let module M = Protocol.Trace in
-  let method_ = M.method_ in
   let message = Format.asprintf "[%s] %s" hdr msg in
   let params = { M.Params.message; verbose = extra } in
-  let params = M.Params.to_yojson params |> Yojson.Safe.Util.to_assoc in
-  let notification =
-    Lsp.Base.(Notification.(make ~method_ ~params () |> Message.notification))
-  in
+  let notification = M.make params in
   send_message notification
 
 let message_notification ~lvl ~message =
   let module M = Protocol.Message in
-  let method_ = M.method_ in
   let type_ = Fleche.Io.Level.to_int lvl in
-  let params = M.Params.({ type_; message } |> to_yojson) in
-  let params = Yojson.Safe.Util.to_assoc params in
-  let notification =
-    Lsp.Base.(Notification.(make ~method_ ~params () |> Message.notification))
-  in
+  let params = M.Params.{ type_; message } in
+  let notification = M.make params in
   send_message notification
 
 let trace_enabled = true

petanque/json_shell/protocol.ml

@@ -206,6 +206,10 @@ module Trace = struct
       }
     [@@deriving yojson]
   end
+
+  let make params =
+    let params = Params.to_yojson params |> Yojson.Safe.Util.to_assoc in
+    Lsp.Base.Message.Notification { method_; params }
 end
 
 (* Message notification *)
@@ -219,4 +223,8 @@ module Message = struct
       }
     [@@deriving yojson]
   end
+
+  let make params =
+    let params = Params.to_yojson params |> Yojson.Safe.Util.to_assoc in
+    Lsp.Base.Message.Notification { method_; params }
 end

petanque/json_shell/server.ml

@@ -29,7 +29,7 @@ let rec handle_connection ~token ic oc () =
         let* () = Logs_lwt.info (fun m -> m "Sent reply") in
         let* () =
           Lwt_io.fprintl oc
-            (Yojson.Safe.to_string (Lsp.Base.Response.to_yojson reply))
+            (Yojson.Safe.to_string (Lsp.Base.Message.to_yojson reply))
         in
         handle_connection ~token ic oc ())
   with End_of_file -> return ()