diff options
author | Sébastien Dailly <sebastien@dailly.me> | 2022-02-07 15:38:37 +0100 |
---|---|---|
committer | Sébastien Dailly <sebastien@dailly.me> | 2022-02-07 16:01:12 +0100 |
commit | 77544bdfad2af41514ec1435f706fee87ea2969e (patch) | |
tree | 4de23870e08711da25ff92e9670370fc0a74e459 /viz.js/promise/promise.ml | |
parent | ad526111f0dd619ae9e0e98ef2253146b58a068f (diff) |
Added viz.js code
Diffstat (limited to 'viz.js/promise/promise.ml')
-rwxr-xr-x | viz.js/promise/promise.ml | 66 |
1 files changed, 66 insertions, 0 deletions
diff --git a/viz.js/promise/promise.ml b/viz.js/promise/promise.ml new file mode 100755 index 0000000..f9f7e53 --- /dev/null +++ b/viz.js/promise/promise.ml @@ -0,0 +1,66 @@ +open Js_of_ocaml + +type ('a, 'b) promise + +type 'a resolve = 'a -> unit + +type 'a reject = 'a -> unit + +let promise_global = Js.Unsafe.global##._Promise + +let is_supported () = Js.Optdef.test promise_global + +let make f = + Js.Unsafe.new_obj promise_global [|Js.Unsafe.inject f|] + +let resolve value = + Js.Unsafe.fun_call promise_global##.resolve [|Js.Unsafe.inject value|] + +let reject value = + Js.Unsafe.fun_call promise_global##.reject [|Js.Unsafe.inject value|] + +let js_of_opt = function + | Some value -> Js.Unsafe.inject value + | None -> Js.Unsafe.inject Js.undefined + +let then_bind ~on_fulfilled ?on_rejected promise = + Js.Unsafe.meth_call promise "then" + [|Js.Unsafe.inject on_fulfilled; js_of_opt on_rejected|] + +let then_map ~on_fulfilled ?on_rejected promise = + Js.Unsafe.meth_call promise "then" + [|Js.Unsafe.inject on_fulfilled; js_of_opt on_rejected|] + +let catch_bind ~on_rejected promise = + Js.Unsafe.meth_call promise "catch" [|Js.Unsafe.inject on_rejected|] + +let catch_map ~on_rejected promise = + Js.Unsafe.meth_call promise "catch" [|Js.Unsafe.inject on_rejected|] + +let then_final ~on_fulfilled ~on_rejected promise = + Js.Unsafe.meth_call promise "then" + [|Js.Unsafe.inject on_fulfilled; Js.Unsafe.inject on_rejected|] + +let all promises = + let intermediate_promise = + Js.Unsafe.fun_call promise_global##.all + [|Js.Unsafe.inject (Js.array promises)|] + in + then_map + ~on_fulfilled:(fun js_array -> Js.to_array js_array) intermediate_promise + +let race promises = + Js.Unsafe.fun_call promise_global##.race + [|Js.Unsafe.inject (Js.array promises)|] + +module Infix = struct + let (>>=) promise on_fulfilled = then_bind ~on_fulfilled promise + let (>|=) promise on_fulfilled = then_map ~on_fulfilled promise + + let (>>~) promise on_rejected = catch_bind ~on_rejected promise + let (>|~) promise on_rejected = catch_map ~on_rejected promise + + let (>||) promise (on_fulfilled, on_rejected) = + then_final ~on_fulfilled ~on_rejected promise +end + |