hphp/hack/src/utils/marshal_tools/marshal_tools_lwt.ml

   1 (**
   2  * Copyright (c) 2017, Facebook, Inc.
   3  * All rights reserved.
   4  *
   5  * This source code is licensed under the MIT license found in the
   6  * LICENSE file in the "hack" directory of this source tree.
   7  *
   8  *)
   9
  10 module Marshal_tools_lwt = Marshal_tools.MarshalToolsFunctor (struct
  11   type 'a result = 'a Lwt.t
  12   type fd = Lwt_unix.file_descr
  13
  14   let return = Lwt.return
  15   let fail = Lwt.fail
  16   let (>>=) = Lwt.(>>=)
  17
  18   let write ?timeout fd ~buffer ~offset ~size =
  19     if timeout <> None
  20     then raise (Invalid_argument "Use Lwt timeouts directly");
  21     Lwt_unix.wait_write fd
  22     >>= (fun () -> Lwt_unix.write fd buffer offset size)
  23
  24   let read ?timeout fd ~buffer ~offset ~size =
  25     if timeout <> None
  26     then raise (Invalid_argument "Use lwt timeouts directly");
  27     Lwt_unix.wait_read fd
  28     >>= (fun () -> Lwt_unix.read fd buffer offset size)
  29
  30   let log str = Lwt_log_core.ign_error str
  31 end)
  32
  33 include Marshal_tools_lwt
  34
  35 (* The Timeout module probably doesn't work terribly well with Lwt. Luckily, timeouts are super easy
  36  * to write in Lwt, so we don't **really** need them *)
  37 let to_fd_with_preamble ?flags fd obj = to_fd_with_preamble ?flags fd obj
  38 let from_fd_with_preamble fd = from_fd_with_preamble fd