jon.recoil.org
this repo has no description
1open Js_top_worker_message.Message
2
3(** Re-export Widget_view so user code can write [Widget.View.Element] etc. *)
4module View = Js_top_worker_message.Widget_view
5
6(* --- Send function, injected by worker at startup --- *)
7
8let sender : (string -> unit) ref = ref (fun _ -> ())
9
10let set_sender f = sender := f
11
12let send_msg msg =
13 let json = json_of_worker_msg msg in
14 !sender json
15
16(* --- Handler registry --- *)
17
18type widget_state = {
19 handlers : (string * (string option -> unit)) list;
20}
21
22let widgets : (string, widget_state) Hashtbl.t = Hashtbl.create 16
23
24(* --- Public API --- *)
25
26let display ~id ~handlers view =
27 Hashtbl.replace widgets id { handlers };
28 send_msg (WidgetUpdate { widget_id = id; view })
29
30let update ~id view =
31 send_msg (WidgetUpdate { widget_id = id; view })
32
33let clear ~id =
34 Hashtbl.remove widgets id;
35 send_msg (WidgetClear { widget_id = id })
36
37let display_managed ~id ~kind ~config ~handlers =
38 Hashtbl.replace widgets id { handlers };
39 send_msg (WidgetUpdate { widget_id = id;
40 view = View.Managed { kind; config } })
41
42let update_config ~id config =
43 send_msg (WidgetConfig { widget_id = id; config })
44
45let command ~id cmd data =
46 send_msg (WidgetCommand { widget_id = id; command = cmd; data })
47
48let register_adapter ~kind ~js =
49 send_msg (WidgetRegisterAdapter { kind; js_code = js })
50
51let handle_event ~widget_id ~handler_id ~value =
52 match Hashtbl.find_opt widgets widget_id with
53 | None -> ()
54 | Some state ->
55 match List.assoc_opt handler_id state.handlers with
56 | None -> ()
57 | Some handler -> handler value