From a0d2a16ca89ed9bc32e4f4db6d5cc4b2bff30a8c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= <thevoodoos@gmail.com>
Date: Wed, 23 Oct 2024 20:09:54 +0200
Subject: [PATCH] bindings: handle more events

---
 vendor/brr_lwd_ui/bindings/yjs/awareness.ml   | 14 +++++
 vendor/brr_lwd_ui/bindings/yjs/awareness.mli  |  1 +
 .../bindings/yjs/webrtc_provider.ml           | 53 +++++++++++++++++++
 .../bindings/yjs/webrtc_provider.mli          | 17 ++++++
 4 files changed, 85 insertions(+)

diff --git a/vendor/brr_lwd_ui/bindings/yjs/awareness.ml b/vendor/brr_lwd_ui/bindings/yjs/awareness.ml
index 13e176e..b33486c 100644
--- a/vendor/brr_lwd_ui/bindings/yjs/awareness.ml
+++ b/vendor/brr_lwd_ui/bindings/yjs/awareness.ml
@@ -5,3 +5,17 @@ external to_jv : t -> Jv.t = "%identity"
 
 let class_awarness = Jv.get (get_awareness_protocol ()) "Awareness"
 let make doc = Jv.new' class_awarness [| Doc.Doc.to_jv doc |]
+
+let set_local_state_field t ~field value =
+  Jv.call t "setLocalStateField" [| Jv.of_string field; value |] |> ignore
+
+let set_user_info t ~name ?color () =
+  let info =
+    Jv.obj
+    @@
+    match color with
+    | Some color ->
+        [| ("name", Jv.of_string name); ("color", Jv.of_string color) |]
+    | None -> [| ("name", Jv.of_string name) |]
+  in
+  set_local_state_field t ~field:"user" info
diff --git a/vendor/brr_lwd_ui/bindings/yjs/awareness.mli b/vendor/brr_lwd_ui/bindings/yjs/awareness.mli
index 4c213ee..1bde921 100644
--- a/vendor/brr_lwd_ui/bindings/yjs/awareness.mli
+++ b/vendor/brr_lwd_ui/bindings/yjs/awareness.mli
@@ -2,3 +2,4 @@ type t
 
 val to_jv : t -> Jv.t
 val make : Doc.Doc.t -> t
+val set_user_info : t -> name:string -> ?color:string -> unit -> unit
diff --git a/vendor/brr_lwd_ui/bindings/yjs/webrtc_provider.ml b/vendor/brr_lwd_ui/bindings/yjs/webrtc_provider.ml
index 099a4d9..cb92e6e 100644
--- a/vendor/brr_lwd_ui/bindings/yjs/webrtc_provider.ml
+++ b/vendor/brr_lwd_ui/bindings/yjs/webrtc_provider.ml
@@ -180,3 +180,56 @@ let make ~room_name ?signaling ?awareness yjs_doc =
   in
   Jv.new' web_rtc_provider
     [| Jv.of_string room_name; Doc.Doc.to_jv yjs_doc; Jv.obj options |]
+
+type status = { connected : bool }
+type synced = { synced : bool }
+
+type peers = {
+  added : string list;
+  removed : string list;
+  webrtc_peers : string list;
+  bc_peers : string list;
+}
+
+type 'a event =
+  | Status : status event
+  | Synced : synced event
+  | Peers : peers event
+
+let on (type a) t (event : a event) ~(f : a -> unit) =
+  match event with
+  | Status ->
+      ignore
+      @@ Jv.call t "on"
+           [|
+             Jv.of_string "status";
+             Jv.callback ~arity:1 (fun status ->
+                 f { connected = Jv.get status "connected" |> Jv.to_bool });
+           |]
+  | Synced ->
+      ignore
+      @@ Jv.call t "on"
+           [|
+             Jv.of_string "synced";
+             Jv.callback ~arity:1 (fun synced ->
+                 f { synced = Jv.get synced "synced" |> Jv.to_bool });
+           |]
+  | Peers ->
+      ignore
+      @@ Jv.call t "on"
+           [|
+             Jv.of_string "peers";
+             Jv.callback ~arity:1 (fun peers ->
+                 let get_array key =
+                   Jv.get peers key |> Jv.to_list Jv.to_string
+                 in
+                 let peers =
+                   {
+                     added = get_array "added";
+                     removed = get_array "removed";
+                     webrtc_peers = get_array "webrtcPeers";
+                     bc_peers = get_array "bcPeers";
+                   }
+                 in
+                 f peers);
+           |]
diff --git a/vendor/brr_lwd_ui/bindings/yjs/webrtc_provider.mli b/vendor/brr_lwd_ui/bindings/yjs/webrtc_provider.mli
index de0286e..ab05f25 100644
--- a/vendor/brr_lwd_ui/bindings/yjs/webrtc_provider.mli
+++ b/vendor/brr_lwd_ui/bindings/yjs/webrtc_provider.mli
@@ -6,3 +6,20 @@ val make :
   ?awareness:Awareness.t ->
   Doc.Doc.t ->
   t
+
+type status = { connected : bool }
+type synced = { synced : bool }
+
+type peers = {
+  added : string list;
+  removed : string list;
+  webrtc_peers : string list;
+  bc_peers : string list;
+}
+
+type 'a event =
+  | Status : status event
+  | Synced : synced event
+  | Peers : peers event
+
+val on : 'a. t -> 'a event -> f:('a -> unit) -> unit