diff --git a/petanque/json_shell/lsp_lwt/io.ml b/petanque/json_shell/lsp_lwt/io.ml index 52e9d0e85..5f19e5e76 100644 --- a/petanque/json_shell/lsp_lwt/io.ml +++ b/petanque/json_shell/lsp_lwt/io.ml @@ -4,27 +4,19 @@ module J = Yojson.Safe (* IO for JSON/RPC with Lwt, we could put this in the lsp module, however we don't want to pull Lwt as a dependency for coq-lsp *) -let mut = Mutex.create () +(* let mut = Mutex.create () *) + +(* let read_raw_request ic = let* cl = Lwt_io.read_line ic in let sin = + Scanf.Scanning.from_string cl in let+ raw_obj = Scanf.bscanf sin + "Content-Length: %d\r" (fun size -> (* Consume the second \r\n or header *) + let* ohdr = Lwt_io.read_line ic in (* If the second line is a return, then no + more headers *) let* () = if ohdr.[0] = '\r' then return () else (* Fixme (or + use ocaml-lsp) Skip the Content-type header *) let+ _ = Lwt_io.read_line ic + in () in let buf = Bytes.create size in let+ () = Lwt_io.read_into_exactly ic + buf 0 size in Bytes.to_string buf) in J.from_string raw_obj *) let read_raw_request ic = - let* cl = Lwt_io.read_line ic in - let sin = Scanf.Scanning.from_string cl in - let+ raw_obj = - Scanf.bscanf sin "Content-Length: %d\r" (fun size -> - (* Consume the second \r\n or header *) - let* ohdr = Lwt_io.read_line ic in - (* If the second line is a return, then no more headers *) - let* () = - if ohdr.[0] = '\r' then return () - else - (* Fixme (or use ocaml-lsp) Skip the Content-type header *) - let+ _ = Lwt_io.read_line ic in - () - in - let buf = Bytes.create size in - let+ () = Lwt_io.read_into_exactly ic buf 0 size in - Bytes.to_string buf) - in + let+ raw_obj = Lwt_io.read_line ic in J.from_string raw_obj let read_raw_request ic = @@ -50,10 +42,7 @@ let read_request ic = let+ raw_request = read_raw_request ic in Option.map (fun r -> Result.bind r Lsp.Base.Message.from_yojson) raw_request -let send_json fmt obj = - Mutex.lock mut; - let msg = J.to_string obj ^ "\n" in - let size = String.length msg in - let* () = Lwt_io.fprintf fmt "Content-Length: %d\r\n\r\n%s%!" size msg in - Mutex.unlock mut; - return () +let send_json fmt obj = Lwt_io.fprintl fmt (J.to_string obj) +(* Mutex.lock mut; let msg = J.to_string obj ^ "\n" in let size = String.length + msg in let* () = Lwt_io.fprintf fmt "Content-Length: %d\r\n\r\n%s%!" size msg + in Mutex.unlock mut; return () *)