From 1710df0e7eab7af62b7d7049b4de6f16df34db5c Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 8 Apr 2021 19:52:35 -0400 Subject: [PATCH] use `logs` to log stuff --- linol.opam | 1 + src/blocking_IO.ml | 16 ++++------------ src/dune | 2 +- src/jsonrpc2.ml | 14 +++----------- src/jsonrpc2.mli | 3 --- src/linol.ml | 1 + src/log.ml | 2 ++ src/server.ml | 16 +++++++++++++++- 8 files changed, 27 insertions(+), 28 deletions(-) create mode 100644 src/log.ml diff --git a/linol.opam b/linol.opam index 58851e0d..f67cc8da 100644 --- a/linol.opam +++ b/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 } diff --git a/src/blocking_IO.ml b/src/blocking_IO.ml index be0c671d..b3bbea0c 100644 --- a/src/blocking_IO.ml +++ b/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 diff --git a/src/dune b/src/dune index 2a23d29c..1354e047 100644 --- a/src/dune +++ b/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)) diff --git a/src/jsonrpc2.ml b/src/jsonrpc2.ml index 4339c864..aa578a70 100644 --- a/src/jsonrpc2.ml +++ b/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 diff --git a/src/jsonrpc2.mli b/src/jsonrpc2.mli index f14b05bb..5df03616 100644 --- a/src/jsonrpc2.mli +++ b/src/jsonrpc2.mli @@ -31,6 +31,3 @@ end module Make(IO : IO) : S with module IO = IO -(**/**) -val _log : ((unit -> string) -> unit) ref -(**/**) diff --git a/src/linol.ml b/src/linol.ml index 649e1613..64f3080f 100644 --- a/src/linol.ml +++ b/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 diff --git a/src/log.ml b/src/log.ml new file mode 100644 index 00000000..dbef00c7 --- /dev/null +++ b/src/log.ml @@ -0,0 +1,2 @@ + +include (val Logs.src_log (Logs.Src.create ~doc:"linol (LSP library)" "linol")) diff --git a/src/server.ml b/src/server.ml index 837d6100..cb0d7094 100644 --- a/src/server.ml +++ b/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} ->