Merge pull request #17 from c-cube/wip-lsp-1.14

move to lsp 1.14

.ocamlformat

@@ -0,0 +1,15 @@
+version = 0.24.1
+profile=conventional
+margin=80
+if-then-else=k-r
+parens-ite=true
+parens-tuple=multi-line-only
+sequence-style=terminator
+type-decl=sparse
+break-cases=toplevel
+cases-exp-indent=2
+field-space=tight-decl
+leading-nested-match-parens=true
+module-item-spacing=compact
+quiet=true
+ocaml-version=4.08.0

example/template/dune

@@ -2,13 +2,12 @@
  (name main)
  (libraries
   ; Deps on linol + LWT backend
-    linol linol-lwt
+  linol
+  linol-lwt
   ; Types from the lsp library are exposed by the linol libs,
   ; and thus almost guaranteed to be used by code using linol;
   ; it is thus better to explicitly list lsp as a dep rather
   ; than rely on its inclusion as a transitive dep of linol
   ; since it would for instance generate errors if the
   ; implicit-transitive-deps option of dune is set to false
-    lsp
+  lsp))
-    )
- )

example/template/main.ml

@@ -20,10 +20,10 @@ type state_after_processing = unit
 let process_some_input_file (_file_contents : string) : state_after_processing =
   ()
 
-let diagnostics (_state : state_after_processing) : Lsp.Types.Diagnostic.t list =
+let diagnostics (_state : state_after_processing) : Lsp.Types.Diagnostic.t list
+    =
   []
 
-
 (* Lsp server class
 
    This is the main point of interaction beetween the code checking documents
@@ -40,16 +40,15 @@ class lsp_server =
     inherit Linol_lwt.Jsonrpc2.server
 
     (* one env per document *)
-    val buffers: (Lsp.Types.DocumentUri.t, state_after_processing) Hashtbl.t
+    val buffers : (Lsp.Types.DocumentUri.t, state_after_processing) Hashtbl.t =
-      = Hashtbl.create 32
+      Hashtbl.create 32
 
     (* We define here a helper method that will:
        - process a document
        - store the state resulting from the processing
        - return the diagnostics from the new state
     *)
-    method private _on_doc
+    method private _on_doc ~(notify_back : Linol_lwt.Jsonrpc2.notify_back)
-        ~(notify_back:Linol_lwt.Jsonrpc2.notify_back)
         (uri : Lsp.Types.DocumentUri.t) (contents : string) =
       let new_state = process_some_input_file contents in
       Hashtbl.replace buffers uri new_state;
@@ -63,7 +62,8 @@ class lsp_server =
 
     (* Similarly, we also override the [on_notify_doc_did_change] method that will be called
        by the server each time a new document is opened. *)
-    method on_notif_doc_did_change ~notify_back d _c ~old_content:_old ~new_content =
+    method on_notif_doc_did_change ~notify_back d _c ~old_content:_old
+        ~new_content =
       self#_on_doc ~notify_back d.uri new_content
 
     (* On document closes, we remove the state associated to the file from the global
@@ -71,7 +71,6 @@ class lsp_server =
     method on_notif_doc_did_close ~notify_back:_ d : unit Linol_lwt.t =
       Hashtbl.remove buffers d.uri;
       Linol_lwt.return ()
-
   end
 
 (* Main code
@@ -90,4 +89,3 @@ let run () =
 
 (* Finally, we actually run the server *)
 let () = run ()
-

linol-lwt.opam

@@ -13,7 +13,8 @@ build: [
 depends: [
   "dune" { >= "2.0" }
   "linol" { = version }
-  "jsonrpc" { >= "1.11" & < "1.12" }
+  "jsonrpc" { >= "1.14" & < "1.15" }
+  "lsp" { >= "1.14" & < "1.15" }
   "lwt" { >= "5.1" & < "6.0" }
   "base-unix"
   "yojson" { >= "1.6" }

linol.opam

@@ -14,7 +14,7 @@ depends: [
   "dune" { >= "2.0" }
   "yojson" { >= "1.6" }
   "logs"
-  "lsp" { >= "1.11" & < "1.12" }
+  "lsp" { >= "1.14" & < "1.15" }
   "ocaml" { >= "4.12" }
   "odoc" { with-doc }
 ]

src/blocking_IO.ml

@@ -1,4 +1,3 @@
-
 type 'a t = 'a
 type nonrec in_channel = in_channel
 type nonrec out_channel = out_channel
@@ -7,10 +6,8 @@ let (let+) x f = f x
 let ( let* ) x f = f x
 let ( and+ ) a b = a, b
 let return x = x
-
 let failwith = failwith
 let fail = raise
-
 let stdin = stdin
 let stdout = stdout
 
@@ -18,21 +15,16 @@ let default_spawn_ f =
   let run () =
     try f ()
     with e ->
-      Log.err (fun k->k
+      Log.err (fun k ->
-        "uncaught exception in `spawn`:\n%s\n%!"
+          k "uncaught exception in `spawn`:\n%s\n%!" (Printexc.to_string e));
-        (Printexc.to_string e));
       raise e
   in
   ignore (Thread.create run ())
 
 let spawn_ref_ = ref default_spawn_
-
 let set_spawn_function f = spawn_ref_ := f
 let spawn f = !spawn_ref_ f
-
+let catch f g = try f () with e -> g e
-let catch f g =
-  try f()
-  with e -> g e
 
 let rec read ic buf i len =
   if len > 0 then (
@@ -43,6 +35,9 @@ let rec read ic buf i len =
 let read_line = input_line
 
 let write oc b i len =
-  output oc b i len; flush oc
+  output oc b i len;
+  flush oc
+
 let write_string oc s =
-  output_string oc s; flush oc
+  output_string oc s;
+  flush oc

src/blocking_IO.mli

@@ -1,7 +1,8 @@
-
 (** {1 Blocking IO with a new thread for each [spawn]} *)
 
-include Sigs.IO with type 'a t = 'a
+include
+  Sigs.IO
+    with type 'a t = 'a
      and type in_channel = in_channel
      and type out_channel = out_channel
 

src/dune

@@ -1,4 +1,3 @@
-
 (library
  (name linol)
  (public_name linol)

src/jsonrpc2.ml

@@ -1,4 +1,3 @@
-
 (** {1 Simple JSON-RPC2 implementation}
     See {{: https://www.jsonrpc.org/specification} the spec} *)
 
@@ -17,25 +16,17 @@ module type S = sig
 
   include module type of Server.Make (IO)
 
-  val create :
+  val create : ic:IO.in_channel -> oc:IO.out_channel -> server -> t
-    ic:IO.in_channel ->
-    oc:IO.out_channel ->
-    server ->
-    t
   (** Create a connection from the pair of channels *)
 
   val create_stdio : server -> t
   (** Create a connection using stdin/stdout *)
 
-  val run :
+  val run : ?shutdown:(unit -> bool) -> t -> unit IO.t
-    ?shutdown:(unit -> bool) ->
-    t -> unit IO.t
   (** Listen for incoming messages and responses *)
 end
 
-module Make(IO : IO)
+module Make (IO : IO) : S with module IO = IO = struct
-    : S with module IO = IO
-= struct
   module IO = IO
   include Server.Make (IO)
   open IO
@@ -72,17 +63,14 @@ module Make(IO : IO)
   }
 
   let create ~ic ~oc server : t = { ic; oc; s = server }
-
+  let create_stdio server : t = create ~ic:IO.stdin ~oc:IO.stdout server
-  let create_stdio server : t =
-    create ~ic:IO.stdin ~oc:IO.stdout server
 
   (* 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"
+      Printf.sprintf "Content-Length: %d\r\n\r\n%s" (String.length json) json
-        (String.length json) json
     in
     IO.write_string self.oc full_s
 
@@ -90,44 +78,47 @@ module Make(IO : IO)
     let json = Jsonrpc.Response.yojson_of_t m in
     send_json_ self json
 
-  let send_server_notif (self:t) (m:Jsonrpc.Message.notification) : unit IO.t =
+  let send_server_notif (self : t) (m : Jsonrpc.Notification.t) : unit IO.t =
-    let json = Jsonrpc.Message.yojson_of_notification m in
+    let json = Jsonrpc.Notification.yojson_of_t m in
     send_json_ self json
 
   let try_ f =
     IO.catch
-      (fun () -> let+ x = f() in Ok x)
+      (fun () ->
+        let+ x = f () in
+        Ok x)
       (fun e -> IO.return (Error e))
 
   (* read a full message *)
-  let read_msg (self:t) : (Jsonrpc.Message.either, exn) result IO.t =
+  let read_msg (self : t) : (Jsonrpc.Packet.t, exn) result IO.t =
     let rec read_headers acc =
-      let*? line =
+      let*? line = try_ @@ fun () -> IO.read_line self.ic in
-        try_ @@ fun () -> IO.read_line self.ic
-      in
       match String.trim line with
       | "" -> IO.return (Ok acc) (* last separator *)
       | line ->
-        begin match
+        (match
            let i = String.index line ':' in
            if i < 0 || String.get line (i + 1) <> ' ' then raise Not_found;
            let key = String.lowercase_ascii @@ String.sub line 0 i in
            let v =
-              String.lowercase_ascii @@
+             String.lowercase_ascii
-              String.trim (String.sub line (i+1) (String.length line-i-1))
+             @@ String.trim
+                  (String.sub line (i + 1) (String.length line - i - 1))
            in
            key, v
          with
         | pair -> read_headers (pair :: acc)
         | exception _ ->
-            IO.return (Error (E(ErrorCode.ParseError, spf "invalid header: %S" line)))
+          IO.return
-        end
+            (Error (E (ErrorCode.ParseError, spf "invalid header: %S" line))))
     in
     let*? headers = read_headers [] in
-    Log.debug (fun k->k "jsonrpc2: read headers: [%s]"
+    Log.debug (fun k ->
-                  (String.concat ";" @@
+        k "jsonrpc2: read headers: [%s]"
-                   List.map (fun (a,b)->Printf.sprintf "(%S,%S)" a b) headers));
+          (String.concat ";"
-    let ok = match List.assoc "content-type" headers with
+          @@ List.map (fun (a, b) -> Printf.sprintf "(%S,%S)" a b) headers));
+    let ok =
+      match List.assoc "content-type" headers with
       | "utf8" | "utf-8" -> true
       | _ -> false
       | exception Not_found -> true
@@ -137,58 +128,55 @@ module Make(IO : IO)
       | n ->
         Log.debug (fun k -> k "jsonrpc2: read %d bytes..." n);
         let buf = Bytes.make n '\000' in
-        let*? () =
+        let*? () = try_ @@ fun () -> IO.read self.ic buf 0 n in
-          try_ @@ fun () -> IO.read self.ic buf 0 n
-        in
         (* log_lsp_ "got bytes %S" (Bytes.unsafe_to_string buf); *)
         let*? j =
           try_ @@ fun () ->
           IO.return @@ J.from_string (Bytes.unsafe_to_string buf)
         in
         Log.debug (fun k -> k "got json %s" (J.to_string j));
-        begin match Jsonrpc.Message.either_of_yojson j with
+        (match Jsonrpc.Packet.t_of_yojson j with
         | m -> IO.return @@ Ok m
         | exception _ ->
           Log.err (fun k -> k "cannot decode json message");
-            IO.return (Error (E(ErrorCode.ParseError, "cannot decode json")))
+          IO.return (Error (E (ErrorCode.ParseError, "cannot decode json"))))
-        end
       | exception _ ->
-        IO.return @@
+        IO.return
-        Error (E(ErrorCode.ParseError, "missing content-length' header"))
+        @@ Error (E (ErrorCode.ParseError, "missing content-length' header"))
-    ) else (
+    ) else
-      IO.return @@
+      IO.return
-      Error (E(ErrorCode.InvalidRequest, "content-type must be 'utf-8'"))
+      @@ Error (E (ErrorCode.InvalidRequest, "content-type must be 'utf-8'"))
-    )
 
   let run ?(shutdown = fun _ -> false) (self : t) : unit IO.t =
     let process_msg r =
-      let module M = Jsonrpc.Message in
+      let module M = Jsonrpc.Packet in
       let protect ~id f =
-        IO.catch f
+        IO.catch f (fun e ->
-          (fun e ->
+            let message =
-             let message = spf "%s\n%s" (Printexc.to_string e) (Printexc.get_backtrace()) in
+              spf "%s\n%s" (Printexc.to_string e) (Printexc.get_backtrace ())
+            in
             Log.err (fun k -> k "error: %s" message);
-             let r = Jsonrpc.Response.error id
+            let r =
+              Jsonrpc.Response.error id
                 (Jsonrpc.Response.Error.make
-                 ~code:Jsonrpc.Response.Error.Code.InternalError
+                   ~code:Jsonrpc.Response.Error.Code.InternalError ~message ())
-                 ~message ())
             in
             send_response self r)
       in
-      match r.M.id with
+      match r with
-      | None ->
+      | M.Notification n ->
         (* notification *)
-        begin match Lsp.Client_notification.of_jsonrpc {r with M.id=()} with
+        (match Lsp.Client_notification.of_jsonrpc n with
         | Ok n ->
           IO.catch
             (fun () ->
-                (self.s)#on_notification n
+              self.s#on_notification n ~notify_back:(fun n ->
-                  ~notify_back:(fun n ->
                   let msg = Lsp.Server_notification.to_jsonrpc n in
                   send_server_notif self msg))
             (fun e ->
               let msg =
-                   Lsp.Types.LogMessageParams.create ~type_:Lsp.Types.MessageType.Error
+                Lsp.Types.LogMessageParams.create
+                  ~type_:Lsp.Types.MessageType.Error
                   ~message:(Printexc.to_string e)
               in
               let msg =
@@ -196,50 +184,49 @@ module Make(IO : IO)
                 |> Lsp.Server_notification.to_jsonrpc
               in
               send_server_notif self msg)
-          | Error e ->
+        | Error e -> IO.failwith (spf "cannot decode notification: %s" e))
-            IO.failwith (spf "cannot decode notification: %s" e)
+      | M.Request r ->
-        end
-      | Some id ->
         (* request, so we need to reply *)
+        let id = r.id in
         IO.catch
           (fun () ->
-            begin match Lsp.Client_request.of_jsonrpc {r with M.id} with
+            match Lsp.Client_request.of_jsonrpc r with
             | Ok (Lsp.Client_request.E r) ->
               protect ~id (fun () ->
-                  let* reply = self.s#on_request r ~id
+                  let* reply =
-                    ~notify_back:(fun n ->
+                    self.s#on_request r ~id ~notify_back:(fun n ->
                         let msg = Lsp.Server_notification.to_jsonrpc n in
                         send_server_notif self msg)
                   in
-                  let reply_json = Lsp.Client_request.yojson_of_result r reply in
+                  let reply_json =
+                    Lsp.Client_request.yojson_of_result r reply
+                  in
                   let response = Jsonrpc.Response.ok id reply_json in
-                  send_response self response
+                  send_response self response)
-                )
+            | Error e -> IO.failwith (spf "cannot decode request: %s" e))
-              | Error e ->
-                IO.failwith (spf "cannot decode request: %s" e)
-            end)
           (fun e ->
-            let message = spf "%s\n%s" (Printexc.to_string e) (Printexc.get_backtrace()) in
+            let message =
+              spf "%s\n%s" (Printexc.to_string e) (Printexc.get_backtrace ())
+            in
             Log.err (fun k -> k "error: %s" message);
             let r =
               Jsonrpc.Response.error id
                 (Jsonrpc.Response.Error.make
-                ~code:Jsonrpc.Response.Error.Code.InternalError
+                   ~code:Jsonrpc.Response.Error.Code.InternalError ~message ())
-                ~message ())
             in
             send_response self r)
+      | _p -> IO.failwith "neither notification nor request"
     in
     let rec loop () =
-      if shutdown() then IO.return ()
+      if shutdown () then
-      else (
+        IO.return ()
+      else
         let* r = read_msg self in
         match r with
         | Ok r ->
           IO.spawn (fun () -> process_msg r);
           loop ()
         | Error e -> IO.fail e
-      )
     in
     loop ()
 end
-

src/jsonrpc2.mli

@@ -1,5 +1,3 @@
-
-
 type json = Yojson.Safe.t
 
 module type IO = Sigs.IO
@@ -12,22 +10,15 @@ module type S = sig
 
   include module type of Server.Make (IO)
 
-  val create :
+  val create : ic:IO.in_channel -> oc:IO.out_channel -> server -> t
-    ic:IO.in_channel ->
-    oc:IO.out_channel ->
-    server ->
-    t
   (** Create a connection from the pair of channels *)
 
   val create_stdio : server -> t
   (** Create a connection using stdin/stdout *)
 
-  val run :
+  val run : ?shutdown:(unit -> bool) -> t -> unit IO.t
-    ?shutdown:(unit -> bool) ->
-    t -> unit IO.t
   (** Listen for incoming messages and responses.
     @param shutdown if true, tells the server to shut down *)
 end
 
 module Make (IO : IO) : S with module IO = IO
-

src/linol.ml

@@ -1,13 +1,12 @@
-
 (** {1 Linol}
 
     Abstraction over The "Lsp" library, to make it easier to develop
     LSP servers in OCaml (but not necessarily {b for} OCaml). *)
 
 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

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

src/lwt/dune

@@ -1,4 +1,3 @@
-
 (library
  (name linol_lwt)
  (public_name linol-lwt)

src/lwt/linol_lwt.ml

@@ -1,20 +1,22 @@
-
 module type IO = Linol.IO
 
-module IO_lwt
+module IO_lwt :
-  : IO with type 'a t = 'a Lwt.t
+  IO
+    with type 'a t = 'a Lwt.t
      and type in_channel = Lwt_io.input Lwt_io.channel
-        and type out_channel = Lwt_io.output Lwt_io.channel
+     and type out_channel = Lwt_io.output Lwt_io.channel = struct
-= struct
   type 'a t = 'a Lwt.t
+
   let ( let+ ) = Lwt.( >|= )
   let ( let* ) = Lwt.( >>= )
+
   let ( and+ ) a b =
     let open Lwt in
-    a >>= fun x -> b >|= fun y -> x,y
+    a >>= fun x ->
+    b >|= fun y -> x, y
+
   let return = Lwt.return
   let failwith = Lwt.fail_with
-
   let stdin = Lwt_io.stdin
   let stdout = Lwt_io.stdout
 
@@ -25,15 +27,12 @@ module IO_lwt
   let write = Lwt_io.write_from_exactly
   let read = Lwt_io.read_into_exactly
   let read_line = Lwt_io.read_line
-
   let catch = Lwt.catch
   let fail = Lwt.fail
 
   let spawn f =
-    Lwt.async
+    Lwt.async (fun () ->
-      (fun () ->
+        Lwt.catch f (fun exn ->
-         Lwt.catch f
-           (fun exn ->
             Printf.eprintf "uncaught exception in `spawn`:\n%s\n%!"
               (Printexc.to_string exn);
             Lwt.return ()))
@@ -41,6 +40,7 @@ end
 
 include Lsp.Types
 include IO_lwt
+
 type doc_state = Linol.Server.doc_state
 
 module Jsonrpc2 = Linol.Jsonrpc2.Make (IO_lwt)

src/server.ml

@@ -1,13 +1,12 @@
-
 open Sigs
 
-(** Current state of a document. *)
 type nonrec doc_state = {
   uri: Lsp.Types.DocumentUri.t;
   languageId: string;
   version: int;
   content: string;
 }
+(** Current state of a document. *)
 
 (** {2 Request ID}
 
@@ -24,7 +23,6 @@ end
 (** {2 Server interface for some IO substrate} *)
 module Make (IO : IO) = struct
   open Lsp.Types
-
   module Position = Position
   module Range = Range
   module Diagnostic = Diagnostic
@@ -32,13 +30,15 @@ module Make(IO : IO) = struct
   module Req_id = Req_id
 
   (** The server baseclass *)
-  class virtual base_server = object
+  class virtual base_server =
-    method virtual on_notification :
+    object
-      notify_back:(Lsp.Server_notification.t -> unit IO.t) ->
+      method virtual on_notification
+          : notify_back:(Lsp.Server_notification.t -> unit IO.t) ->
             Lsp.Client_notification.t ->
             unit IO.t
 
-    method virtual on_request : 'a.
+      method virtual on_request
+          : 'a.
             notify_back:(Lsp.Server_notification.t -> unit IO.t) ->
             id:Req_id.t ->
             'a Lsp.Client_request.t ->
@@ -48,72 +48,109 @@ module Make(IO : IO) = struct
         messages, diagnostics, etc.
         @param id the query RPC ID, can be used for tracing, cancellation, etc. *)
 
-    (** Set to true if the client requested to exit *)
       method must_quit = false
+      (** Set to true if the client requested to exit *)
     end
 
   (** A wrapper to more easily reply to notifications *)
-  class notify_back ~notify_back ?version ?(uri:DocumentUri.t option) () = object
+  class notify_back ~notify_back ~workDoneToken ~partialResultToken:_ ?version
+    ?(uri : DocumentUri.t option) () =
+    object
       val mutable uri = uri
       method set_uri u = uri <- Some u
 
-    (** Send a log message to the editor *)
       method send_log_msg ~type_ msg : unit IO.t =
         let params = LogMessageParams.create ~type_ ~message:msg in
         notify_back (Lsp.Server_notification.LogMessage params)
+      (** Send a log message to the editor *)
 
-    (** Send diagnostics for the current document *)
       method send_diagnostic (l : Diagnostic.t list) : unit IO.t =
         match uri with
-      | None -> IO.failwith "notify_back: cannot publish diagnostics, no URI given"
+        | None ->
+          IO.failwith "notify_back: cannot publish diagnostics, no URI given"
         | Some uri ->
-        let params = PublishDiagnosticsParams.create
+          let params =
-            ~uri ?version ~diagnostics:l () in
+            PublishDiagnosticsParams.create ~uri ?version ~diagnostics:l ()
+          in
           notify_back (Lsp.Server_notification.PublishDiagnostics params)
+      (** Send diagnostics for the current document *)
 
+      method telemetry json : unit IO.t =
+        notify_back @@ Lsp.Server_notification.TelemetryNotification json
+
+      method cancel_request (id : Jsonrpc.Id.t) : unit IO.t =
+        notify_back @@ CancelRequest id
+
+      method work_done_progress_begin (p : Lsp.Types.WorkDoneProgressBegin.t)
+          : unit IO.t =
+        match workDoneToken with
+        | Some token ->
+          notify_back
+          @@ WorkDoneProgress
+               { value = Lsp.Server_notification.Progress.Begin p; token }
+        | None -> IO.return ()
+
+      method work_done_progress_report (p : Lsp.Types.WorkDoneProgressReport.t)
+          : unit IO.t =
+        match workDoneToken with
+        | Some token ->
+          notify_back
+          @@ WorkDoneProgress
+               { value = Lsp.Server_notification.Progress.Report p; token }
+        | None -> IO.return ()
+
+      method work_done_progress_end (p : Lsp.Types.WorkDoneProgressEnd.t)
+          : unit IO.t =
+        match workDoneToken with
+        | Some token ->
+          notify_back
+          @@ WorkDoneProgress
+               { value = Lsp.Server_notification.Progress.End p; token }
+        | None -> IO.return ()
+
+      method send_notification (n : Lsp.Server_notification.t) = notify_back n
       (** Send a notification (general purpose method) *)
-    method send_notification (n:Lsp.Server_notification.t) =
-      notify_back n
     end
 
-  (** Current state of a document. *)
   type nonrec doc_state = doc_state = {
     uri: DocumentUri.t;
     languageId: string;
     version: int;
     content: string;
   }
+  (** Current state of a document. *)
 
   (** An easily overloadable class. Pick the methods you want to support.
       The user must provide at least the callbacks for document lifecycle:
       open, close, update. The most basic LSP server should check documents
       when they're updated and report diagnostics back to the editor. *)
-  class virtual server = object(self)
+  class virtual server =
+    object (self)
       inherit base_server
       val mutable _quit = false
       val docs : (DocumentUri.t, doc_state) Hashtbl.t = Hashtbl.create 16
-
       method! must_quit = _quit
 
-    (** Find current state of the given document, if present. *)
       method find_doc (uri : DocumentUri.t) : doc_state option =
-      try Some (Hashtbl.find docs uri)
+        try Some (Hashtbl.find docs uri) with Not_found -> None
-      with Not_found -> None
+      (** Find current state of the given document, if present. *)
 
-    (** Override to process other requests *)
+      method on_request_unhandled : type r.
-    method on_request_unhandled
+          notify_back:notify_back ->
-      : type r. notify_back:notify_back ->
+          id:Req_id.t ->
-        id:Req_id.t -> r Lsp.Client_request.t -> r IO.t
+          r Lsp.Client_request.t ->
-      = fun ~notify_back:_ ~id:_ _r ->
+          r IO.t =
+        fun ~notify_back:(_ : notify_back) ~id:_ _r ->
           Log.debug (fun k -> k "req: unhandled request");
           IO.failwith "TODO: handle this request"
+      (** Override to process other requests *)
 
-    (** Parameter for how to synchronize content with the editor *)
       method config_sync_opts : TextDocumentSyncOptions.t =
-      TextDocumentSyncOptions.create
+        TextDocumentSyncOptions.create ~change:TextDocumentSyncKind.Incremental
-        ~change:TextDocumentSyncKind.Incremental ~openClose:true
+          ~openClose:true
           ~save:(`SaveOptions (SaveOptions.create ~includeText:false ()))
           ~willSave:false ()
+      (** Parameter for how to synchronize content with the editor *)
 
       method config_completion : CompletionOptions.t option = None
       (** Configuration for the completion API.
@@ -122,39 +159,50 @@ module Make(IO : IO) = struct
       method config_code_lens_options : CodeLensOptions.t option = None
       (** @since 0.3 *)
 
-    method config_definition :
+      method config_definition
-      [`Bool of bool | `DefinitionOptions of DefinitionOptions.t ] option = None
+          : [ `Bool of bool | `DefinitionOptions of DefinitionOptions.t ] option
+          =
+        None
       (** @since 0.3 *)
 
-    method config_hover :
+      method config_hover
-      [`Bool of bool | `HoverOptions of HoverOptions.t ] option = None
+          : [ `Bool of bool | `HoverOptions of HoverOptions.t ] option =
+        None
       (** @since 0.3 *)
 
-    method config_symbol :
+      method config_symbol
-      [`Bool of bool | `DocumentSymbolOptions of DocumentSymbolOptions.t ] option = None
+          : [ `Bool of bool
+            | `DocumentSymbolOptions of DocumentSymbolOptions.t
+            ]
+            option =
+        None
       (** @since 0.3 *)
 
-    method config_code_action_provider :
+      method config_code_action_provider
-      [`CodeActionOptions of CodeActionOptions.t | `Bool of bool] = `Bool false
+          : [ `CodeActionOptions of CodeActionOptions.t | `Bool of bool ] =
+        `Bool false
       (** @since 0.3 *)
 
+      method config_modify_capabilities (c : ServerCapabilities.t)
+          : ServerCapabilities.t =
+        c
       (** Modify capabilities before sending them back to the client.
         By default we just return them unmodified.
         @since 0.3 *)
-    method config_modify_capabilities (c:ServerCapabilities.t) : ServerCapabilities.t = c
 
-    (** List of commands available *)
       method config_list_commands : string list = []
+      (** List of commands available *)
 
-    method on_req_initialize ~notify_back:_
+      method on_req_initialize ~notify_back:(_ : notify_back)
           (_i : InitializeParams.t) : InitializeResult.t IO.t =
         let sync_opts = self#config_sync_opts in
         let capabilities =
           ServerCapabilities.create
             ?codeLensProvider:self#config_code_lens_options
             ~codeActionProvider:self#config_code_action_provider
-          ~executeCommandProvider:(ExecuteCommandOptions.create
+            ~executeCommandProvider:
-                                     ~commands:self#config_list_commands ())
+              (ExecuteCommandOptions.create ~commands:self#config_list_commands
+                 ())
             ?completionProvider:self#config_completion
             ?definitionProvider:self#config_definition
             ?hoverProvider:self#config_hover
@@ -164,145 +212,176 @@ module Make(IO : IO) = struct
         in
         IO.return @@ InitializeResult.create ~capabilities ()
 
+      method on_req_hover ~notify_back:(_ : notify_back) ~id:_ ~uri:_ ~pos:_
+          ~workDoneToken:_ (_ : doc_state) : Hover.t option IO.t =
+        IO.return None
       (** Called when the user hovers on some identifier in the document *)
-    method on_req_hover ~notify_back:_ ~id:_ ~uri:_ ~pos:_ ~workDoneToken:_
-        (_ : doc_state) : Hover.t option IO.t =
-      IO.return None
 
+      method on_req_completion ~notify_back:(_ : notify_back) ~id:_ ~uri:_
+          ~pos:_ ~ctx:_ ~workDoneToken:_ ~partialResultToken:_ (_ : doc_state)
+          : [ `CompletionList of CompletionList.t
+            | `List of CompletionItem.t list
+            ]
+            option
+            IO.t =
+        IO.return None
       (** Called when the user requests completion in the document *)
-    method on_req_completion  ~notify_back:_ ~id:_ ~uri:_ ~pos:_ ~ctx:_
-        ~workDoneToken:_ ~partialResultToken:_
-        (_ : doc_state) :
-          [ `CompletionList of CompletionList.t
-          | `List of CompletionItem.t list ] option IO.t =
-      IO.return None
 
+      method on_req_definition ~notify_back:(_ : notify_back) ~id:_ ~uri:_
+          ~pos:_ ~workDoneToken:_ ~partialResultToken:_ (_ : doc_state)
+          : Locations.t option IO.t =
+        IO.return None
       (** Called when the user wants to jump-to-definition  *)
-    method on_req_definition  ~notify_back:_ ~id:_ ~uri:_ ~pos:_
-        ~workDoneToken:_ ~partialResultToken:_
-        (_ : doc_state) : Locations.t option IO.t =
-      IO.return None
 
+      method on_req_code_lens ~notify_back:(_ : notify_back) ~id:_ ~uri:_
+          ~workDoneToken:_ ~partialResultToken:_ (_ : doc_state)
+          : CodeLens.t list IO.t =
+        IO.return []
       (** List code lenses for the given document
         @since 0.3 *)
-    method on_req_code_lens  ~notify_back:_ ~id:_ ~uri:_
-        ~workDoneToken:_ ~partialResultToken:_
-        (_ : doc_state) : CodeLens.t list IO.t =
-      IO.return []
 
-    (** Code lens resolution, must return a code lens with non null "command"
+      method on_req_code_lens_resolve ~notify_back:(_ : notify_back) ~id:_
-        @since 0.3 *)
-    method on_req_code_lens_resolve
-        ~notify_back:(_:notify_back) ~id:_
           (cl : CodeLens.t) : CodeLens.t IO.t =
         IO.return cl
+      (** Code lens resolution, must return a code lens with non null "command"
+        @since 0.3 *)
 
+      method on_req_code_action ~notify_back:(_ : notify_back) ~id:_
+          (_c : CodeActionParams.t) : CodeActionResult.t IO.t =
+        IO.return None
       (** Code action.
         @since 0.3 *)
-    method on_req_code_action ~notify_back:(_:notify_back) ~id:_
-        (_c:CodeActionParams.t)
-      : CodeActionResult.t IO.t =
-      IO.return None
 
+      method on_req_execute_command ~notify_back:(_ : notify_back) ~id:_
+          ~workDoneToken:_ (_c : string) (_args : Yojson.Safe.t list option)
+          : Yojson.Safe.t IO.t =
+        IO.return `Null
       (** Execute a command with given arguments.
         @since 0.3 *)
-    method on_req_execute_command ~notify_back:_ ~id:_ ~workDoneToken:_
-        (_c:string) (_args:Yojson.Safe.t list option) : Yojson.Safe.t IO.t =
-      IO.return `Null
 
+      method on_req_symbol ~notify_back:(_ : notify_back) ~id:_ ~uri:_
+          ~workDoneToken:_ ~partialResultToken:_ ()
+          : [ `DocumentSymbol of DocumentSymbol.t list
+            | `SymbolInformation of SymbolInformation.t list
+            ]
+            option
+            IO.t =
+        IO.return None
       (** List symbols in this document.
         @since 0.3 *)
-    method on_req_symbol ~notify_back:_ ~id:_ ~uri:_
-        ~workDoneToken:_ ~partialResultToken:_
-        () : [ `DocumentSymbol of DocumentSymbol.t list
-             | `SymbolInformation of SymbolInformation.t list ] option IO.t =
-      IO.return None
 
-    method on_request
+      method on_request : type r.
-    : type r. notify_back:_ -> id:Req_id.t -> r Lsp.Client_request.t -> r IO.t
+          notify_back:_ -> id:Req_id.t -> r Lsp.Client_request.t -> r IO.t =
-    = fun ~notify_back ~id (r:_ Lsp.Client_request.t) ->
+        fun ~notify_back ~id (r : _ Lsp.Client_request.t) ->
-      Log.debug (fun k->k "handle request[id=%s] <opaque>" (Req_id.to_string id));
+          Log.debug (fun k ->
+              k "handle request[id=%s] <opaque>" (Req_id.to_string id));
 
-      begin match r with
+          match r with
           | Lsp.Client_request.Shutdown ->
             Log.info (fun k -> k "shutdown");
-          _quit <- true; IO.return ()
+            _quit <- true;
-
+            IO.return ()
           | Lsp.Client_request.Initialize i ->
             Log.debug (fun k -> k "req: initialize");
-          let notify_back = new notify_back ~notify_back () in
+            let notify_back =
+              new notify_back
+                ~partialResultToken:None ~workDoneToken:i.workDoneToken
+                ~notify_back ()
+            in
             self#on_req_initialize ~notify_back i
-
+          | Lsp.Client_request.TextDocumentHover
-        | Lsp.Client_request.TextDocumentHover { textDocument; position; workDoneToken } ->
+              { textDocument; position; workDoneToken } ->
             let uri = textDocument.uri in
             Log.debug (fun k -> k "req: hover '%s'" (DocumentUri.to_path uri));
 
-          begin match Hashtbl.find_opt docs uri with
+            (match Hashtbl.find_opt docs uri with
             | None -> IO.return None
             | Some doc_st ->
-              let notify_back = new notify_back ~uri ~notify_back () in
+              let notify_back =
-              self#on_req_hover ~notify_back ~id ~uri ~pos:position ~workDoneToken doc_st
+                new notify_back
-          end
+                  ~workDoneToken ~partialResultToken:None ~uri ~notify_back ()
-
+              in
-        | Lsp.Client_request.TextDocumentCompletion {
+              self#on_req_hover ~notify_back ~id ~uri ~pos:position
-            textDocument; position; context; workDoneToken; partialResultToken;
+                ~workDoneToken doc_st)
+          | Lsp.Client_request.TextDocumentCompletion
+              {
+                textDocument;
+                position;
+                context;
+                workDoneToken;
+                partialResultToken;
               } ->
             let uri = textDocument.uri in
-          Log.debug (fun k->k "req: complete '%s'" (DocumentUri.to_path uri));
+            Log.debug (fun k ->
-          begin match Hashtbl.find_opt docs uri with
+                k "req: complete '%s'" (DocumentUri.to_path uri));
+            (match Hashtbl.find_opt docs uri with
             | None -> IO.return None
             | Some doc_st ->
-              let notify_back = new notify_back ~uri ~notify_back () in
+              let notify_back =
-              self#on_req_completion ~notify_back ~id ~uri
+                new notify_back
-                ~workDoneToken ~partialResultToken
+                  ~partialResultToken ~workDoneToken ~uri ~notify_back ()
-                ~pos:position ~ctx:context doc_st
+              in
-          end
+              self#on_req_completion ~notify_back ~id ~uri ~workDoneToken
-        | Lsp.Client_request.TextDocumentDefinition {
+                ~partialResultToken ~pos:position ~ctx:context doc_st)
-            textDocument; position; workDoneToken; partialResultToken;
+          | Lsp.Client_request.TextDocumentDefinition
-          } ->
+              { textDocument; position; workDoneToken; partialResultToken } ->
             let uri = textDocument.uri in
-          Log.debug (fun k->k "req: definition '%s'" (DocumentUri.to_path uri));
+            Log.debug (fun k ->
-          let notify_back = new notify_back ~uri ~notify_back () in
+                k "req: definition '%s'" (DocumentUri.to_path uri));
+            let notify_back =
+              new notify_back
+                ~workDoneToken ~partialResultToken ~uri ~notify_back ()
+            in
 
-          begin match Hashtbl.find_opt docs uri with
+            (match Hashtbl.find_opt docs uri with
             | None -> IO.return None
             | Some doc_st ->
-              self#on_req_definition ~notify_back ~id
+              self#on_req_definition ~notify_back ~id ~workDoneToken
-                ~workDoneToken ~partialResultToken
+                ~partialResultToken ~uri ~pos:position doc_st)
-                ~uri ~pos:position doc_st
+          | Lsp.Client_request.TextDocumentCodeLens
-          end
+              { textDocument; workDoneToken; partialResultToken } ->
-
-        | Lsp.Client_request.TextDocumentCodeLens {
-            textDocument; workDoneToken; partialResultToken;
-          } ->
             let uri = textDocument.uri in
-          Log.debug (fun k->k "req: codelens '%s'" (DocumentUri.to_path uri));
+            Log.debug (fun k ->
-          let notify_back = new notify_back ~uri ~notify_back () in
+                k "req: codelens '%s'" (DocumentUri.to_path uri));
+            let notify_back =
+              new notify_back
+                ~workDoneToken ~partialResultToken ~uri ~notify_back ()
+            in
 
-          begin match Hashtbl.find_opt docs uri with
+            (match Hashtbl.find_opt docs uri with
             | None -> IO.return []
             | Some doc_st ->
-              self#on_req_code_lens ~notify_back ~id ~uri
+              self#on_req_code_lens ~notify_back ~id ~uri ~workDoneToken
-                ~workDoneToken ~partialResultToken doc_st
+                ~partialResultToken doc_st)
-          end
-
           | Lsp.Client_request.TextDocumentCodeLensResolve cl ->
             Log.debug (fun k -> k "req: codelens resolve");
-          let notify_back = new notify_back ~notify_back () in
+            let notify_back =
+              new notify_back
+                ~workDoneToken:None ~partialResultToken:None ~notify_back ()
+            in
             self#on_req_code_lens_resolve ~notify_back ~id cl
-
+          | Lsp.Client_request.ExecuteCommand
-        | Lsp.Client_request.ExecuteCommand { command; arguments; workDoneToken } ->
+              { command; arguments; workDoneToken } ->
             Log.debug (fun k -> k "req: execute command '%s'" command);
-          let notify_back = new notify_back ~notify_back () in
+            let notify_back =
-          self#on_req_execute_command ~notify_back ~id ~workDoneToken command arguments
+              new notify_back
-
+                ~workDoneToken ~partialResultToken:None ~notify_back ()
-        | Lsp.Client_request.DocumentSymbol { textDocument=d; workDoneToken; partialResultToken } ->
+            in
-          let notify_back = new notify_back ~notify_back () in
+            self#on_req_execute_command ~notify_back ~id ~workDoneToken command
-          self#on_req_symbol ~notify_back ~id ~uri:d.uri
+              arguments
-            ~workDoneToken ~partialResultToken ()
+          | Lsp.Client_request.DocumentSymbol
-
+              { textDocument = d; workDoneToken; partialResultToken } ->
+            let notify_back =
+              new notify_back ~workDoneToken ~partialResultToken ~notify_back ()
+            in
+            self#on_req_symbol ~notify_back ~id ~uri:d.uri ~workDoneToken
+              ~partialResultToken ()
           | Lsp.Client_request.CodeAction a ->
-          let notify_back = new notify_back ~notify_back () in
+            let notify_back =
+              new notify_back
+                ~workDoneToken:a.workDoneToken
+                ~partialResultToken:a.partialResultToken ~notify_back ()
+            in
             self#on_req_code_action ~notify_back ~id a
           | Lsp.Client_request.CodeActionResolve _
           | Lsp.Client_request.LinkedEditingRange _
@@ -330,81 +409,111 @@ module Make(IO : IO) = struct
           | Lsp.Client_request.SemanticTokensDelta _
           | Lsp.Client_request.SemanticTokensFull _
           | Lsp.Client_request.SemanticTokensRange _
+          | Lsp.Client_request.TextDocumentImplementation _
+          | Lsp.Client_request.TextDocumentPrepareCallHierarchy _
+          | Lsp.Client_request.TextDocumentRangeFormatting _
+          | Lsp.Client_request.CallHierarchyIncomingCalls _
+          | Lsp.Client_request.CallHierarchyOutgoingCalls _
+          | Lsp.Client_request.WillCreateFiles _
+          | Lsp.Client_request.WillDeleteFiles _
+          | Lsp.Client_request.WillRenameFiles _
           | Lsp.Client_request.UnknownRequest _ ->
-          let notify_back = new notify_back ~notify_back () in
+            let notify_back =
+              new notify_back
+                ~workDoneToken:None ~partialResultToken:None ~notify_back ()
+            in
             self#on_request_unhandled ~notify_back ~id r
-      end
 
-    (** Called when a document is opened *)
+      method virtual on_notif_doc_did_open
-    method virtual on_notif_doc_did_open :
+          : notify_back:notify_back ->
-      notify_back:notify_back ->
             TextDocumentItem.t ->
             content:string ->
             unit IO.t
+      (** Called when a document is opened *)
 
-    method virtual on_notif_doc_did_close :
+      method virtual on_notif_doc_did_close
-      notify_back:notify_back ->
+          : notify_back:notify_back -> TextDocumentIdentifier.t -> unit IO.t
-      TextDocumentIdentifier.t ->
-      unit IO.t
 
-    (** Called when the document changes. *)
+      method virtual on_notif_doc_did_change
-    method virtual on_notif_doc_did_change :
+          : notify_back:notify_back ->
-      notify_back:notify_back ->
             VersionedTextDocumentIdentifier.t ->
             TextDocumentContentChangeEvent.t list ->
             old_content:string ->
             new_content:string ->
             unit IO.t
+      (** Called when the document changes. *)
 
-    (** Override to handle unprocessed notifications *)
+      method on_notification_unhandled ~notify_back:(_ : notify_back)
-    method on_notification_unhandled
+          (_n : Lsp.Client_notification.t) : unit IO.t =
-        ~notify_back:_ (_n:Lsp.Client_notification.t) : unit IO.t =
         IO.return ()
+      (** Override to handle unprocessed notifications *)
 
-    method on_notification
+      method on_notification ~notify_back (n : Lsp.Client_notification.t)
-        ~notify_back (n:Lsp.Client_notification.t) : unit IO.t =
+          : unit IO.t =
         let open Lsp.Types in
-
+        match n with
-      begin match n with
         | Lsp.Client_notification.TextDocumentDidOpen
             { DidOpenTextDocumentParams.textDocument = doc } ->
-          Log.debug (fun k->k "notif: did open '%s'" (DocumentUri.to_path doc.uri));
+          Log.debug (fun k ->
+              k "notif: did open '%s'" (DocumentUri.to_path doc.uri));
           let notify_back =
-            new notify_back ~uri:doc.uri ~version:doc.version ~notify_back () in
+            new notify_back
-          let st = {
+              ~uri:doc.uri ~workDoneToken:None ~partialResultToken:None
-            uri=doc.uri; version=doc.version; content=doc.text;
+              ~version:doc.version ~notify_back ()
+          in
+          let st =
+            {
+              uri = doc.uri;
+              version = doc.version;
+              content = doc.text;
               languageId = doc.languageId;
-          } in
+            }
+          in
           Hashtbl.replace docs doc.uri st;
-          self#on_notif_doc_did_open ~notify_back doc ~content:st.content
+          self#on_notif_doc_did_open
-
+            ~notify_back:(notify_back : notify_back)
+            doc ~content:st.content
         | Lsp.Client_notification.TextDocumentDidClose { textDocument = doc } ->
-          Log.debug (fun k->k "notif: did close '%s'" (DocumentUri.to_path doc.uri));
+          Log.debug (fun k ->
-          let notify_back = new notify_back ~uri:doc.uri ~notify_back () in
+              k "notif: did close '%s'" (DocumentUri.to_path doc.uri));
-          self#on_notif_doc_did_close ~notify_back doc
+          let notify_back =
-
+            new notify_back
-        | Lsp.Client_notification.TextDocumentDidChange {textDocument=doc; contentChanges=c} ->
+              ~workDoneToken:None ~partialResultToken:None ~uri:doc.uri
-          Log.debug (fun k->k "notif: did change '%s'" (DocumentUri.to_path doc.uri));
+              ~notify_back ()
-          let notify_back = new notify_back ~uri:doc.uri ~notify_back () in
+          in
+          self#on_notif_doc_did_close
+            ~notify_back:(notify_back : notify_back)
+            doc
+        | Lsp.Client_notification.TextDocumentDidChange
+            { textDocument = doc; contentChanges = c } ->
+          Log.debug (fun k ->
+              k "notif: did change '%s'" (DocumentUri.to_path doc.uri));
+          let notify_back =
+            new notify_back
+              ~workDoneToken:None ~partialResultToken:None ~uri:doc.uri
+              ~notify_back ()
+          in
 
           let old_doc =
             match Hashtbl.find_opt docs doc.uri with
             | None ->
               (* WTF vscode. Well let's try and deal with it. *)
-              Log.err (fun k->k "unknown document: '%s'" (DocumentUri.to_path doc.uri));
+              Log.err (fun k ->
+                  k "unknown document: '%s'" (DocumentUri.to_path doc.uri));
               let version = doc.version in
 
-              let languageId = "" in (* FIXME*)
+              let languageId = "" in
+              (* FIXME*)
               Lsp.Text_document.make
                 (DidOpenTextDocumentParams.create
-                   ~textDocument:(
+                   ~textDocument:
-                     TextDocumentItem.create ~languageId
+                     (TextDocumentItem.create ~languageId ~uri:doc.uri ~version
-                       ~uri:doc.uri ~version ~text:""))
+                        ~text:""))
             | Some st ->
               Lsp.Text_document.make
                 (DidOpenTextDocumentParams.create
-                     ~textDocument:(
+                   ~textDocument:
-                       TextDocumentItem.create ~languageId:st.languageId
+                     (TextDocumentItem.create ~languageId:st.languageId
                         ~uri:doc.uri ~version:st.version ~text:st.content))
           in
 
@@ -414,18 +523,24 @@ module Make(IO : IO) = struct
               old_doc c
           in
 
-          let new_st : doc_state = {
+          let new_st : doc_state =
-            uri=doc.uri; languageId=Lsp.Text_document.languageId new_doc;
+            {
+              uri = doc.uri;
+              languageId = Lsp.Text_document.languageId new_doc;
               content = Lsp.Text_document.text new_doc;
               version = Lsp.Text_document.version new_doc;
-          } in
+            }
+          in
 
           Hashtbl.replace docs doc.uri new_st;
-          self#on_notif_doc_did_change ~notify_back doc c
+          self#on_notif_doc_did_change
+            ~notify_back:(notify_back : notify_back)
+            doc c
             ~old_content:(Lsp.Text_document.text old_doc)
             ~new_content:new_st.content
-
+        | Lsp.Client_notification.Exit ->
-        | Lsp.Client_notification.Exit -> _quit <- true; IO.return ()
+          _quit <- true;
+          IO.return ()
         | Lsp.Client_notification.DidSaveTextDocument _
         | Lsp.Client_notification.WillSaveTextDocument _
         | Lsp.Client_notification.ChangeWorkspaceFolders _
@@ -435,9 +550,17 @@ module Make(IO : IO) = struct
         | Lsp.Client_notification.CancelRequest _
         | Lsp.Client_notification.WorkDoneProgressCancel _
         | Lsp.Client_notification.SetTrace _
-          ->
+        | Lsp.Client_notification.DidChangeWatchedFiles _
-          let notify_back = new notify_back ~notify_back () in
+        | Lsp.Client_notification.DidCreateFiles _
-          self#on_notification_unhandled ~notify_back n
+        | Lsp.Client_notification.DidDeleteFiles _
-      end
+        | Lsp.Client_notification.DidRenameFiles _
+        | Lsp.Client_notification.LogTrace _ ->
+          let notify_back =
+            new notify_back
+              ~workDoneToken:None ~partialResultToken:None ~notify_back ()
+          in
+          self#on_notification_unhandled
+            ~notify_back:(notify_back : notify_back)
+            n
     end
 end

src/sigs.ml

@@ -1,12 +1,9 @@
-
-
 (** {2 Parametrized IO Interface} *)
 module type IO = sig
   type 'a t
 
   val return : 'a -> 'a t
   val failwith : string -> 'a t
-
   val ( let+ ) : 'a t -> ('a -> 'b) -> 'b t
   val ( let* ) : 'a t -> ('a -> 'b t) -> 'b t
   val ( and+ ) : 'a t -> 'b t -> ('a * 'b) t
@@ -16,10 +13,8 @@ module type IO = sig
 
   val stdin : in_channel
   val stdout : out_channel
-
   val read : in_channel -> bytes -> int -> int -> unit t
   val read_line : in_channel -> string t
-
   val write : out_channel -> bytes -> int -> int -> unit t
   val write_string : out_channel -> string -> unit t