PGOCaml with Async backend

PGOCaml_async.ml

open Core.Std
open Async.Std

module type PGOCaml_async_thread =
  PGOCaml_generic.THREAD
  with type 'a t = 'a Deferred.t

module PGOCaml_async_thread : PGOCaml_async_thread = struct
  type 'a t = 'a Deferred.t

  let return = Deferred.return
  let (>>=) = Deferred.(>>=)

  let fail = raise

  let catch f handler =
    Monitor.try_with ~run:`Now ~rest:`Raise f
    >>= function
    | Ok x    -> return x
    | Error e -> handler e

  type in_channel = Reader.t
  type out_channel = Writer.t

  let open_connection sockaddr =
    begin match sockaddr with
      | Core.Std.Unix.ADDR_UNIX s ->
        Socket.connect
          (Socket.create Socket.Type.unix)
          (`Unix s)
        >>| Socket.fd
      | Core.Std.Unix.ADDR_INET (addr, port) ->
        Socket.connect
          (Socket.create Socket.Type.tcp)
          (`Inet (addr, port))
        >>| Socket.fd
    end
    >>= fun fd ->
    return (Reader.create fd, Writer.create fd)

  let output_char w c =
    Writer.write_char w c;
    return ()

  let output_binary_int w n =
    let buf = String.create 4 in
    Binary_packing.pack_signed_32_int ~byte_order:`Big_endian ~buf ~pos:0 n;
    Writer.write w buf;
    return ()

  let output_string w s =
    Writer.write w s;
    return ()

  let flush w =
    Writer.flushed w

  let input_char r =
    Reader.read_char r >>| function
    | `Eof -> raise End_of_file
    | `Ok c -> c

  let input_binary_int r =
    let buf = String.create 4 in
    Reader.really_read r ~len:4 buf >>| function
    | `Eof _ -> raise End_of_file
    | `Ok -> Binary_packing.unpack_signed_32_int ~byte_order:`Big_endian ~buf ~pos:0

  let really_input r buf pos len =
    Reader.really_read r ~pos ~len buf >>| function
    | `Eof _ -> raise End_of_file
    | `Ok    -> ()

  let close_in r =
    Unix.Fd.syscall_exn (Reader.fd r)
      (fun file_descr -> Core.Std.Unix.shutdown file_descr Core.Std.Unix.SHUTDOWN_RECEIVE);
    return ()
end

include PGOCaml_generic.Make (PGOCaml_async_thread)

Hi, did you manage this snippet to work?