Js_of_ocaml equiv of Brr.Fut.t?

Learning
1

Is there an Js_of_ocaml equiv of Brr.Fut.t ?

I have found Promise (promise_jsoo.Promise) and async_js/example.ml at master · janestreet/async_js · GitHub
but its not clear to me which way to go.

Taking a step back, I just want to write async style code in OCaml, with some ppx syntax for let%... =

2

Offtopic comment I’m not entitled to since I’ve never used either of the syntaxes with async features, but OCaml now has a built-in syntax for monadic-style let bindings.

1 Like
3

I think it depends a little on what async things you want to do and what are your constraints. Note, promise_jsoo and Brr.Fut.t both have ‘syntaxes’ for monadic-style let bindings. I think the js_of_ocaml stance is to go with promise_jsoo (at least that’s what I inferred from How to tackle a JavaScript function that returns a JS `Promise`? · Issue #1073 · ocsigen/js_of_ocaml · GitHub) but that’s for wrapping JS promises in a monadic interface, you might still need Async (or Lwt).

Where’s your “async-ness” coming from ? A web API returning a promise (e.g. fetch() global function - Web APIs | MDN), waiting for an event (e.g. websocket receive) or imposed by an OCaml library that is built using Async (or Lwt) ?

1 Like
4

Two sources: 1. Fetch 2. Converting onMessage to a chan.

fetch

This is standard Fetch API. Nothing fancy.

let response_to_txt (r : Brr_io.Fetch.Response.t) : Jstr.t Fut.t =
  let open Fut.Syntax in
  let* txt = Brr_io.Fetch.Body.text @@ Brr_io.Fetch.Response.as_body r in
  Fut.return @@ ok_or_throw txt "response_to_txt"

let response_to_ab (r : Brr_io.Fetch.Response.t) : Brr.Tarray.Buffer.t Fut.t =
  let open Fut.Syntax in
  let* blob = Brr_io.Fetch.Body.blob @@ Brr_io.Fetch.Response.as_body r in
  let blob = ok_or_throw blob "response_to_ab (to blob step)" in
  let* ab = Brr.Blob.array_buffer blob in
  Fut.return @@ ok_or_throw ab "response_to-ab (to arraybuffer step)"

onMessage → chan

The “onMessage” handler has inversion of control / we need to write a state machine. Instead, we build a chan primitive, where onMessagre pushes into the chan (queue) and some other process takes items off the queue in normal code.

To do this, we have a queue of “values” and a queue of “promises” (code waiting for a value) and match them up. This allows us to write code that deals with onMessage handler in an 'async style"

open B_brr
open Core

type 'a inner = Empty | Fns of ('a -> unit) * ('a -> unit) Queue.t | Elems of 'a * 'a Queue.t
type 'a t = 'a inner ref

let create () : 'a t = ref @@ Empty

let push_elem (c : 'a t) (e : 'a) =
  match !c with
  | Empty -> c := Elems (e, Queue.create ())
  | Fns (x, qx) ->
      (match Queue.dequeue qx with
      | Some x' -> c := Fns (x', qx)
      | None -> c := Empty);
      x e
  | Elems (_x, qx) -> Queue.enqueue qx e

let push_fn (c : 'a t) (f : 'a -> unit) =
  match !c with
  | Empty -> c := Fns (f, Queue.create ())
  | Fns (_x, qx) -> Queue.enqueue qx f
  | Elems (x, qx) ->
      (match Queue.dequeue qx with
      | Some x' -> c := Elems (x', qx)
      | None -> c := Empty);
      f x

let wait_on (c : 'a t) =
  let p, r = Fut.create () in
  push_fn c r;
  p

let rec drop_until (c : 'a t) (f : 'a -> bool) =
  let open Fut.Syntax in
  let p, r = Fut.create () in
  push_fn c r;
  let* t = p in
  if f t then Fut.return t else drop_until c f

let raw_data_appender (chan : Jv.t t) (ev : Brr_io.Message.Ev.t Brr.Ev.t) =
  let t : Brr_io.Message.Ev.t = Brr.Ev.as_type ev in
  let data : Jv.t = Brr_io.Message.Ev.data t in
  push_elem chan data

let data_appender (chan : 'a t) ~(f : Jv.t -> 'a) (ev : Brr_io.Message.Ev.t Brr.Ev.t) =
  let t : Brr_io.Message.Ev.t = Brr.Ev.as_type ev in
  let data : Jv.t = Brr_io.Message.Ev.data t in
  let e : 'a = f data in
  push_elem chan e

let rec loop_forever (chan : 'a t) ~(f : 'a -> unit) =
  let open Fut.Syntax in
  let* x = wait_on chan in
  let _ = f x in
  loop_forever chan ~f

let pipe_to_chan (chan : 'a t) (target : Brr.Ev.target) ~(f : Jv.t -> 'a) =
  Brr.Ev.listen Brr_io.Message.Ev.message (data_appender chan ~f) target

let rec select (chan : 'a t) ~(f : 'a -> 'b option) : 'b Fut.t =
  let open Fut.Syntax in
  let* (msg : 'a) = wait_on chan in
  match f msg with
  | None -> select chan ~f
  | Some v -> Fut.return v

let create_from_port (p : Brr_io.Message.Port.t) ~(f : Jv.t -> 'a) : 'a t =
  let c = create () in
  let _ = pipe_to_chan c Brr_io.Message.(Port.as_target p) ~f in
  let _ = Brr_io.Message.(Port.start p) in

edit

From https://github.com/ocsigen/js_of_ocaml/blob/master/examples/webgl/webgldemo.ml

let http_get url =
  XmlHttpRequest.get url
  >>= fun r ->
  let cod = r.XmlHttpRequest.code in
  let msg = r.XmlHttpRequest.content in
  if cod = 0 || cod = 200 then Lwt.return msg else fst (Lwt.wait ())

the impression I get is to go with Lwt.t ?

5

It is common to use Lwt inside a program compiled with js_of_ocaml. The two projects have shared authors and maintainers for a while, so they have evolved to work well together.

2 Likes