Source file `ezjs_min_lwt.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
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
include Ezjs_min

module Promise = struct
  include Promise

  let ( >>= ) = Lwt.( >>= )
  let ( >|= ) = Lwt.( >|= )

  let return = Lwt.return

  let async = Lwt.async

  let return_unit = Lwt.return_unit

  let (>>=?) v f =
    v >>= function
    | Error _ as err -> Lwt.return err
    | Ok v -> f v

  let (>>|?) v f = v >>=? fun v -> Lwt.return (Ok (f v))


  (* promises *)

  let to_lwt (p : 'a promise t) =
    let waiter, notifier = Lwt.wait () in
    rthen p (Lwt.wakeup notifier);
    waiter

  let to_lwt_opt cb (p : 'a promise t) =
    to_lwt p >>= function
    | Error e -> return (Error e)
    | Ok x -> match cb with
      | None -> Lwt.return_ok None
      | Some cb -> Lwt.return_ok @@ Some (cb x)

  let to_lwt_tr tr (p : 'a promise t) =
    to_lwt p >>|? tr

  let to_lwt_exn (p : 'a promise t) =
    let waiter, notifier = Lwt.wait () in
    jthen p (Lwt.wakeup notifier);
    waiter

  let to_lwt_exn_opt cb (p : 'a promise t) =
    to_lwt_exn p >>= fun x ->
    match cb with None -> return None | Some cb -> return (Some (cb x))

  let to_lwt_exn_tr tr (p : 'a promise t) =
    to_lwt_exn p >|= tr

  (* callbacks *)

  let to_lwt_cb0 f =
    let waiter, notifier = Lwt.wait () in
    f (Lwt.wakeup notifier) ;
    waiter

  let to_lwt_cb f =
    let waiter, notifier = Lwt.wait () in
    f (wrap_callback (Lwt.wakeup notifier)) ;
    waiter

  let to_lwt_cb_tr tr f =
    let waiter, notifier = Lwt.wait () in
    f (wrap_callback (fun x -> Lwt.wakeup notifier (tr x))) ;
    waiter

  let to_lwt_cb_opt callback f =
    match callback with
    | Some callback ->
      let waiter, notifier = Lwt.wait () in
      f (def (wrap_callback (Lwt.wakeup notifier))) ;
      waiter >>= fun x -> return (Some (callback x))
    | None ->
      f undefined ; Lwt.return_none

  let promise_lwt res =
    let f resolve _reject =
      async (fun () -> res >>= fun value -> resolve value ; return_unit) in
    promise f

  let promise_lwt_res res =
    let f resolve reject =
      async (fun () -> res >>= function
        | Ok value -> resolve value ; return_unit
        | Error reason -> reject reason ; return_unit) in
    promise f
end