jon.recoil.org
this repo has no description
feat: add Widget module for interactive toplevel widgets
Co-Authored-By: Claude Opus 4.6 <noreply@anthropic.com>
+20
js_top_worker-widget.opam
+20
js_top_worker-widget.opam
···
1
+
version: "0.0.1"
2
+
opam-version: "2.0"
3
+
maintainer: "jon@recoil.org"
4
+
authors: "various"
5
+
license: "ISC"
6
+
homepage: "https://github.com/jonludlam/js_top_worker"
7
+
bug-reports: "https://github.com/jonludlam/js_top_worker/issues"
8
+
depends: [
9
+
"ocaml"
10
+
"dune" {>= "2.9.1"}
11
+
"js_top_worker-rpc"
12
+
]
13
+
build : [
14
+
["dune" "subst"] {pinned}
15
+
["dune" "build" "-p" name "-j" jobs]
16
+
]
17
+
synopsis: "Interactive widget support for js_top_worker toplevel"
18
+
description: """
19
+
Widget module for creating interactive HTML widgets from the OCaml toplevel
20
+
"""
+4
widget/dune
+4
widget/dune
+40
widget/widget.ml
+40
widget/widget.ml
···
1
+
open Js_top_worker_message.Message
2
+
3
+
(* --- Send function, injected by worker at startup --- *)
4
+
5
+
let sender : (string -> unit) ref = ref (fun _ -> ())
6
+
7
+
let set_sender f = sender := f
8
+
9
+
let send_msg msg =
10
+
let json = json_of_worker_msg msg in
11
+
!sender json
12
+
13
+
(* --- Handler registry --- *)
14
+
15
+
type widget_state = {
16
+
handlers : (string * (string option -> unit)) list;
17
+
}
18
+
19
+
let widgets : (string, widget_state) Hashtbl.t = Hashtbl.create 16
20
+
21
+
(* --- Public API --- *)
22
+
23
+
let display ~id ~handlers view =
24
+
Hashtbl.replace widgets id { handlers };
25
+
send_msg (WidgetUpdate { widget_id = id; view })
26
+
27
+
let update ~id view =
28
+
send_msg (WidgetUpdate { widget_id = id; view })
29
+
30
+
let clear ~id =
31
+
Hashtbl.remove widgets id;
32
+
send_msg (WidgetClear { widget_id = id })
33
+
34
+
let handle_event ~widget_id ~handler_id ~value =
35
+
match Hashtbl.find_opt widgets widget_id with
36
+
| None -> ()
37
+
| Some state ->
38
+
match List.assoc_opt handler_id state.handlers with
39
+
| None -> ()
40
+
| Some handler -> handler value
+55
widget/widget.mli
+55
widget/widget.mli
···
1
+
(** Interactive widget support for the OCaml toplevel.
2
+
3
+
Widgets are rendered in the client as HTML elements built from
4
+
{!Js_top_worker_message.Widget_view.node} trees. Event handlers in the view
5
+
are symbolic string identifiers — when the user interacts with a widget,
6
+
the client sends the handler ID and input value back to the worker,
7
+
where the registered callback is invoked.
8
+
9
+
Typical usage with Note FRP:
10
+
{[
11
+
let e, send = Note.E.create ()
12
+
let s = Note.S.hold 50 e
13
+
14
+
let () =
15
+
Widget.display ~id:"my-slider"
16
+
~handlers:["x", (fun v ->
17
+
send (int_of_string (Option.get v)))]
18
+
(Js_top_worker_message.Widget_view.Element { tag = "input";
19
+
attrs = [Property ("type", "range")];
20
+
children = [] })
21
+
22
+
(* Wire up automatic updates via Note: *)
23
+
let _logr = Note.S.log
24
+
(Note.S.map (fun v -> ... build view ...) s)
25
+
(Widget.update ~id:"my-slider")
26
+
]} *)
27
+
28
+
val display :
29
+
id:string ->
30
+
handlers:(string * (string option -> unit)) list ->
31
+
Js_top_worker_message.Widget_view.node ->
32
+
unit
33
+
(** [display ~id ~handlers view] registers a widget with the given [id],
34
+
installs [handlers] for routing incoming events, and sends the
35
+
initial [view] to the client. If a widget with this [id] already
36
+
exists, it is replaced. *)
37
+
38
+
val update : id:string -> Js_top_worker_message.Widget_view.node -> unit
39
+
(** [update ~id view] sends an updated view for an existing widget.
40
+
The handler map is not changed. *)
41
+
42
+
val clear : id:string -> unit
43
+
(** [clear ~id] removes the widget and its handlers. Sends a
44
+
WidgetClear message to the client. *)
45
+
46
+
val handle_event :
47
+
widget_id:string -> handler_id:string -> value:string option -> unit
48
+
(** [handle_event ~widget_id ~handler_id ~value] routes an incoming
49
+
event to the registered handler. Called by the worker message loop
50
+
when a WidgetEvent is received. *)
51
+
52
+
val set_sender : (string -> unit) -> unit
53
+
(** [set_sender f] installs the function used to send JSON strings to
54
+
the client. Called once by the worker at startup. The function [f]
55
+
should call [Worker.post_message]. *)