use logs to log stuff

linol.opam

@@ -14,6 +14,7 @@ depends: [
   "dune" { >= "2.0" }
   "containers" { >= "3.0" & < "4.0" }
   "yojson" { >= "1.6" }
+  "logs"
   "lsp" { >= "1.4" & < "1.5" }
   "ocaml" { >= "4.08" }
   "odoc" { with-doc }

src/blocking_IO.ml

@@ -18,12 +18,9 @@ let spawn f =
   let run () =
     try f()
     with e ->
-      let msg =
-        Printf.sprintf "linol: uncaught exception in `spawn`:\n%s\n%!"
-          (Printexc.to_string e)
-      in
-      !Jsonrpc2._log (fun () -> msg);
-      Printf.eprintf "%s\n%!" msg;
+      Log.err (fun k->k
+        "uncaught exception in `spawn`:\n%s\n%!"
+        (Printexc.to_string e));
       raise e
 in
   ignore (Thread.create run () : Thread.t)
@@ -40,14 +37,9 @@ let rec read ic buf i len =
     read ic buf (i+n) (len-n)
   )
 
-let read_line ic =
-  let s = input_line ic in
-  !Jsonrpc2._log (fun () -> spf "read line: '%s'" s);
-  s
+let read_line = input_line
 
 let write oc b i len =
-  !Jsonrpc2._log (fun () -> spf "write '%s'[%d..%d]" (Bytes.unsafe_to_string b) i (i+len));
   output oc b i len; flush oc
 let write_string oc s =
-  !Jsonrpc2._log (fun () -> spf "write-str '%s'" s);
   output_string oc s; flush oc

src/dune

@@ -3,4 +3,4 @@
   (name linol)
   (public_name linol)
   (flags :standard -warn-error -a+8)
-  (libraries containers yojson lsp))
+  (libraries containers yojson lsp logs))

src/jsonrpc2.ml

@@ -10,8 +10,6 @@ type json = Yojson.Safe.t
 
 module type IO = Sigs.IO
 
-let _log : ((unit -> string) -> unit) ref = ref (fun _ -> ())
-
 module type S = sig
   module IO : IO
 
@@ -82,6 +80,7 @@ module Make(IO : IO)
   (* send a single message *)
   let send_json_ (self:t) (j:json) : unit IO.t =
     let json = J.to_string j in
+    Log.debug (fun k->k "jsonrpc2: send json: %s" json);
     let full_s =
       Printf.sprintf "Content-Length: %d\r\n\r\n%s"
         (String.length json) json
@@ -101,13 +100,6 @@ module Make(IO : IO)
       (fun () -> let+ x = f() in Ok x)
       (fun e -> IO.return (Error e))
 
-  let log_lsp_ msg =
-    Fmt.kasprintf
-      (fun s ->
-        Lsp.Logger.log ~title:Lsp.Logger.Title.Debug ~section:"jsonrpc2"
-        "%s" s)
-      msg
-
   (* read a full message *)
   let read_msg (self:t) : (Jsonrpc.Message.either, exn) result IO.t =
     let rec read_headers acc =
@@ -133,7 +125,7 @@ module Make(IO : IO)
         end
     in
     let*? headers = read_headers [] in
-    log_lsp_ "headers: %a" Fmt.Dump.(list @@ pair string string) headers;
+    Log.debug (fun k->k "jsonrpc2: read headers: %a" Fmt.Dump.(list @@ pair string string) headers);
     let ok = match List.assoc "content-type" headers with
       | "utf8" | "utf-8" -> true
       | _ -> false
@@ -142,7 +134,7 @@ module Make(IO : IO)
     if ok then (
       match int_of_string (List.assoc "content-length" headers) with
       | n ->
-        log_lsp_ "read %d bytes..." n;
+        Log.debug (fun k->k "jsonrpc2: read %d bytes..." n);
         let buf = Bytes.make n '\000' in
         let*? () =
           try_ @@ fun () -> IO.read self.ic buf 0 n

src/jsonrpc2.mli

@@ -31,6 +31,3 @@ end
 
 module Make(IO : IO) : S with module IO = IO
 
-(**/**)
-val _log : ((unit -> string) -> unit) ref
-(**/**)

src/linol.ml

@@ -8,5 +8,6 @@ module type IO = Sigs.IO
 module Jsonrpc2 = Jsonrpc2
 module Server = Server
 module Blocking_IO = Blocking_IO
+module Log = Log
 
 module Make = Jsonrpc2.Make

src/log.ml

@@ -0,0 +1,2 @@
+
+include (val Logs.src_log (Logs.Src.create ~doc:"linol (LSP library)" "linol"))

src/server.ml

@@ -164,8 +164,17 @@ module Make(IO : IO) = struct
     method on_request
     : type r. notify_back:_ -> r Lsp.Client_request.t -> r IO.t
     = fun ~notify_back (r:_ Lsp.Client_request.t) ->
+
+      Log.debug
+        (fun k->k "handle request : %a" Yojson.Safe.pp
+            (Lsp.Client_request.to_jsonrpc_request ~id:(Jsonrpc.Id.t_of_yojson `Null) r
+             |> Jsonrpc.Message.yojson_of_request));
+
       begin match r with
-        | Lsp.Client_request.Shutdown -> _quit <- true; IO.return ()
+        | Lsp.Client_request.Shutdown ->
+          Log.info (fun k->k "shutdown");
+          _quit <- true; IO.return ()
+
         | Lsp.Client_request.Initialize i ->
           let notify_back = new notify_back ~notify_back () in
           self#on_req_initialize ~notify_back i
@@ -266,6 +275,11 @@ module Make(IO : IO) = struct
     method on_notification
         ~notify_back (n:Lsp.Client_notification.t) : unit IO.t =
       let open Lsp.Types in
+
+      Log.debug
+        (fun k->k "handle notification: %a" Yojson.Safe.pp
+            (Lsp.Client_notification.to_jsonrpc n |> Jsonrpc.Message.yojson_of_notification));
+
       begin match n with
         | Lsp.Client_notification.TextDocumentDidOpen
             {DidOpenTextDocumentParams.textDocument=doc} ->