Source file lwt_promise.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
open Js_of_ocaml
open Promise

let to_lwt (p : 'a Promise.t Js.t) : 'a Lwt.t =
  let r, w = Lwt.task () in
  ignore
    ((Js.Unsafe.coerce p)##_then
       (Js.wrap_callback (fun v -> Lwt.wakeup w v))
       (Js.wrap_callback (fun e ->
            Lwt.wakeup_exn
              w
              (try raise e with
              | e -> e)))
      : unit);
  r
;;

let of_lwt (p : unit -> 'a Lwt.t) : 'a Promise.t Js.t =
  new%js _Promise
    (Js.wrap_callback (fun resolve reject ->
         Lwt.try_bind
           p
           (fun v -> Js.Unsafe.fun_call resolve [| Js.Unsafe.inject v |])
           (fun e -> Js.Unsafe.fun_call reject [| Js.Unsafe.inject e |])))
;;