package ezjs_min

  1. Overview
  2. Docs

Source file promise_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
90
91
92
93
94
95
96
97
98
99
100
101
102
103
open Js
include Promise

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

let return = Lwt.return

let async = Lwt.async

let return_unit = Lwt.return_unit

(* promises *)

let to_lwt (p : 'a promise t) =
  let waiter, notifier = Lwt.wait () in
  (p##_then (wrap_callback (fun x -> Lwt.wakeup notifier (Ok x))))##catch
    (wrap_callback (fun x -> Lwt.wakeup notifier (Error x)))
  |> ignore ;
  waiter

let to_lwt_opt cb (p : 'a promise t) =
  let waiter, notifier = Lwt.wait () in
  (p##_then (wrap_callback (fun x -> Lwt.wakeup notifier (Ok x))))##catch
    (wrap_callback (fun x -> Lwt.wakeup notifier (Error x)))
  |> ignore ;
  waiter
  >>= function
  | Error e ->
      return (Error e)
  | Ok x -> (
    match cb with
    | None ->
        return (Ok None)
    | Some cb ->
        return (Ok (Some (cb x))) )

let to_lwt_tr tr (p : 'a promise t) =
  let waiter, notifier = Lwt.wait () in
  (p##_then (wrap_callback (fun x -> Lwt.wakeup notifier (Ok x))))##catch
    (wrap_callback (fun x -> Lwt.wakeup notifier (Error x)))
  |> ignore ;
  waiter >>= function Error e -> return (Error e) | Ok x -> return (Ok (tr x))

let to_lwt_exn (p : 'a promise t) =
  let waiter, notifier = Lwt.wait () in
  p##_then (wrap_callback (Lwt.wakeup notifier)) |> ignore ;
  waiter

let to_lwt_exn_opt cb (p : 'a promise t) =
  let waiter, notifier = Lwt.wait () in
  p##_then (wrap_callback (Lwt.wakeup notifier)) |> ignore ;
  waiter
  >>= fun x ->
  match cb with None -> return None | Some cb -> return (Some (cb x))

let to_lwt_exn_tr tr (p : 'a promise t) =
  let waiter, notifier = Lwt.wait () in
  p##_then (wrap_callback (Lwt.wakeup notifier)) |> ignore ;
  waiter >>= fun x -> return (tr x)

(* 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