diff options
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/flesh/dune (renamed from lib/dune) | 1 | ||||
| -rw-r--r-- | lib/flesh/flesh.ml (renamed from lib/flesh.ml) | 0 | ||||
| -rw-r--r-- | lib/portal/dune | 6 | ||||
| -rw-r--r-- | lib/portal/portal_ws.ml | 24 |
4 files changed, 30 insertions, 1 deletions
diff --git a/lib/dune b/lib/flesh/dune index af1b3ad..d79e297 100644 --- a/lib/dune +++ b/lib/flesh/dune @@ -1,4 +1,3 @@ (library (public_name flesh) - (name flesh) (libraries lwt)) diff --git a/lib/flesh.ml b/lib/flesh/flesh.ml index 969d285..969d285 100644 --- a/lib/flesh.ml +++ b/lib/flesh/flesh.ml diff --git a/lib/portal/dune b/lib/portal/dune new file mode 100644 index 0000000..47b59ce --- /dev/null +++ b/lib/portal/dune @@ -0,0 +1,6 @@ +(library + (name portal_ws) + (modules portal_ws) + (public_name flesh_websockets) + (libraries lwt js_of_ocaml) + (preprocess (pps js_of_ocaml-ppx))) diff --git a/lib/portal/portal_ws.ml b/lib/portal/portal_ws.ml new file mode 100644 index 0000000..f2c0cf5 --- /dev/null +++ b/lib/portal/portal_ws.ml @@ -0,0 +1,24 @@ +open Lwt.Syntax + +open Js_of_ocaml +let jss = Js.string +let sjs = Js.to_string + +let lwt_ws (url : string) = + (** [lwt_ws url] returns a stream and a push function for the websocket at [url]. + Pushing [None] closes the websocket. + If the websocket is closed server-side, it's up to the caller's to close the push stream. *) + let open Lwt_stream in + let handle ws incoming () = + let+ _ = iter (fun msg -> ws##send (jss msg)) incoming + in (ws##close) + in let stream, message = create () (* websocket -> user *) + and incoming, push = create () (* user -> websocket *) + in let (ws : WebSockets.webSocket Js.t) = new%js WebSockets.webSocket (jss url) + in ws##.onmessage := + Dom.handler (fun x -> Some (sjs x##.data) |> message; Js._false); + ws##.onopen := + Dom.handler (fun _ -> Lwt.async @@ handle ws incoming; Js._false); + ws##.onclose := + Dom.handler (fun _ -> message None; Js._true); + stream, push |