forked from
anil.recoil.org/monopam-myspace
My aggregated monorepo of OCaml code, automaintained
Merge branch 'widget-frp'
# Conflicts:
# x-ocaml/src/jtw_client.cppo.ml
+4724
-18
+11
-12
FEATURE.md
+11
-12
FEATURE.md
···
1
-
# Feature: x-ocaml cell modes
1
+
# Feature: widget/FRP bridge
2
2
3
-
Extend the x-ocaml WebComponent to support exercise, test, hidden, and
4
-
interactive cell modes — enabling assessment-style worksheets and
5
-
step-by-step tutorials.
3
+
Experimental work to enable reactive UI widgets (sliders, plots, mini-apps)
4
+
driven by OCaml code running in the Web Worker. Backend-authoritative
5
+
architecture: Worker owns state, view descriptions flow out via
6
+
postMessage, user events flow back in.
6
7
7
8
## Scope
8
9
9
-
- Exercise cells: editable skeleton code with CodeMirror
10
-
- Test cells: immutable assertions linked to exercises (positional + explicit)
11
-
- Hidden cells: setup code that runs but isn't shown
12
-
- Interactive cells: demo/example code (read-only, visible)
13
-
- Cell dependency ordering and execution within environments
14
-
- Test-to-exercise linking resolution
10
+
- Evaluate Lwd vs Note as the reactivity library
11
+
- Design a serializable view description format (no closures, no JS refs)
12
+
- Implement experiments A–D (counter, richer widgets, TyXML integration)
13
+
- Measure ergonomics, serialization format, latency, bundle size
15
14
16
15
## References
17
16
18
-
- [Design](docs/plans/2026-02-20-ocaml-interactive-tutorials-design.md) — Sections 2, 4
19
-
- [Plan](docs/plans/2026-02-20-ocaml-interactive-tutorials-plan.md) — Stream 2 (tasks 2.1–2.6)
17
+
- [Design](docs/plans/2026-02-20-ocaml-interactive-tutorials-design.md) — Section 5
18
+
- [Plan](docs/plans/2026-02-20-ocaml-interactive-tutorials-plan.md) — Stream 4 (tasks 4.1–4.5)
+607
docs/plans/2026-02-24-widget-frp-experiments-cd-plan.md
+607
docs/plans/2026-02-24-widget-frp-experiments-cd-plan.md
···
1
+
# Widget/FRP Experiments C & D — Implementation Plan
2
+
3
+
> **For Claude:** REQUIRED SUB-SKILL: Use superpowers:executing-plans to implement this plan task-by-task.
4
+
5
+
**Goal:** Build a richer multi-slider widget (Experiment C) and evaluate TyXML functor integration for type-safe HTML construction (Experiment D), both using Note as the FRP library.
6
+
7
+
**Architecture:** Same worker/main-thread split as Experiments A/B. Experiment C extends the renderer to extract input values from DOM events and tests Note's composition with multiple interacting signals. Experiment D implements TyXML's `Xml_sigs.T` over our `View.node` type, giving a typed HTML DSL that produces serializable view trees.
8
+
9
+
**Tech Stack:** OCaml, js_of_ocaml 6.2, Brr 0.0.8, Note 0.0.3, TyXML 4.6.0 (`tyxml.functor`), dune 3.21
10
+
11
+
**Existing code:** `experiments/widget-bridge/` with `lib/view.ml`, `renderer/renderer.ml`, working Note counter in `note_counter/`.
12
+
13
+
---
14
+
15
+
## Task 1: Extend renderer to extract input values
16
+
17
+
The renderer currently sends `value = None` for all events. For
18
+
`<input>`, `<select>`, and `<textarea>` elements, it should extract
19
+
the element's current value and include it in the event message.
20
+
21
+
**Files:**
22
+
- Modify: `experiments/widget-bridge/renderer/renderer.ml`
23
+
24
+
**Step 1: Read the current renderer code**
25
+
26
+
Read `experiments/widget-bridge/renderer/renderer.ml` to understand
27
+
the current event handler wiring (lines 19-28).
28
+
29
+
The key change: when an event fires on an input element, read the
30
+
DOM element's `.value` property and include it in `event_msg.value`.
31
+
32
+
**Step 2: Modify the Handler arm to extract values**
33
+
34
+
Replace the Handler case in the `List.iter` block:
35
+
36
+
```ocaml
37
+
| Handler (event_name, handler_id) ->
38
+
let is_input = match tag with
39
+
| "input" | "select" | "textarea" -> true
40
+
| _ -> false
41
+
in
42
+
ignore @@ Ev.listen
43
+
(Ev.Type.void (Jstr.v event_name))
44
+
(fun _ev ->
45
+
let value =
46
+
if is_input then
47
+
Some (Jstr.to_string (El.prop El.Prop.value el))
48
+
else None
49
+
in
50
+
on_event { View.handler_id; event_type = event_name; value })
51
+
(El.as_target el)
52
+
```
53
+
54
+
Note: `tag` is already bound in the outer `Element` match arm.
55
+
`El.prop El.Prop.value el` reads the DOM `.value` property. Check
56
+
`$(opam var lib)/brr/brr.mli` for `El.Prop.value` — it may be
57
+
`El.Prop.value` or need `Jstr.to_string` wrapping.
58
+
59
+
If `El.Prop.value` doesn't exist, use:
60
+
```ocaml
61
+
Jstr.to_string (Jv.Jstr.get (El.to_jv el) "value")
62
+
```
63
+
64
+
**Step 3: Build**
65
+
66
+
Run: `opam exec -- dune build --root experiments/widget-bridge`
67
+
68
+
Expected: Compiles without errors.
69
+
70
+
**Step 4: Commit**
71
+
72
+
```bash
73
+
git add experiments/widget-bridge/renderer/renderer.ml
74
+
git commit -m "feat: extract input values from DOM events in renderer"
75
+
```
76
+
77
+
---
78
+
79
+
## Task 2: Experiment C — Two-slider widget with Note
80
+
81
+
Two range sliders (X, Y) controlling a computed display (X * Y).
82
+
Tests Note's composition with multiple interacting signals.
83
+
84
+
**Files:**
85
+
- Create: `experiments/widget-bridge/sliders/dune`
86
+
- Create: `experiments/widget-bridge/sliders/worker.ml`
87
+
- Create: `experiments/widget-bridge/sliders/main.ml`
88
+
- Create: `experiments/widget-bridge/html/sliders.html`
89
+
90
+
**Step 1: Create sliders/dune**
91
+
92
+
```ocaml
93
+
(executable
94
+
(name worker)
95
+
(modules worker)
96
+
(modes js)
97
+
(libraries view note js_of_ocaml))
98
+
99
+
(executable
100
+
(name main)
101
+
(modules main)
102
+
(modes js)
103
+
(libraries view renderer brr))
104
+
```
105
+
106
+
**Step 2: Create sliders/worker.ml**
107
+
108
+
```ocaml
109
+
open View
110
+
111
+
(* --- Event sources --- *)
112
+
113
+
let x_input, send_x = Note.E.create ()
114
+
let y_input, send_y = Note.E.create ()
115
+
116
+
(* --- Reactive state --- *)
117
+
118
+
let x = Note.S.hold 50 x_input
119
+
let y = Note.S.hold 50 y_input
120
+
121
+
(* --- View derivation --- *)
122
+
123
+
let slider ~label ~handler_id value =
124
+
Element { tag = "div"; attrs = [Class "slider-row"]; children = [
125
+
Element { tag = "label"; attrs = []; children = [
126
+
Text (Printf.sprintf "%s: %d" label value)
127
+
] };
128
+
Element { tag = "input"; attrs = [
129
+
Property ("type", "range");
130
+
Property ("min", "0");
131
+
Property ("max", "100");
132
+
Property ("value", string_of_int value);
133
+
Handler ("input", handler_id);
134
+
]; children = [] };
135
+
] }
136
+
137
+
let view =
138
+
Note.S.l2 (fun x y ->
139
+
Element { tag = "div"; attrs = [Class "sliders"]; children = [
140
+
slider ~label:"X" ~handler_id:"x" x;
141
+
slider ~label:"Y" ~handler_id:"y" y;
142
+
Element { tag = "div"; attrs = [Class "result"]; children = [
143
+
Text (Printf.sprintf "X × Y = %d" (x * y))
144
+
] };
145
+
] })
146
+
x y
147
+
148
+
(* --- Worker loop --- *)
149
+
150
+
let send_view (v : node) =
151
+
Js_of_ocaml.Worker.post_message (Marshal.to_bytes v [])
152
+
153
+
let () =
154
+
let logr = Note.S.log view send_view in
155
+
Note.Logr.hold logr;
156
+
Js_of_ocaml.Worker.set_onmessage (fun data ->
157
+
let ev : event_msg = Marshal.from_bytes data 0 in
158
+
match ev.handler_id, ev.value with
159
+
| "x", Some v -> (try send_x (int_of_string v) with _ -> ())
160
+
| "y", Some v -> (try send_y (int_of_string v) with _ -> ())
161
+
| _ -> ())
162
+
```
163
+
164
+
**Step 3: Create sliders/main.ml**
165
+
166
+
Copy from `note_counter/main.ml`, changing the worker URL:
167
+
168
+
```ocaml
169
+
module Worker = Brr_webworkers.Worker
170
+
open Brr
171
+
172
+
let () =
173
+
let container =
174
+
match Document.find_el_by_id G.document (Jstr.v "app") with
175
+
| Some el -> el
176
+
| None -> failwith "No #app element found"
177
+
in
178
+
let worker = Worker.create (Jstr.v "../sliders/worker.bc.js") in
179
+
let on_event (ev : View.event_msg) =
180
+
Worker.post worker (Marshal.to_bytes ev [])
181
+
in
182
+
ignore @@ Ev.listen Brr_io.Message.Ev.message
183
+
(fun msg ->
184
+
let msg = Ev.as_type msg in
185
+
let data : bytes = Brr_io.Message.Ev.data msg in
186
+
let view : View.node = Marshal.from_bytes data 0 in
187
+
let t0 = Performance.now_ms G.performance in
188
+
let el = Renderer.render ~on_event view in
189
+
El.set_children container [el];
190
+
let t1 = Performance.now_ms G.performance in
191
+
Console.(log [str "Render:"; (t1 -. t0); str "ms"]))
192
+
(Worker.as_target worker)
193
+
```
194
+
195
+
**Step 4: Create html/sliders.html**
196
+
197
+
```html
198
+
<!DOCTYPE html>
199
+
<html>
200
+
<head>
201
+
<meta charset="utf-8">
202
+
<title>Experiment C: Two Sliders</title>
203
+
<style>
204
+
body { font-family: system-ui, sans-serif; padding: 2rem; }
205
+
.sliders { max-width: 400px; }
206
+
.slider-row { margin-bottom: 1rem; }
207
+
.slider-row label { display: block; margin-bottom: 0.25rem; font-size: 1.1rem; }
208
+
.slider-row input[type="range"] { width: 100%; }
209
+
.result { font-size: 1.5rem; margin-top: 1rem; padding: 0.5rem;
210
+
background: #f0f0f0; border-radius: 4px; text-align: center; }
211
+
</style>
212
+
</head>
213
+
<body>
214
+
<h1>Experiment C: Two Sliders</h1>
215
+
<div id="app">Loading...</div>
216
+
<script src="../sliders/main.bc.js"></script>
217
+
</body>
218
+
</html>
219
+
```
220
+
221
+
**Step 5: Build**
222
+
223
+
Run: `opam exec -- dune build --root experiments/widget-bridge`
224
+
225
+
Expected: Compiles and produces `sliders/worker.bc.js` and
226
+
`sliders/main.bc.js`.
227
+
228
+
**Step 6: Test in browser**
229
+
230
+
Serve: `python3 -m http.server 8765 --directory experiments/widget-bridge/_build/default`
231
+
232
+
Copy HTML: `cp -r experiments/widget-bridge/html experiments/widget-bridge/_build/default/html`
233
+
234
+
Open `http://localhost:8765/html/sliders.html`. Expected:
235
+
- Two range sliders labelled X and Y, both starting at 50
236
+
- A result display showing "X × Y = 2500"
237
+
- Dragging either slider updates the label and result in real-time
238
+
239
+
**Step 7: Commit**
240
+
241
+
```bash
242
+
git add experiments/widget-bridge/sliders/ experiments/widget-bridge/html/sliders.html
243
+
git commit -m "feat: Experiment C — two-slider widget with Note"
244
+
```
245
+
246
+
---
247
+
248
+
## Task 3: Implement TyXML backend over View.node
249
+
250
+
Create a module implementing `Xml_sigs.T` that produces `View.node`
251
+
values. Then use `Svg_f.Make` and `Html_f.Make` to get a type-safe
252
+
HTML DSL.
253
+
254
+
**Files:**
255
+
- Create: `experiments/widget-bridge/tyxml_backend/dune`
256
+
- Create: `experiments/widget-bridge/tyxml_backend/view_xml.ml`
257
+
- Create: `experiments/widget-bridge/tyxml_backend/view_html.ml`
258
+
259
+
**Step 1: Create tyxml_backend/dune**
260
+
261
+
```ocaml
262
+
(library
263
+
(name view_html)
264
+
(libraries view tyxml))
265
+
```
266
+
267
+
Note: `tyxml` (not `tyxml.functor`) — check which library name
268
+
exposes `Html_f`, `Svg_f`, `Xml_sigs`, `Xml_wrap`. If the build
269
+
fails, try `tyxml.functor` instead.
270
+
271
+
**Step 2: Create tyxml_backend/view_xml.ml**
272
+
273
+
This implements `Xml_sigs.T` using `View.node` as the element type.
274
+
275
+
```ocaml
276
+
(** TyXML XML backend producing {!View.node} values. *)
277
+
278
+
include Xml_sigs.T
279
+
with type elt = View.node
280
+
and type attrib = View.attr
281
+
282
+
module W = Xml_wrap.NoWrap
283
+
284
+
type 'a wrap = 'a
285
+
type 'a list_wrap = 'a list
286
+
287
+
(* --- URIs --- *)
288
+
289
+
type uri = string
290
+
let uri_of_string s = s
291
+
let string_of_uri s = s
292
+
293
+
(* --- Attributes --- *)
294
+
295
+
type aname = string
296
+
297
+
(* Event handlers are handler IDs; strip "on" prefix for event name *)
298
+
type event_handler = string
299
+
type mouse_event_handler = string
300
+
type keyboard_event_handler = string
301
+
type touch_event_handler = string
302
+
303
+
type attrib = View.attr
304
+
305
+
let float_attrib name value = View.Property (name, string_of_float value)
306
+
let int_attrib name value = View.Property (name, string_of_int value)
307
+
let string_attrib name value = View.Property (name, value)
308
+
let space_sep_attrib name values = View.Property (name, String.concat " " values)
309
+
let comma_sep_attrib name values = View.Property (name, String.concat "," values)
310
+
311
+
let event_name_of_aname aname =
312
+
(* "onclick" -> "click", "oninput" -> "input", etc. *)
313
+
if String.length aname > 2 && String.sub aname 0 2 = "on"
314
+
then String.sub aname 2 (String.length aname - 2)
315
+
else aname
316
+
317
+
let event_handler_attrib aname handler_id =
318
+
View.Handler (event_name_of_aname aname, handler_id)
319
+
let mouse_event_handler_attrib = event_handler_attrib
320
+
let keyboard_event_handler_attrib = event_handler_attrib
321
+
let touch_event_handler_attrib = event_handler_attrib
322
+
let uri_attrib name value = View.Property (name, value)
323
+
let uris_attrib name values = View.Property (name, String.concat " " values)
324
+
325
+
(* --- Elements --- *)
326
+
327
+
type elt = View.node
328
+
type ename = string
329
+
330
+
let empty () = View.Text ""
331
+
let comment _s = View.Text "" (* Comments not meaningful in view tree *)
332
+
let pcdata s = View.Text s
333
+
let encodedpcdata s = View.Text s
334
+
let entity e = View.Text ("&" ^ e ^ ";")
335
+
336
+
let leaf ?(a = []) name =
337
+
View.Element { tag = name; attrs = a; children = [] }
338
+
339
+
let node ?(a = []) name children =
340
+
View.Element { tag = name; attrs = a; children }
341
+
342
+
let cdata s = View.Text s
343
+
let cdata_script s = View.Text s
344
+
let cdata_style s = View.Text s
345
+
```
346
+
347
+
**IMPORTANT**: This code likely won't compile as-is. The `Xml_sigs.T`
348
+
signature is strict. Read `$(opam var lib)/tyxml/functor/xml_sigs.mli`
349
+
carefully and adjust:
350
+
351
+
- The `include` at the top is pseudocode — you need a proper module
352
+
that satisfies the signature. Write the module body and let it be
353
+
constrained by usage.
354
+
- Check if `W` needs to be a specific module type
355
+
- Check the exact types of `float_attrib`, `int_attrib` etc. — they
356
+
may take wrapped values (`float wrap` not `float`)
357
+
358
+
Reference: `/home/jons-agent/.opam/default/lib/tyxml/tyxml_xml.ml`
359
+
is the built-in string backend — copy its structure.
360
+
361
+
**Step 3: Create tyxml_backend/view_html.ml**
362
+
363
+
```ocaml
364
+
(** Type-safe HTML DSL producing {!View.node} values.
365
+
366
+
Usage:
367
+
{[
368
+
open View_html
369
+
let my_div = div ~a:[a_class ["counter"]] [
370
+
button ~a:[a_onclick "inc"] [txt "+"];
371
+
span [txt "0"];
372
+
]
373
+
(* my_div : [> `Div ] elt, but underlying type is View.node *)
374
+
]}
375
+
*)
376
+
377
+
module Xml = View_xml
378
+
module Svg = Svg_f.Make(Xml)
379
+
module Html = Html_f.Make(Xml)(Svg)
380
+
include Html
381
+
```
382
+
383
+
**Step 4: Build**
384
+
385
+
Run: `opam exec -- dune build --root experiments/widget-bridge`
386
+
387
+
This will likely need several iterations. Common issues:
388
+
- `Xml_sigs.T` signature mismatches — read the exact signature
389
+
- `Svg_f.Make` may need additional constraints
390
+
- `Html_f.Make` may require `Xml` with specific `W.ft` type
391
+
392
+
Fix compilation errors by reading the .mli files and adjusting
393
+
`view_xml.ml`. The built-in `tyxml_xml.ml` at
394
+
`$(opam var lib)/tyxml/tyxml_xml.ml` is the authoritative reference.
395
+
396
+
**Step 5: Commit**
397
+
398
+
```bash
399
+
git add experiments/widget-bridge/tyxml_backend/
400
+
git commit -m "feat: TyXML backend producing View.node values"
401
+
```
402
+
403
+
---
404
+
405
+
## Task 4: Experiment D — Rewrite sliders with TyXML HTML DSL
406
+
407
+
Use the TyXML-based HTML DSL from Task 3 to build the same two-slider
408
+
widget. Compare ergonomics with the raw `View.node` construction.
409
+
410
+
**Files:**
411
+
- Create: `experiments/widget-bridge/tyxml_sliders/dune`
412
+
- Create: `experiments/widget-bridge/tyxml_sliders/worker.ml`
413
+
- Create: `experiments/widget-bridge/tyxml_sliders/main.ml`
414
+
- Create: `experiments/widget-bridge/html/tyxml_sliders.html`
415
+
416
+
**Step 1: Create tyxml_sliders/dune**
417
+
418
+
```ocaml
419
+
(executable
420
+
(name worker)
421
+
(modules worker)
422
+
(modes js)
423
+
(libraries view view_html note js_of_ocaml))
424
+
425
+
(executable
426
+
(name main)
427
+
(modules main)
428
+
(modes js)
429
+
(libraries view renderer brr))
430
+
```
431
+
432
+
**Step 2: Create tyxml_sliders/worker.ml**
433
+
434
+
```ocaml
435
+
open View
436
+
open View_html
437
+
438
+
(* --- Event sources --- *)
439
+
440
+
let x_input, send_x = Note.E.create ()
441
+
let y_input, send_y = Note.E.create ()
442
+
443
+
(* --- Reactive state --- *)
444
+
445
+
let x = Note.S.hold 50 x_input
446
+
let y = Note.S.hold 50 y_input
447
+
448
+
(* --- View derivation with TyXML DSL --- *)
449
+
450
+
let slider_row ~label_text ~handler_id value =
451
+
div ~a:[a_class ["slider-row"]] [
452
+
label [txt (Printf.sprintf "%s: %d" label_text value)];
453
+
input ~a:[
454
+
a_input_type `Range;
455
+
a_input_min (`Number 0);
456
+
a_input_max (`Number 100);
457
+
a_value (string_of_int value);
458
+
a_oninput handler_id;
459
+
] ();
460
+
]
461
+
|> toelt (* Convert typed elt to View.node *)
462
+
463
+
let view =
464
+
Note.S.l2 (fun x y ->
465
+
Element { tag = "div"; attrs = [Class "sliders"]; children = [
466
+
slider_row ~label_text:"X" ~handler_id:"x" x;
467
+
slider_row ~label_text:"Y" ~handler_id:"y" y;
468
+
toelt (div ~a:[a_class ["result"]] [
469
+
txt (Printf.sprintf "X × Y = %d" (x * y))
470
+
]);
471
+
] })
472
+
x y
473
+
474
+
(* --- Worker loop (identical to Experiment C) --- *)
475
+
476
+
let send_view (v : node) =
477
+
Js_of_ocaml.Worker.post_message (Marshal.to_bytes v [])
478
+
479
+
let () =
480
+
let logr = Note.S.log view send_view in
481
+
Note.Logr.hold logr;
482
+
Js_of_ocaml.Worker.set_onmessage (fun data ->
483
+
let ev : event_msg = Marshal.from_bytes data 0 in
484
+
match ev.handler_id, ev.value with
485
+
| "x", Some v -> (try send_x (int_of_string v) with _ -> ())
486
+
| "y", Some v -> (try send_y (int_of_string v) with _ -> ())
487
+
| _ -> ())
488
+
```
489
+
490
+
**IMPORTANT**: The TyXML attribute names may differ from what's
491
+
shown above. Check the generated `View_html` module for exact
492
+
function names:
493
+
- `a_input_type` may be `a_input_type` or `a_type`
494
+
- `a_input_min` may be `a_min` or take a different argument type
495
+
- `a_value` may take `Jstr.t` or `string` depending on wrapping
496
+
- `a_oninput` takes an `event_handler` (= `string` in our backend)
497
+
- `toelt` converts `'a elt` to `Xml.elt` (= `View.node`)
498
+
499
+
If TyXML attribute functions don't match, read the generated
500
+
module interface or use `View_html.Xml.string_attrib` as fallback.
501
+
502
+
**Step 3: Create tyxml_sliders/main.ml**
503
+
504
+
Copy from `sliders/main.ml`, change worker URL to
505
+
`"../tyxml_sliders/worker.bc.js"`.
506
+
507
+
**Step 4: Create html/tyxml_sliders.html**
508
+
509
+
Copy from `html/sliders.html`, change title to "Experiment D: TyXML
510
+
Sliders" and script src to `"../tyxml_sliders/main.bc.js"`.
511
+
512
+
**Step 5: Build**
513
+
514
+
Run: `opam exec -- dune build --root experiments/widget-bridge`
515
+
516
+
The TyXML DSL may need adjustments — attribute function names,
517
+
argument types, or missing `toelt` calls. Fix iteratively.
518
+
519
+
**Step 6: Test in browser**
520
+
521
+
Same as Experiment C: serve, open page, drag sliders, verify
522
+
the result updates. The behaviour should be identical.
523
+
524
+
**Step 7: Commit**
525
+
526
+
```bash
527
+
git add experiments/widget-bridge/tyxml_sliders/ experiments/widget-bridge/html/tyxml_sliders.html
528
+
git commit -m "feat: Experiment D — TyXML sliders with typed HTML DSL"
529
+
```
530
+
531
+
---
532
+
533
+
## Task 5: Update RESULTS.md
534
+
535
+
**Files:**
536
+
- Modify: `experiments/widget-bridge/RESULTS.md`
537
+
538
+
**Step 1: Measure bundle sizes**
539
+
540
+
```bash
541
+
ls -lh experiments/widget-bridge/_build/default/sliders/worker.bc.js
542
+
ls -lh experiments/widget-bridge/_build/default/tyxml_sliders/worker.bc.js
543
+
```
544
+
545
+
**Step 2: Count lines**
546
+
547
+
```bash
548
+
wc -l experiments/widget-bridge/sliders/worker.ml
549
+
wc -l experiments/widget-bridge/tyxml_sliders/worker.ml
550
+
wc -l experiments/widget-bridge/tyxml_backend/view_xml.ml
551
+
wc -l experiments/widget-bridge/tyxml_backend/view_html.ml
552
+
```
553
+
554
+
**Step 3: Add Experiment C and D sections to RESULTS.md**
555
+
556
+
Append sections covering:
557
+
558
+
- **Experiment C (sliders)**: Does Note composition work well with
559
+
multiple signals? How does `S.l2` feel? Does the input value
560
+
extraction work smoothly?
561
+
562
+
- **Experiment D (TyXML)**: Code comparison — raw vs typed
563
+
constructor ergonomics. Is `toelt` conversion awkward? Does type
564
+
safety catch real mistakes? Is the setup cost (view_xml.ml) worth
565
+
it? Bundle size impact of tyxml?
566
+
567
+
- **Updated recommendation**: Confirm or revise the Note
568
+
recommendation. Add guidance on whether TyXML is worth adopting.
569
+
570
+
**Step 4: Commit**
571
+
572
+
```bash
573
+
git add experiments/widget-bridge/RESULTS.md
574
+
git commit -m "docs: add Experiment C and D results to comparison"
575
+
```
576
+
577
+
---
578
+
579
+
## Troubleshooting
580
+
581
+
### TyXML functor compilation
582
+
583
+
The most likely failure point is Task 3 (view_xml.ml). If
584
+
`Html_f.Make(View_xml)(View_svg)` fails:
585
+
586
+
1. Read the exact error — it will say which type or function is
587
+
missing or has the wrong signature
588
+
2. Check `$(opam var lib)/tyxml/functor/xml_sigs.mli` for the
589
+
exact `T` signature
590
+
3. Check `$(opam var lib)/tyxml/tyxml_xml.ml` for a working
591
+
reference implementation
592
+
4. The `W.ft` type constraint is critical — `Html_f.Make` requires
593
+
`('a, 'b) W.ft = 'a -> 'b`
594
+
595
+
### Range input values
596
+
597
+
The `input` event fires on every slider movement. The renderer
598
+
extracts the value as a string (e.g., "73"). The worker must parse
599
+
it with `int_of_string`. If the value is empty or non-numeric, the
600
+
`try ... with` guard prevents crashes.
601
+
602
+
### Note.S.l2 for combining signals
603
+
604
+
`Note.S.l2 f s1 s2` creates a signal that applies `f` to the current
605
+
values of `s1` and `s2` whenever either changes. This is the key
606
+
composition primitive for Experiment C. If it doesn't exist, try
607
+
`Note.S.map2`.
+174
docs/plans/2026-02-24-widget-frp-experiments-design.md
+174
docs/plans/2026-02-24-widget-frp-experiments-design.md
···
1
+
# Widget/FRP Bridge Experiments — Design
2
+
3
+
*2026-02-24*
4
+
5
+
## Goal
6
+
7
+
Evaluate **Lwd** vs **Note** as the reactivity library for driving
8
+
interactive widgets from an OCaml Web Worker. Produce three
9
+
deliverables: shared scaffolding with serializable view types, a Lwd
10
+
counter, and a Note counter — enough to compare ergonomics,
11
+
serialization, and latency.
12
+
13
+
## Decisions
14
+
15
+
- **Scope**: Tasks 4.1–4.3 from the tutorials plan (scaffolding, Lwd
16
+
counter, Note counter). Tasks 4.4–4.5 deferred.
17
+
- **Project structure**: Standalone dune project in
18
+
`experiments/widget-bridge/`, independent of the monorepo build.
19
+
Integrate the winner later.
20
+
- **Renderer language**: OCaml compiled with js_of_ocaml, using Brr
21
+
for DOM APIs.
22
+
- **Serialization**: JSON via `postMessage`. No CBOR, no custom binary
23
+
format.
24
+
25
+
## Architecture
26
+
27
+
```
28
+
Worker (OCaml) Main Thread (OCaml/Brr)
29
+
┌──────────────────┐ ┌──────────────────────┐
30
+
│ FRP library │ view │ │
31
+
│ (Lwd or Note) │ JSON │ Renderer: │
32
+
│ ↓ │ ───────> │ decode view JSON │
33
+
│ Serializable │ │ reconcile DOM │
34
+
│ view description │ event │ wire event handlers │
35
+
│ ↓ │ JSON │ │
36
+
│ JSON encode │ <─────── │ User interaction │
37
+
└──────────────────┘ └──────────────────────┘
38
+
```
39
+
40
+
Communication uses `postMessage` with simple JSON objects.
41
+
42
+
## Directory Layout
43
+
44
+
```
45
+
experiments/widget-bridge/
46
+
├── dune-project
47
+
├── lib/
48
+
│ ├── view.ml(i) # Serializable view description type
49
+
│ ├── view_json.ml(i) # JSON encoding/decoding
50
+
│ └── event.ml(i) # Event message type
51
+
├── renderer/
52
+
│ └── renderer.ml(i) # Shared DOM renderer (Brr)
53
+
├── lwd_counter/
54
+
│ ├── worker.ml # Lwd counter, compiled to JS worker
55
+
│ └── main.ml # Main-thread entry, compiled to JS
56
+
├── note_counter/
57
+
│ ├── worker.ml # Note counter, compiled to JS worker
58
+
│ └── main.ml # Main-thread entry, compiled to JS
59
+
├── html/
60
+
│ ├── lwd_counter.html
61
+
│ └── note_counter.html
62
+
└── RESULTS.md # Comparison notes
63
+
```
64
+
65
+
## Serializable View Type
66
+
67
+
```ocaml
68
+
type event_id = string
69
+
70
+
type attr =
71
+
| Property of string * string
72
+
| Style of string * string
73
+
| Class of string
74
+
| Handler of string * event_id (* event name, handler id *)
75
+
76
+
type node =
77
+
| Text of string
78
+
| Element of { tag : string; attrs : attr list; children : node list }
79
+
```
80
+
81
+
No closures, no JS references. Event handlers are symbolic identifiers
82
+
resolved by the worker.
83
+
84
+
## Event Message Type
85
+
86
+
```ocaml
87
+
type event_msg = {
88
+
handler_id : event_id;
89
+
event_type : string;
90
+
value : string option; (* for input elements *)
91
+
}
92
+
```
93
+
94
+
## Worker ↔ Main Thread Protocol
95
+
96
+
Worker → main:
97
+
```json
98
+
{ "tag": "render", "view": { ... } }
99
+
```
100
+
101
+
Main → worker:
102
+
```json
103
+
{ "tag": "event", "handler_id": "inc", "event_type": "click", "value": null }
104
+
```
105
+
106
+
## Renderer
107
+
108
+
A shared OCaml module (compiled for the main thread with Brr) that:
109
+
110
+
1. Receives view JSON from the worker, decodes to `node`
111
+
2. Replaces the root DOM element (naive reconciliation — sufficient
112
+
for experiments, optimize later if needed)
113
+
3. Attaches DOM event listeners for `Handler` attrs that post event
114
+
messages back to the worker
115
+
116
+
## Experiment A — Lwd Counter
117
+
118
+
```ocaml
119
+
let count = Lwd.var 0
120
+
121
+
let view =
122
+
Lwd.map (fun n ->
123
+
Element { tag = "div"; attrs = []; children = [
124
+
Element { tag = "button";
125
+
attrs = [Handler ("click", "inc")];
126
+
children = [Text "+"] };
127
+
Element { tag = "span"; attrs = []; children = [
128
+
Text (string_of_int n)
129
+
] };
130
+
] })
131
+
(Lwd.get count)
132
+
```
133
+
134
+
On receiving an "inc" event: `Lwd.set count (Lwd.peek count + 1)`,
135
+
then re-evaluate and send the new view.
136
+
137
+
## Experiment B — Note Counter
138
+
139
+
```ocaml
140
+
let inc_e, send_inc = Note.E.create ()
141
+
let count = Note.S.accum 0 (Note.E.map (fun () n -> n + 1) inc_e)
142
+
143
+
let view =
144
+
Note.S.map (fun n ->
145
+
Element { tag = "div"; attrs = []; children = [
146
+
Element { tag = "button";
147
+
attrs = [Handler ("click", "inc")];
148
+
children = [Text "+"] };
149
+
Element { tag = "span"; attrs = []; children = [
150
+
Text (string_of_int n)
151
+
] };
152
+
] })
153
+
count
154
+
```
155
+
156
+
On receiving an "inc" event: `send_inc ()`. The signal network
157
+
propagates automatically.
158
+
159
+
## Evaluation Criteria
160
+
161
+
For each experiment, record in RESULTS.md:
162
+
163
+
| Criterion | How measured |
164
+
|-----------|-------------|
165
+
| Lines of OCaml (worker) | `wc -l` |
166
+
| Ergonomics | Subjective notes on readability, composability |
167
+
| Serialization | Sample JSON output for the counter view |
168
+
| Round-trip latency | `Performance.now()` around click → DOM update |
169
+
| Bundle size | `ls -lh` on compiled worker.js |
170
+
171
+
## References
172
+
173
+
- [Tutorials design](2026-02-20-ocaml-interactive-tutorials-design.md) — Section 5
174
+
- [Tutorials plan](2026-02-20-ocaml-interactive-tutorials-plan.md) — Stream 4
+664
docs/plans/2026-02-24-widget-frp-experiments-plan.md
+664
docs/plans/2026-02-24-widget-frp-experiments-plan.md
···
1
+
# Widget/FRP Bridge Experiments — Implementation Plan
2
+
3
+
> **For Claude:** REQUIRED SUB-SKILL: Use superpowers:executing-plans to implement this plan task-by-task.
4
+
5
+
**Goal:** Build two self-contained experiments (Lwd counter, Note counter) that evaluate FRP libraries for driving reactive widgets from an OCaml Web Worker, producing a comparison document.
6
+
7
+
**Architecture:** Standalone dune project in `experiments/widget-bridge/`. Worker-side OCaml code uses an FRP library to derive a serializable view description from state. The view is sent to the main thread via `postMessage` (using `Marshal`). The main thread renders the view to DOM using Brr and sends user events back.
8
+
9
+
**Tech Stack:** OCaml, js_of_ocaml 6.2, Brr 0.0.8, Lwd 0.4, Note 0.0.3, dune 3.21
10
+
11
+
---
12
+
13
+
## Task 1: Install dependencies and scaffold project
14
+
15
+
**Files:**
16
+
- Create: `experiments/widget-bridge/dune-project`
17
+
18
+
**Step 1: Install lwd and note**
19
+
20
+
Run: `opam install lwd note`
21
+
22
+
Expected: Both install successfully. lwd 0.4 depends on seq.
23
+
note 0.0.3 has minimal deps (ocaml >= 4.08).
24
+
25
+
**Step 2: Verify installation**
26
+
27
+
Run: `opam list lwd note`
28
+
29
+
Expected: Both show as installed.
30
+
31
+
**Step 3: Create dune-project**
32
+
33
+
Create `experiments/widget-bridge/dune-project`:
34
+
35
+
```ocaml
36
+
(lang dune 3.21)
37
+
(name widget-bridge-experiments)
38
+
```
39
+
40
+
This is a standalone project — no opam file, no monorepo integration.
41
+
42
+
**Step 4: Build to verify the project is recognised**
43
+
44
+
Run: `opam exec -- dune build --root experiments/widget-bridge`
45
+
46
+
Expected: Succeeds (nothing to build yet).
47
+
48
+
**Step 5: Commit**
49
+
50
+
```bash
51
+
git add experiments/widget-bridge/dune-project
52
+
git commit -m "feat: scaffold widget-bridge experiments project"
53
+
```
54
+
55
+
---
56
+
57
+
## Task 2: Implement shared view type library
58
+
59
+
**Files:**
60
+
- Create: `experiments/widget-bridge/lib/dune`
61
+
- Create: `experiments/widget-bridge/lib/view.ml`
62
+
- Create: `experiments/widget-bridge/lib/view.mli`
63
+
64
+
**Step 1: Create lib/dune**
65
+
66
+
```ocaml
67
+
(library
68
+
(name view)
69
+
(libraries))
70
+
```
71
+
72
+
No dependencies — the view type is pure OCaml.
73
+
74
+
**Step 2: Create lib/view.mli**
75
+
76
+
```ocaml
77
+
(** Serializable view descriptions for the widget bridge.
78
+
79
+
No closures, no JS references. Event handlers are symbolic
80
+
identifiers resolved by the worker. *)
81
+
82
+
type event_id = string
83
+
84
+
type attr =
85
+
| Property of string * string
86
+
| Style of string * string
87
+
| Class of string
88
+
| Handler of string * event_id (** event name, handler id *)
89
+
90
+
type node =
91
+
| Text of string
92
+
| Element of { tag : string; attrs : attr list; children : node list }
93
+
94
+
type event_msg = {
95
+
handler_id : event_id;
96
+
event_type : string;
97
+
value : string option;
98
+
}
99
+
100
+
(** Pretty-print a node tree (for evaluation/documentation). *)
101
+
val pp_node : Format.formatter -> node -> unit
102
+
```
103
+
104
+
**Step 3: Create lib/view.ml**
105
+
106
+
```ocaml
107
+
type event_id = string
108
+
109
+
type attr =
110
+
| Property of string * string
111
+
| Style of string * string
112
+
| Class of string
113
+
| Handler of string * event_id
114
+
115
+
type node =
116
+
| Text of string
117
+
| Element of { tag : string; attrs : attr list; children : node list }
118
+
119
+
type event_msg = {
120
+
handler_id : event_id;
121
+
event_type : string;
122
+
value : string option;
123
+
}
124
+
125
+
let pp_attr fmt = function
126
+
| Property (k, v) -> Format.fprintf fmt "%s=%S" k v
127
+
| Style (k, v) -> Format.fprintf fmt "style:%s=%S" k v
128
+
| Class c -> Format.fprintf fmt ".%s" c
129
+
| Handler (ev, id) -> Format.fprintf fmt "on:%s->%s" ev id
130
+
131
+
let rec pp_node fmt = function
132
+
| Text s -> Format.fprintf fmt "%S" s
133
+
| Element { tag; attrs; children } ->
134
+
Format.fprintf fmt "@[<v 2><%s" tag;
135
+
List.iter (fun a -> Format.fprintf fmt " %a" pp_attr a) attrs;
136
+
Format.fprintf fmt ">";
137
+
List.iter (fun c -> Format.fprintf fmt "@,%a" pp_node c) children;
138
+
Format.fprintf fmt "@]@,</%s>" tag
139
+
```
140
+
141
+
**Step 4: Build**
142
+
143
+
Run: `opam exec -- dune build --root experiments/widget-bridge`
144
+
145
+
Expected: Compiles without errors.
146
+
147
+
**Step 5: Commit**
148
+
149
+
```bash
150
+
git add experiments/widget-bridge/lib/
151
+
git commit -m "feat: add shared view type library for widget experiments"
152
+
```
153
+
154
+
---
155
+
156
+
## Task 3: Implement shared renderer
157
+
158
+
The renderer runs on the main thread. It takes a `View.node`, builds
159
+
DOM using Brr, and wires event handlers to call back to the worker.
160
+
161
+
**Files:**
162
+
- Create: `experiments/widget-bridge/renderer/dune`
163
+
- Create: `experiments/widget-bridge/renderer/renderer.ml`
164
+
- Create: `experiments/widget-bridge/renderer/renderer.mli`
165
+
166
+
**Step 1: Create renderer/dune**
167
+
168
+
```ocaml
169
+
(library
170
+
(name renderer)
171
+
(libraries view brr))
172
+
```
173
+
174
+
**Step 2: Create renderer/renderer.mli**
175
+
176
+
```ocaml
177
+
(** Render a {!View.node} tree to DOM and wire event handlers.
178
+
179
+
Each call to {!render} produces a fresh DOM subtree. The caller is
180
+
responsible for replacing the container's children. *)
181
+
182
+
val render : on_event:(View.event_msg -> unit) -> View.node -> Brr.El.t
183
+
```
184
+
185
+
**Step 3: Create renderer/renderer.ml**
186
+
187
+
```ocaml
188
+
open Brr
189
+
190
+
let rec render ~on_event (node : View.node) : El.t =
191
+
match node with
192
+
| Text s ->
193
+
El.txt (Jstr.v s)
194
+
| Element { tag; attrs; children } ->
195
+
let brr_attrs = List.filter_map (fun (a : View.attr) ->
196
+
match a with
197
+
| Property (k, v) -> Some (At.v (Jstr.v k) (Jstr.v v))
198
+
| Style (k, v) -> Some (At.v (Jstr.v "style") (Jstr.v (k ^ ":" ^ v)))
199
+
| Class c -> Some (At.v At.Name.class' (Jstr.v c))
200
+
| Handler _ -> None
201
+
) attrs in
202
+
let el =
203
+
El.v (Jstr.v tag) ~at:brr_attrs
204
+
(List.map (render ~on_event) children)
205
+
in
206
+
List.iter (fun (a : View.attr) ->
207
+
match a with
208
+
| Handler (event_name, handler_id) ->
209
+
let target_el : Ev.target = El.as_target el in
210
+
ignore @@ Ev.listen
211
+
(Ev.Type.void (Jstr.v event_name))
212
+
(fun _ev ->
213
+
on_event { View.handler_id; event_type = event_name; value = None })
214
+
target_el
215
+
| _ -> ()
216
+
) attrs;
217
+
el
218
+
```
219
+
220
+
**Step 4: Build**
221
+
222
+
Run: `opam exec -- dune build --root experiments/widget-bridge`
223
+
224
+
Expected: Compiles. If `Ev.Type.void` doesn't exist, check Brr API
225
+
and adjust — may need `Ev.Type.create (Jstr.v event_name)` instead.
226
+
227
+
**Step 5: Commit**
228
+
229
+
```bash
230
+
git add experiments/widget-bridge/renderer/
231
+
git commit -m "feat: add shared DOM renderer for widget experiments"
232
+
```
233
+
234
+
---
235
+
236
+
## Task 4: Implement Lwd counter (Experiment A)
237
+
238
+
**Files:**
239
+
- Create: `experiments/widget-bridge/lwd_counter/dune`
240
+
- Create: `experiments/widget-bridge/lwd_counter/worker.ml`
241
+
- Create: `experiments/widget-bridge/lwd_counter/main.ml`
242
+
- Create: `experiments/widget-bridge/html/lwd_counter.html`
243
+
244
+
**Step 1: Create lwd_counter/dune**
245
+
246
+
Two separate executables sharing the directory, each with explicit
247
+
module lists:
248
+
249
+
```ocaml
250
+
(executable
251
+
(name worker)
252
+
(modules worker)
253
+
(modes js)
254
+
(libraries view lwd js_of_ocaml))
255
+
256
+
(executable
257
+
(name main)
258
+
(modules main)
259
+
(modes js)
260
+
(libraries view renderer brr))
261
+
```
262
+
263
+
**Step 2: Create lwd_counter/worker.ml**
264
+
265
+
```ocaml
266
+
open View
267
+
268
+
(* --- State --- *)
269
+
270
+
let count = Lwd.var 0
271
+
272
+
(* --- View derivation --- *)
273
+
274
+
let view =
275
+
Lwd.map (fun n ->
276
+
Element { tag = "div"; attrs = [Class "counter"]; children = [
277
+
Element { tag = "button";
278
+
attrs = [Handler ("click", "dec")];
279
+
children = [Text "-"] };
280
+
Element { tag = "span";
281
+
attrs = [Style ("margin", "0 1em")];
282
+
children = [Text (string_of_int n)] };
283
+
Element { tag = "button";
284
+
attrs = [Handler ("click", "inc")];
285
+
children = [Text "+"] };
286
+
] })
287
+
(Lwd.get count)
288
+
289
+
let root = Lwd.observe view
290
+
291
+
(* --- Worker loop --- *)
292
+
293
+
let send_view () =
294
+
let v = Lwd.sample root in
295
+
Js_of_ocaml.Worker.post_message (Marshal.to_bytes (v : node) [])
296
+
297
+
let handle_event (ev : event_msg) =
298
+
(match ev.handler_id with
299
+
| "inc" -> Lwd.set count (Lwd.peek count + 1)
300
+
| "dec" -> Lwd.set count (Lwd.peek count - 1)
301
+
| _ -> ());
302
+
send_view ()
303
+
304
+
let () =
305
+
send_view ();
306
+
Js_of_ocaml.Worker.set_onmessage (fun data ->
307
+
let ev : event_msg = Marshal.from_bytes data 0 in
308
+
handle_event ev)
309
+
```
310
+
311
+
**Step 3: Create lwd_counter/main.ml**
312
+
313
+
```ocaml
314
+
open Brr
315
+
316
+
let () =
317
+
let container =
318
+
match Document.find_el_by_id G.document (Jstr.v "app") with
319
+
| Some el -> el
320
+
| None -> failwith "No #app element found"
321
+
in
322
+
let worker = Brr_webworkers.Worker.create (Jstr.v "worker.js") in
323
+
let on_event (ev : View.event_msg) =
324
+
Brr_webworkers.Worker.post worker
325
+
(Marshal.to_bytes ev [])
326
+
in
327
+
ignore @@ Ev.listen Brr_io.Message.Ev.message
328
+
(fun msg ->
329
+
let data : bytes = Brr_io.Message.Ev.data msg in
330
+
let view : View.node = Marshal.from_bytes data 0 in
331
+
let t0 = Performance.now_ms G.performance in
332
+
let el = Renderer.render ~on_event view in
333
+
El.set_children container [el];
334
+
let t1 = Performance.now_ms G.performance in
335
+
Brr.Console.(log [str "Render:"; float (t1 -. t0); str "ms"]))
336
+
(Brr_webworkers.Worker.as_target worker)
337
+
```
338
+
339
+
**Step 4: Create html/lwd_counter.html**
340
+
341
+
```html
342
+
<!DOCTYPE html>
343
+
<html>
344
+
<head>
345
+
<meta charset="utf-8">
346
+
<title>Experiment A: Lwd Counter</title>
347
+
<style>
348
+
body { font-family: system-ui, sans-serif; padding: 2rem; }
349
+
.counter { display: flex; align-items: center; font-size: 1.5rem; }
350
+
.counter button { font-size: 1.5rem; padding: 0.25em 0.75em; cursor: pointer; }
351
+
</style>
352
+
</head>
353
+
<body>
354
+
<h1>Experiment A: Lwd Counter</h1>
355
+
<div id="app">Loading…</div>
356
+
<script src="../_build/default/experiments/widget-bridge/lwd_counter/main.js"></script>
357
+
</body>
358
+
</html>
359
+
```
360
+
361
+
Note: The `<script>` path assumes serving from the repo root. The
362
+
worker URL `worker.js` in main.ml is relative to the HTML file — this
363
+
will need adjustment. We may need to serve from the `_build` directory
364
+
or copy artifacts.
365
+
366
+
**Step 5: Build**
367
+
368
+
Run: `opam exec -- dune build --root experiments/widget-bridge`
369
+
370
+
Expected: Produces `_build/default/experiments/widget-bridge/lwd_counter/worker.js`
371
+
and `_build/default/experiments/widget-bridge/lwd_counter/main.js`.
372
+
373
+
If build fails, likely causes:
374
+
- `Ev.Type.void` may not exist — try `Ev.Type.create` or check
375
+
`Brr.Ev.Type` API
376
+
- `Marshal` may need `[]` flags or `[Marshal.No_sharing]`
377
+
- `Brr_io.Message.Ev.data` may need type annotation or `Obj.magic`
378
+
coercion if the bytes type doesn't match
379
+
380
+
Fix any compilation errors before proceeding.
381
+
382
+
**Step 6: Create a serve script and test manually**
383
+
384
+
Create a simple HTML file that works with dune's output layout. The
385
+
worker URL needs to be correct relative to where main.js loads.
386
+
387
+
Approach: serve from `_build/default/experiments/widget-bridge/` and
388
+
adjust paths.
389
+
390
+
Update `html/lwd_counter.html` to use correct relative paths, then:
391
+
392
+
Run: `cd _build/default/experiments/widget-bridge && python3 -m http.server 8000`
393
+
394
+
Open `http://localhost:8000/html/lwd_counter.html` in a browser.
395
+
396
+
Expected: Counter displays with + and - buttons. Clicking + increments,
397
+
clicking - decrements. Console shows render timing.
398
+
399
+
**Step 7: Commit**
400
+
401
+
```bash
402
+
git add experiments/widget-bridge/lwd_counter/ experiments/widget-bridge/html/lwd_counter.html
403
+
git commit -m "feat: Experiment A — Lwd counter with worker bridge"
404
+
```
405
+
406
+
---
407
+
408
+
## Task 5: Implement Note counter (Experiment B)
409
+
410
+
**Files:**
411
+
- Create: `experiments/widget-bridge/note_counter/dune`
412
+
- Create: `experiments/widget-bridge/note_counter/worker.ml`
413
+
- Create: `experiments/widget-bridge/note_counter/main.ml`
414
+
- Create: `experiments/widget-bridge/html/note_counter.html`
415
+
416
+
**Step 1: Create note_counter/dune**
417
+
418
+
```ocaml
419
+
(executable
420
+
(name worker)
421
+
(modules worker)
422
+
(modes js)
423
+
(libraries view note js_of_ocaml))
424
+
425
+
(executable
426
+
(name main)
427
+
(modules main)
428
+
(modes js)
429
+
(libraries view renderer brr))
430
+
```
431
+
432
+
**Step 2: Create note_counter/worker.ml**
433
+
434
+
```ocaml
435
+
open View
436
+
437
+
(* --- Event sources --- *)
438
+
439
+
let inc_e, send_inc = Note.E.create ()
440
+
let dec_e, send_dec = Note.E.create ()
441
+
442
+
(* --- Reactive state --- *)
443
+
444
+
let count =
445
+
let delta = Note.E.select [
446
+
Note.E.map (fun () n -> n + 1) inc_e;
447
+
Note.E.map (fun () n -> n - 1) dec_e;
448
+
] in
449
+
Note.S.accum 0 delta
450
+
451
+
(* --- View derivation --- *)
452
+
453
+
let view =
454
+
Note.S.map (fun n ->
455
+
Element { tag = "div"; attrs = [Class "counter"]; children = [
456
+
Element { tag = "button";
457
+
attrs = [Handler ("click", "dec")];
458
+
children = [Text "-"] };
459
+
Element { tag = "span";
460
+
attrs = [Style ("margin", "0 1em")];
461
+
children = [Text (string_of_int n)] };
462
+
Element { tag = "button";
463
+
attrs = [Handler ("click", "inc")];
464
+
children = [Text "+"] };
465
+
] })
466
+
count
467
+
468
+
(* --- Worker loop --- *)
469
+
470
+
let send_view (v : node) =
471
+
Js_of_ocaml.Worker.post_message (Marshal.to_bytes v [])
472
+
473
+
let () =
474
+
(* Observe view signal and send updates *)
475
+
let logr = Note.S.log view send_view in
476
+
Note.Logr.hold logr;
477
+
(* Send initial view *)
478
+
send_view (Note.S.value view);
479
+
(* Handle incoming events *)
480
+
Js_of_ocaml.Worker.set_onmessage (fun data ->
481
+
let ev : event_msg = Marshal.from_bytes data 0 in
482
+
match ev.handler_id with
483
+
| "inc" -> send_inc ()
484
+
| "dec" -> send_dec ()
485
+
| _ -> ())
486
+
```
487
+
488
+
**Step 3: Create note_counter/main.ml**
489
+
490
+
This is identical to the Lwd version — same renderer, same protocol.
491
+
Copy `lwd_counter/main.ml` and change only the worker URL if needed.
492
+
493
+
```ocaml
494
+
open Brr
495
+
496
+
let () =
497
+
let container =
498
+
match Document.find_el_by_id G.document (Jstr.v "app") with
499
+
| Some el -> el
500
+
| None -> failwith "No #app element found"
501
+
in
502
+
let worker = Brr_webworkers.Worker.create (Jstr.v "worker.js") in
503
+
let on_event (ev : View.event_msg) =
504
+
Brr_webworkers.Worker.post worker
505
+
(Marshal.to_bytes ev [])
506
+
in
507
+
ignore @@ Ev.listen Brr_io.Message.Ev.message
508
+
(fun msg ->
509
+
let data : bytes = Brr_io.Message.Ev.data msg in
510
+
let view : View.node = Marshal.from_bytes data 0 in
511
+
let t0 = Performance.now_ms G.performance in
512
+
let el = Renderer.render ~on_event view in
513
+
El.set_children container [el];
514
+
let t1 = Performance.now_ms G.performance in
515
+
Brr.Console.(log [str "Render:"; float (t1 -. t0); str "ms"]))
516
+
(Brr_webworkers.Worker.as_target worker)
517
+
```
518
+
519
+
**Step 4: Create html/note_counter.html**
520
+
521
+
```html
522
+
<!DOCTYPE html>
523
+
<html>
524
+
<head>
525
+
<meta charset="utf-8">
526
+
<title>Experiment B: Note Counter</title>
527
+
<style>
528
+
body { font-family: system-ui, sans-serif; padding: 2rem; }
529
+
.counter { display: flex; align-items: center; font-size: 1.5rem; }
530
+
.counter button { font-size: 1.5rem; padding: 0.25em 0.75em; cursor: pointer; }
531
+
</style>
532
+
</head>
533
+
<body>
534
+
<h1>Experiment B: Note Counter</h1>
535
+
<div id="app">Loading…</div>
536
+
<script src="../note_counter/main.js"></script>
537
+
</body>
538
+
</html>
539
+
```
540
+
541
+
**Step 5: Build**
542
+
543
+
Run: `opam exec -- dune build --root experiments/widget-bridge`
544
+
545
+
Expected: Produces `note_counter/worker.js` and `note_counter/main.js`
546
+
in `_build/default/experiments/widget-bridge/`.
547
+
548
+
**Step 6: Test manually**
549
+
550
+
Serve and test in browser as with Experiment A. Verify same counter
551
+
behaviour.
552
+
553
+
**Step 7: Commit**
554
+
555
+
```bash
556
+
git add experiments/widget-bridge/note_counter/ experiments/widget-bridge/html/note_counter.html
557
+
git commit -m "feat: Experiment B — Note counter with worker bridge"
558
+
```
559
+
560
+
---
561
+
562
+
## Task 6: Evaluate and document results
563
+
564
+
**Files:**
565
+
- Create: `experiments/widget-bridge/RESULTS.md`
566
+
567
+
**Step 1: Measure bundle sizes**
568
+
569
+
Run:
570
+
```bash
571
+
ls -lh _build/default/experiments/widget-bridge/lwd_counter/worker.js
572
+
ls -lh _build/default/experiments/widget-bridge/note_counter/worker.js
573
+
ls -lh _build/default/experiments/widget-bridge/lwd_counter/main.js
574
+
ls -lh _build/default/experiments/widget-bridge/note_counter/main.js
575
+
```
576
+
577
+
**Step 2: Count lines of code**
578
+
579
+
Run:
580
+
```bash
581
+
wc -l experiments/widget-bridge/lwd_counter/worker.ml
582
+
wc -l experiments/widget-bridge/note_counter/worker.ml
583
+
```
584
+
585
+
**Step 3: Capture sample view output**
586
+
587
+
Add a temporary `Printf.eprintf "%s\n" (Format.asprintf "%a" View.pp_node v)`
588
+
to each worker, or use the pretty-printer in a small test script, to
589
+
capture the view tree for one state. Include in RESULTS.md.
590
+
591
+
**Step 4: Write RESULTS.md**
592
+
593
+
Document all measurements and subjective ergonomics comparison in a
594
+
table following this structure:
595
+
596
+
```markdown
597
+
# Widget/FRP Bridge — Experiment Results
598
+
599
+
## Measurements
600
+
601
+
| Metric | Lwd (Exp A) | Note (Exp B) |
602
+
|--------|-------------|--------------|
603
+
| Worker lines of OCaml | N | N |
604
+
| Worker JS bundle size | N KB | N KB |
605
+
| Main JS bundle size | N KB | N KB |
606
+
| Render latency (median) | N ms | N ms |
607
+
608
+
## Ergonomics
609
+
610
+
### Lwd
611
+
- ...
612
+
613
+
### Note
614
+
- ...
615
+
616
+
## View Description (sample JSON)
617
+
...
618
+
619
+
## Recommendation
620
+
...
621
+
```
622
+
623
+
**Step 5: Commit**
624
+
625
+
```bash
626
+
git add experiments/widget-bridge/RESULTS.md
627
+
git commit -m "docs: add widget/FRP experiment results"
628
+
```
629
+
630
+
---
631
+
632
+
## Troubleshooting
633
+
634
+
### Marshal fails across postMessage
635
+
636
+
If `Marshal.from_bytes` raises on the receiving side, the structured
637
+
clone algorithm may not preserve the bytes correctly. Fix: switch to
638
+
manual JSON encoding using `Jv.obj` (Brr) on the sending side and
639
+
`Jv.get` on the receiving side. This means replacing `Marshal` with
640
+
custom `view_to_jv` / `view_of_jv` functions.
641
+
642
+
### Brr API differences
643
+
644
+
If `Ev.Type.void`, `Performance.now_ms`, or similar don't match,
645
+
check `$(opam var lib)/brr/brr.mli` for exact signatures. The Brr
646
+
API may use `Jstr.t` where we used `string` — wrap with `Jstr.v`.
647
+
648
+
### Worker URL resolution
649
+
650
+
The worker script URL in `Worker.create (Jstr.v "worker.js")` is
651
+
resolved relative to the HTML page. If serving from a different
652
+
directory, adjust the path or use an absolute URL.
653
+
654
+
### Lwd.observe memory
655
+
656
+
Always call `Lwd.release root` when done. For the experiment this
657
+
doesn't matter (the worker runs for the page lifetime), but note it
658
+
for production use.
659
+
660
+
### Note.Logr.hold
661
+
662
+
Note loggers are garbage-collected unless held. Always call
663
+
`Note.Logr.hold` on loggers you want to keep alive. Forgetting this
664
+
causes silent failures where signal updates stop propagating.
+203
docs/plans/2026-02-24-widget-protocol-integration-design.md
+203
docs/plans/2026-02-24-widget-protocol-integration-design.md
···
1
+
# Widget Protocol Integration Design
2
+
3
+
**Goal:** Integrate the widget/FRP bridge from the experiments into
4
+
js_top_worker's existing JSON message protocol, enabling interactive
5
+
widgets in OCaml toplevel output.
6
+
7
+
**Context:** Experiments A–D (on the `widget-frp` branch) validated
8
+
that Note + TyXML + serializable View.node trees work well for
9
+
worker-side widget authoring. This design integrates that into the
10
+
real toplevel.
11
+
12
+
## Architecture
13
+
14
+
User OCaml code running in the toplevel creates Note signals and
15
+
calls `Widget.display` to register a live widget. The Widget module
16
+
attaches a `Note.S.log` to the view signal. Whenever the signal
17
+
changes, the logger serializes the View.node tree to JSON and sends
18
+
a `WidgetUpdate` message through the existing worker→client message
19
+
protocol. User interactions in the frontend produce `WidgetEvent`
20
+
messages that flow back to the worker, where the Widget module
21
+
routes them to the registered handler callbacks. Those callbacks
22
+
fire Note events, which propagate through the signal graph, which
23
+
triggers view updates for all affected widgets automatically.
24
+
25
+
```
26
+
┌─────────────────── Worker ───────────────────┐
27
+
│ │
28
+
│ User code: │
29
+
│ let e, send = Note.E.create () │
30
+
│ let s = Note.S.hold 50 e │
31
+
│ Widget.display ~id:"my-widget" │
32
+
│ ~handlers:["x", fun v -> send ...] │
33
+
│ (Note.S.map view_fn s) │
34
+
│ │
35
+
│ Widget module: │
36
+
│ S.log → serialize View.node → send msg │
37
+
│ receive WidgetEvent → lookup handler → call │
38
+
│ │
39
+
└──────────── JSON over postMessage ────────────┘
40
+
↕
41
+
┌─────────────── Frontend ─────────────────────┐
42
+
│ │
43
+
│ Receive WidgetUpdate → render View.node DOM │
44
+
│ User interaction → send WidgetEvent back │
45
+
│ │
46
+
└───────────────────────────────────────────────┘
47
+
```
48
+
49
+
## Key Design Decisions
50
+
51
+
**Explicit widget IDs.** User code names each widget with a string
52
+
ID: `Widget.display ~id:"my-slider" ...`. The frontend uses this ID
53
+
to identify where to render the widget and where to route events.
54
+
No auto-generated IDs — the user controls naming.
55
+
56
+
**Handler map co-located with display.** `Widget.display` takes both
57
+
a view signal and a handler map:
58
+
`~handlers:["x", (fun v -> send_x ...)]`. This keeps the view
59
+
definition and its event routing together.
60
+
61
+
**Signals span cells, widgets render per-ID.** Note signals are
62
+
OCaml values that persist in the toplevel environment across evals.
63
+
Cell 1 can define a signal, cell 2 can derive from it and display
64
+
a widget. When cell 1's widget fires an event, cell 2's widget
65
+
updates automatically via the signal graph. Widget rendering is
66
+
identified by widget_id, not cell_id.
67
+
68
+
**Generic protocol.** The protocol carries View.node trees and
69
+
string events. No widget-type-specific messages. A slider, a
70
+
button, a data table — all just different View.node trees.
71
+
Convenience functions (e.g., `Widget.slider`) are built on top
72
+
in user-space, not in the protocol.
73
+
74
+
**JSON serialization.** View.node trees are encoded as JSON using
75
+
the same `Js.Unsafe` / `JSON.stringify` pattern as the existing
76
+
protocol, for cross-jsoo-version compatibility.
77
+
78
+
## Protocol Additions
79
+
80
+
### New message types in message.ml
81
+
82
+
**Worker → Client:**
83
+
84
+
```
85
+
WidgetUpdate { widget_id: string; view: <View.node as JSON> }
86
+
WidgetClear { widget_id: string }
87
+
```
88
+
89
+
**Client → Worker:**
90
+
91
+
```
92
+
WidgetEvent { widget_id: string; handler_id: string;
93
+
event_type: string; value: string option }
94
+
```
95
+
96
+
### View.node JSON encoding
97
+
98
+
```json
99
+
{"t":"el","tag":"div","a":[{"t":"cls","v":"counter"}],
100
+
"c":[{"t":"txt","v":"hello"}]}
101
+
```
102
+
103
+
Attribute variants:
104
+
- `{"t":"prop","k":"type","v":"range"}`
105
+
- `{"t":"style","k":"margin","v":"0 1em"}`
106
+
- `{"t":"cls","v":"active"}`
107
+
- `{"t":"handler","ev":"input","id":"x"}`
108
+
109
+
Short keys (`t`, `k`, `v`, `c`, `a`, `ev`, `id`) to minimize
110
+
payload size since these are sent on every signal change.
111
+
112
+
## Components
113
+
114
+
### 1. View types (shared library)
115
+
116
+
Move `View.node`, `View.attr`, `View.event_msg` from
117
+
`experiments/widget-bridge/lib/` into a standalone opam package
118
+
(like `mime_printer`). Zero dependencies. Used by both the Widget
119
+
module (worker-side) and the message protocol.
120
+
121
+
### 2. JSON encoding (in message.ml)
122
+
123
+
Add `json_of_view_node`, `view_node_of_json`, `json_of_view_attr`
124
+
functions to `message.ml` alongside the existing JSON helpers.
125
+
These use the same `Js.Unsafe` / `json_of_obj` pattern.
126
+
127
+
### 3. Widget module (toplevel-loadable library)
128
+
129
+
Similar to `mime_printer` — a small library with no heavy
130
+
dependencies that gets loaded into the toplevel. Provides:
131
+
132
+
```ocaml
133
+
module Widget : sig
134
+
val display :
135
+
id:string ->
136
+
handlers:(string * (string option -> unit)) list ->
137
+
View.node Note.S.t ->
138
+
unit
139
+
140
+
val clear : id:string -> unit
141
+
end
142
+
```
143
+
144
+
`display` attaches a `Note.S.log` to the view signal. The logger
145
+
calls a `send` function (injected at init time by the worker) to
146
+
emit WidgetUpdate messages. It also registers the handler map so
147
+
incoming WidgetEvent messages can be routed.
148
+
149
+
`clear` detaches the logger and sends a WidgetClear message.
150
+
151
+
**Dependency consideration:** This module depends on `note` and
152
+
`widget-view`. It does NOT depend on js_of_ocaml or brr — it
153
+
only calls a `send` callback injected by the worker. This keeps
154
+
it portable and avoids polluting the toplevel namespace.
155
+
156
+
### 4. Worker integration (worker.ml)
157
+
158
+
- Handle `WidgetEvent` in `handle_message`: look up widget_id
159
+
in the Widget module's registry, find the handler_id callback,
160
+
call it.
161
+
- Initialize the Widget module's send function at startup so it
162
+
can emit messages.
163
+
164
+
### 5. JS client (ocaml-worker.js)
165
+
166
+
- Add `onWidgetUpdate` callback option (like `onOutputAt`)
167
+
- Add `onWidgetClear` callback option
168
+
- Add `sendWidgetEvent(widgetId, handlerId, eventType, value)`
169
+
method
170
+
- Handle new message types in `_handleMessage`
171
+
172
+
### 6. Frontend renderer
173
+
174
+
A small JS/OCaml module that takes a View.node JSON tree and
175
+
renders it to DOM elements, attaching event listeners that call
176
+
`sendWidgetEvent`. This is essentially the experiment's
177
+
`renderer.ml` adapted to work with the JSON representation.
178
+
179
+
For the prototype, this can be a standalone HTML test page rather
180
+
than full x-ocaml integration.
181
+
182
+
## Prototype Scope
183
+
184
+
The prototype validates the full round-trip: user code creates a
185
+
widget with Note signals → view updates flow to the frontend as
186
+
JSON → frontend renders DOM → user interaction flows back → signal
187
+
graph updates → all affected widgets re-render.
188
+
189
+
**In scope:**
190
+
- View types as shared library
191
+
- View.node JSON encoding in message.ml
192
+
- Widget module with display/clear/handler routing
193
+
- WidgetUpdate/WidgetEvent/WidgetClear message types
194
+
- JS client additions (onWidgetUpdate, sendWidgetEvent)
195
+
- Worker-side event routing
196
+
- Test HTML page with JS renderer
197
+
198
+
**Out of scope (follow-up work):**
199
+
- x-ocaml WebComponent integration
200
+
- TyXML functor backend integration (convenience, not required)
201
+
- Widget convenience library (Widget.slider, Widget.button, etc.)
202
+
- CSS styling / theming
203
+
- Widget persistence / serialization
+839
docs/plans/2026-02-24-widget-protocol-integration-plan.md
+839
docs/plans/2026-02-24-widget-protocol-integration-plan.md
···
1
+
# Widget Protocol Integration — Implementation Plan
2
+
3
+
> **For Claude:** REQUIRED SUB-SKILL: Use superpowers:executing-plans to implement this plan task-by-task.
4
+
5
+
**Goal:** Integrate the widget/FRP bridge into js_top_worker's JSON message protocol so interactive widgets can be created from OCaml toplevel code.
6
+
7
+
**Architecture:** The Widget module (like Mime_printer — small, toplevel-loadable) provides `display`/`update`/`clear` functions that send serialized View.node trees over the existing postMessage JSON protocol. A handler registry routes incoming WidgetEvent messages to user-registered callbacks. The JS client gets new callbacks and methods for widget messages. A test HTML page validates the full round-trip.
8
+
9
+
**Tech Stack:** OCaml, js_of_ocaml, note (FRP), dune, Brr (test renderer)
10
+
11
+
---
12
+
13
+
## Context
14
+
15
+
**Design doc:** `docs/plans/2026-02-24-widget-protocol-integration-design.md`
16
+
17
+
**Key existing files:**
18
+
- `js_top_worker/idl/message.ml` — JSON message protocol (310 lines)
19
+
- `js_top_worker/lib/worker.ml` — Worker message handler (358 lines)
20
+
- `js_top_worker/client/ocaml-worker.js` — JS client (447 lines)
21
+
- `mime_printer/mime_printer.ml` — Pattern for toplevel-loadable module (20 lines)
22
+
23
+
**Key patterns:**
24
+
- JSON built with `Js.Unsafe.obj` / `json_of_obj` helper, stringified with `JSON.stringify`
25
+
- Messages have a `"type"` field for dispatch
26
+
- Worker sends via `Worker.post_message (Js.string json)`
27
+
- Client sends via `worker.postMessage(JSON.stringify(msg))`
28
+
- All JSON uses plain `JSON.parse`/`JSON.stringify` (NOT jsoo's `Json` module) for cross-version compat
29
+
30
+
---
31
+
32
+
### Task 1: Add View types to the message library
33
+
34
+
Add the serializable view types (from experiments) alongside message.ml. These are the types that cross the worker↔client boundary.
35
+
36
+
**Files:**
37
+
- Create: `js_top_worker/idl/widget_view.ml`
38
+
- Modify: `js_top_worker/idl/dune` (add module to `js_top_worker_message` library)
39
+
40
+
**Step 1: Create widget_view.ml**
41
+
42
+
```ocaml
43
+
(** Serializable view descriptions for interactive widgets.
44
+
45
+
No closures, no JS references. Event handlers are symbolic
46
+
string identifiers resolved by the worker's handler registry. *)
47
+
48
+
type event_id = string
49
+
50
+
type attr =
51
+
| Property of string * string
52
+
| Style of string * string
53
+
| Class of string
54
+
| Handler of string * event_id (** event name, handler id *)
55
+
56
+
type node =
57
+
| Text of string
58
+
| Element of { tag : string; attrs : attr list; children : node list }
59
+
60
+
type event_msg = {
61
+
handler_id : event_id;
62
+
event_type : string;
63
+
value : string option;
64
+
}
65
+
```
66
+
67
+
**Step 2: Add module to dune**
68
+
69
+
In `js_top_worker/idl/dune`, change the `js_top_worker_message` library's modules line:
70
+
71
+
```
72
+
(modules message)
73
+
```
74
+
to:
75
+
```
76
+
(modules message widget_view)
77
+
```
78
+
79
+
**Step 3: Verify build**
80
+
81
+
Run: `opam exec -- dune build js_top_worker/idl/`
82
+
Expected: Clean build, no errors.
83
+
84
+
**Step 4: Commit**
85
+
86
+
```bash
87
+
git add js_top_worker/idl/widget_view.ml js_top_worker/idl/dune
88
+
git commit -m "feat: add serializable view types to message library"
89
+
```
90
+
91
+
---
92
+
93
+
### Task 2: Add View.node JSON encoding to message.ml
94
+
95
+
Add functions to serialize/deserialize View.node trees as JSON, using the existing `json_of_obj` / `json_string` / `get_string` helpers.
96
+
97
+
**Files:**
98
+
- Modify: `js_top_worker/idl/message.ml`
99
+
100
+
**Step 1: Add JSON encoding functions after the existing helpers section (~line 141)**
101
+
102
+
Add after `let get_string_array obj key =` block, before `(** {1 Worker message serialization} *)`:
103
+
104
+
```ocaml
105
+
(** {1 View node JSON encoding} *)
106
+
107
+
let rec json_of_view_attr (a : Widget_view.attr) =
108
+
match a with
109
+
| Property (k, v) ->
110
+
json_of_obj [("t", json_string "prop"); ("k", json_string k); ("v", json_string v)]
111
+
| Style (k, v) ->
112
+
json_of_obj [("t", json_string "style"); ("k", json_string k); ("v", json_string v)]
113
+
| Class c ->
114
+
json_of_obj [("t", json_string "cls"); ("v", json_string c)]
115
+
| Handler (ev, id) ->
116
+
json_of_obj [("t", json_string "handler"); ("ev", json_string ev); ("id", json_string id)]
117
+
118
+
and json_of_view_node (n : Widget_view.node) =
119
+
match n with
120
+
| Text s ->
121
+
json_of_obj [("t", json_string "txt"); ("v", json_string s)]
122
+
| Element { tag; attrs; children } ->
123
+
json_of_obj [
124
+
("t", json_string "el");
125
+
("tag", json_string tag);
126
+
("a", json_array (List.map (fun a -> Js.Unsafe.inject (json_of_view_attr a)) attrs));
127
+
("c", json_array (List.map (fun c -> Js.Unsafe.inject (json_of_view_node c)) children));
128
+
]
129
+
130
+
let view_attr_of_json obj : Widget_view.attr =
131
+
let t = get_string obj "t" in
132
+
match t with
133
+
| "prop" -> Property (get_string obj "k", get_string obj "v")
134
+
| "style" -> Style (get_string obj "k", get_string obj "v")
135
+
| "cls" -> Class (get_string obj "v")
136
+
| "handler" -> Handler (get_string obj "ev", get_string obj "id")
137
+
| _ -> failwith ("Unknown attr type: " ^ t)
138
+
139
+
let rec view_node_of_json obj : Widget_view.node =
140
+
let t = get_string obj "t" in
141
+
match t with
142
+
| "txt" -> Text (get_string obj "v")
143
+
| "el" ->
144
+
let attrs = Array.to_list (Array.map view_attr_of_json (get_array obj "a")) in
145
+
let children = Array.to_list (Array.map view_node_of_json (get_array obj "c")) in
146
+
Element { tag = get_string obj "tag"; attrs; children }
147
+
| _ -> failwith ("Unknown node type: " ^ t)
148
+
```
149
+
150
+
**Step 2: Verify build**
151
+
152
+
Run: `opam exec -- dune build js_top_worker/idl/`
153
+
Expected: Clean build.
154
+
155
+
**Step 3: Commit**
156
+
157
+
```bash
158
+
git add js_top_worker/idl/message.ml
159
+
git commit -m "feat: add View.node JSON encoding to message protocol"
160
+
```
161
+
162
+
---
163
+
164
+
### Task 3: Add widget message types to protocol
165
+
166
+
Add WidgetUpdate, WidgetClear (worker→client) and WidgetEvent (client→worker) message variants, with JSON serialization/deserialization.
167
+
168
+
**Files:**
169
+
- Modify: `js_top_worker/idl/message.ml`
170
+
171
+
**Step 1: Add new variants to worker_msg type (~line 93)**
172
+
173
+
Add before the closing of the `worker_msg` type:
174
+
175
+
```ocaml
176
+
| WidgetUpdate of { widget_id : string; view : Widget_view.node }
177
+
| WidgetClear of { widget_id : string }
178
+
```
179
+
180
+
**Step 2: Add new variant to client_msg type (~line 69)**
181
+
182
+
Add before the closing of the `client_msg` type:
183
+
184
+
```ocaml
185
+
| WidgetEvent of { widget_id : string; handler_id : string; event_type : string; value : string option }
186
+
```
187
+
188
+
**Step 3: Add JSON serialization for new worker_msg variants**
189
+
190
+
In `json_of_worker_msg`, add cases before the final `in`:
191
+
192
+
```ocaml
193
+
| WidgetUpdate { widget_id; view } ->
194
+
json_of_obj [
195
+
("type", json_string "widget_update");
196
+
("widget_id", json_string widget_id);
197
+
("view", Js.Unsafe.inject (json_of_view_node view));
198
+
]
199
+
| WidgetClear { widget_id } ->
200
+
json_of_obj [
201
+
("type", json_string "widget_clear");
202
+
("widget_id", json_string widget_id);
203
+
]
204
+
```
205
+
206
+
**Step 4: Add JSON deserialization for WidgetEvent**
207
+
208
+
In `client_msg_of_string`, add a case before the wildcard:
209
+
210
+
```ocaml
211
+
| "widget_event" ->
212
+
WidgetEvent {
213
+
widget_id = get_string obj "widget_id";
214
+
handler_id = get_string obj "handler_id";
215
+
event_type = get_string obj "event_type";
216
+
value = get_string_opt obj "value";
217
+
}
218
+
```
219
+
220
+
**Step 5: Verify build**
221
+
222
+
Run: `opam exec -- dune build js_top_worker/idl/`
223
+
Expected: Warning about non-exhaustive match in worker.ml (new message variants not handled yet). The idl/ library itself should build clean.
224
+
225
+
**Step 6: Commit**
226
+
227
+
```bash
228
+
git add js_top_worker/idl/message.ml
229
+
git commit -m "feat: add WidgetUpdate/WidgetEvent/WidgetClear to message protocol"
230
+
```
231
+
232
+
---
233
+
234
+
### Task 4: Create the Widget module
235
+
236
+
A toplevel-loadable module (like Mime_printer) that provides the user-facing API. Uses a global `send` callback ref that the worker injects at startup.
237
+
238
+
**Files:**
239
+
- Create: `js_top_worker/widget/widget.ml`
240
+
- Create: `js_top_worker/widget/widget.mli`
241
+
- Create: `js_top_worker/widget/dune`
242
+
243
+
**Step 1: Create dune build file**
244
+
245
+
`js_top_worker/widget/dune`:
246
+
```
247
+
(library
248
+
(name widget)
249
+
(public_name js_top_worker-widget)
250
+
(libraries js_top_worker-rpc.message))
251
+
```
252
+
253
+
Note: No dependency on `note` — the Widget module is imperative. Note integration is done in user code via `Note.S.log`.
254
+
255
+
**Step 2: Create widget.mli**
256
+
257
+
```ocaml
258
+
(** Interactive widget support for the OCaml toplevel.
259
+
260
+
Widgets are rendered in the client as HTML elements built from
261
+
{!Widget_view.node} trees. Event handlers in the view are symbolic
262
+
string identifiers — when the user interacts with a widget, the
263
+
client sends the handler ID and input value back to the worker,
264
+
where the registered callback is invoked.
265
+
266
+
Typical usage with Note FRP:
267
+
{[
268
+
let e, send = Note.E.create ()
269
+
let s = Note.S.hold 50 e
270
+
271
+
let () =
272
+
Widget.display ~id:"my-slider"
273
+
~handlers:["x", (fun v ->
274
+
send (int_of_string (Option.get v)))]
275
+
(Widget_view.Element { tag = "input";
276
+
attrs = [Property ("type", "range")];
277
+
children = [] })
278
+
279
+
(* Wire up automatic updates via Note: *)
280
+
let _logr = Note.S.log
281
+
(Note.S.map (fun v -> ... build view ...) s)
282
+
(Widget.update ~id:"my-slider")
283
+
]} *)
284
+
285
+
val display :
286
+
id:string ->
287
+
handlers:(string * (string option -> unit)) list ->
288
+
Widget_view.node ->
289
+
unit
290
+
(** [display ~id ~handlers view] registers a widget with the given [id],
291
+
installs [handlers] for routing incoming events, and sends the
292
+
initial [view] to the client. If a widget with this [id] already
293
+
exists, it is replaced. *)
294
+
295
+
val update : id:string -> Widget_view.node -> unit
296
+
(** [update ~id view] sends an updated view for an existing widget.
297
+
The handler map is not changed. *)
298
+
299
+
val clear : id:string -> unit
300
+
(** [clear ~id] removes the widget and its handlers. Sends a
301
+
WidgetClear message to the client. *)
302
+
303
+
val handle_event :
304
+
widget_id:string -> handler_id:string -> value:string option -> unit
305
+
(** [handle_event ~widget_id ~handler_id ~value] routes an incoming
306
+
event to the registered handler. Called by the worker message loop
307
+
when a WidgetEvent is received. *)
308
+
309
+
val set_sender : (string -> unit) -> unit
310
+
(** [set_sender f] installs the function used to send JSON strings to
311
+
the client. Called once by the worker at startup. The function [f]
312
+
should call [Worker.post_message]. *)
313
+
```
314
+
315
+
**Step 3: Create widget.ml**
316
+
317
+
```ocaml
318
+
open Js_top_worker_message.Message
319
+
320
+
(* --- Send function, injected by worker at startup --- *)
321
+
322
+
let sender : (string -> unit) ref = ref (fun _ -> ())
323
+
324
+
let set_sender f = sender := f
325
+
326
+
let send_msg msg =
327
+
let json = json_of_worker_msg msg in
328
+
!sender json
329
+
330
+
(* --- Handler registry --- *)
331
+
332
+
type widget_state = {
333
+
handlers : (string * (string option -> unit)) list;
334
+
}
335
+
336
+
let widgets : (string, widget_state) Hashtbl.t = Hashtbl.create 16
337
+
338
+
(* --- Public API --- *)
339
+
340
+
let display ~id ~handlers view =
341
+
Hashtbl.replace widgets id { handlers };
342
+
send_msg (WidgetUpdate { widget_id = id; view })
343
+
344
+
let update ~id view =
345
+
send_msg (WidgetUpdate { widget_id = id; view })
346
+
347
+
let clear ~id =
348
+
Hashtbl.remove widgets id;
349
+
send_msg (WidgetClear { widget_id = id })
350
+
351
+
let handle_event ~widget_id ~handler_id ~value =
352
+
match Hashtbl.find_opt widgets widget_id with
353
+
| None -> ()
354
+
| Some state ->
355
+
match List.assoc_opt handler_id state.handlers with
356
+
| None -> ()
357
+
| Some handler -> handler value
358
+
```
359
+
360
+
**Step 4: Verify build**
361
+
362
+
Run: `opam exec -- dune build js_top_worker/widget/`
363
+
Expected: Clean build.
364
+
365
+
**Step 5: Commit**
366
+
367
+
```bash
368
+
git add js_top_worker/widget/
369
+
git commit -m "feat: add Widget module for interactive toplevel widgets"
370
+
```
371
+
372
+
---
373
+
374
+
### Task 5: Wire Widget into the worker
375
+
376
+
Connect the Widget module to the worker's message loop: initialize the sender, handle WidgetEvent messages, and add the widget library as a dependency.
377
+
378
+
**Files:**
379
+
- Modify: `js_top_worker/lib/worker.ml`
380
+
- Modify: `js_top_worker/lib/dune` (add widget dependency to `js_top_worker-web`)
381
+
382
+
**Step 1: Add js_top_worker-widget to js_top_worker-web dependencies**
383
+
384
+
In `js_top_worker/lib/dune`, in the `js_top_worker-web` library stanza, add `js_top_worker-widget` to the libraries list:
385
+
386
+
```
387
+
(libraries
388
+
js_top_worker
389
+
js_top_worker-rpc.message
390
+
js_top_worker-widget
391
+
js_of_ocaml-ppx
392
+
...
393
+
```
394
+
395
+
**Step 2: Initialize Widget sender in worker.ml**
396
+
397
+
In `worker.ml`, in the `run` function, add after the `Logs.set_level` line (~line 343):
398
+
399
+
```ocaml
400
+
(* Initialize Widget module sender *)
401
+
Widget.set_sender (fun json ->
402
+
Jslib.log "Widget sending: %s" json;
403
+
Js_of_ocaml.Worker.post_message (Js_of_ocaml.Js.string json));
404
+
```
405
+
406
+
**Step 3: Handle WidgetEvent in worker.ml**
407
+
408
+
In `handle_message`, add a new case:
409
+
410
+
```ocaml
411
+
| Msg.WidgetEvent { widget_id; handler_id; value; _ } ->
412
+
Widget.handle_event ~widget_id ~handler_id ~value;
413
+
Lwt.return_unit
414
+
```
415
+
416
+
**Step 4: Verify build**
417
+
418
+
Run: `opam exec -- dune build js_top_worker/`
419
+
Expected: Clean build. The worker now handles widget messages.
420
+
421
+
**Step 5: Commit**
422
+
423
+
```bash
424
+
git add js_top_worker/lib/dune js_top_worker/lib/worker.ml
425
+
git commit -m "feat: wire Widget module into worker message loop"
426
+
```
427
+
428
+
---
429
+
430
+
### Task 6: Update JS client
431
+
432
+
Add widget support to ocaml-worker.js: new constructor options for widget callbacks, new method to send widget events, and handling for widget message types.
433
+
434
+
**Files:**
435
+
- Modify: `js_top_worker/client/ocaml-worker.js`
436
+
- Modify: `js_top_worker/client/ocaml-worker.d.ts`
437
+
438
+
**Step 1: Add widget options to constructor**
439
+
440
+
In the constructor (~line 143), after `this.onOutputAt = options.onOutputAt || null;`, add:
441
+
442
+
```javascript
443
+
this.onWidgetUpdate = options.onWidgetUpdate || null;
444
+
this.onWidgetClear = options.onWidgetClear || null;
445
+
```
446
+
447
+
**Step 2: Handle widget messages in _handleMessage**
448
+
449
+
In `_handleMessage`, add cases before the `default:` in the switch:
450
+
451
+
```javascript
452
+
case 'widget_update':
453
+
if (this.onWidgetUpdate) {
454
+
this.onWidgetUpdate(msg);
455
+
}
456
+
break;
457
+
458
+
case 'widget_clear':
459
+
if (this.onWidgetClear) {
460
+
this.onWidgetClear(msg);
461
+
}
462
+
break;
463
+
```
464
+
465
+
**Step 3: Add sendWidgetEvent method**
466
+
467
+
Add after the `destroyEnv` method:
468
+
469
+
```javascript
470
+
/**
471
+
* Send a widget event to the worker.
472
+
* @param {string} widgetId - Widget identifier
473
+
* @param {string} handlerId - Handler identifier within the widget
474
+
* @param {string} eventType - DOM event type (e.g., 'input', 'click')
475
+
* @param {string|null} [value=null] - Input value if applicable
476
+
*/
477
+
sendWidgetEvent(widgetId, handlerId, eventType, value = null) {
478
+
this.worker.postMessage(JSON.stringify({
479
+
type: 'widget_event',
480
+
widget_id: widgetId,
481
+
handler_id: handlerId,
482
+
event_type: eventType,
483
+
value: value,
484
+
}));
485
+
}
486
+
```
487
+
488
+
**Step 4: Update TypeScript definitions**
489
+
490
+
In `ocaml-worker.d.ts`, add to the options interface and class:
491
+
492
+
```typescript
493
+
onWidgetUpdate?: (msg: { widget_id: string; view: any }) => void;
494
+
onWidgetClear?: (msg: { widget_id: string }) => void;
495
+
```
496
+
497
+
And add the method:
498
+
499
+
```typescript
500
+
sendWidgetEvent(widgetId: string, handlerId: string, eventType: string, value?: string | null): void;
501
+
```
502
+
503
+
**Step 5: Verify build (no compilation needed for JS, but check syntax)**
504
+
505
+
Run: `node -c js_top_worker/client/ocaml-worker.js`
506
+
Expected: No syntax errors.
507
+
508
+
**Step 6: Commit**
509
+
510
+
```bash
511
+
git add js_top_worker/client/ocaml-worker.js js_top_worker/client/ocaml-worker.d.ts
512
+
git commit -m "feat: add widget support to JS client library"
513
+
```
514
+
515
+
---
516
+
517
+
### Task 7: Add widget to example worker and create test page
518
+
519
+
Add the Widget library to the example worker's dependencies (so it's available in the toplevel), create a test HTML page that exercises the full round-trip: eval creates a widget with Note signals, frontend renders it, user interaction sends events back, view updates.
520
+
521
+
**Files:**
522
+
- Modify: `js_top_worker/example/dune` (add js_top_worker-widget to worker deps)
523
+
- Create: `js_top_worker/example/widget_test.html`
524
+
525
+
**Step 1: Add widget dependency to example worker**
526
+
527
+
In `js_top_worker/example/dune`, in the worker executable stanza, add `js_top_worker-widget` and `note` to libraries:
528
+
529
+
```
530
+
(libraries js_top_worker-web logs.browser mime_printer tyxml js_top_worker-widget note))
531
+
```
532
+
533
+
Also add `note` to the `jtw opam` rule so it's available as a toplevel package:
534
+
535
+
```
536
+
(run jtw opam -o _opam str stringext mime_printer note)))
537
+
```
538
+
539
+
**Step 2: Create widget_test.html**
540
+
541
+
`js_top_worker/example/widget_test.html`:
542
+
543
+
```html
544
+
<!DOCTYPE html>
545
+
<html>
546
+
<head>
547
+
<meta charset="utf-8">
548
+
<title>Widget Protocol Test</title>
549
+
<style>
550
+
body { font-family: monospace; max-width: 800px; margin: 2em auto; }
551
+
#log { background: #f5f5f5; padding: 1em; white-space: pre-wrap; max-height: 400px; overflow-y: auto; }
552
+
.widget-container { border: 1px solid #ccc; padding: 1em; margin: 1em 0; }
553
+
.widget-container h3 { margin-top: 0; color: #666; }
554
+
button { margin: 0.5em; padding: 0.5em 1em; }
555
+
</style>
556
+
</head>
557
+
<body>
558
+
<h1>Widget Protocol Test</h1>
559
+
<div id="widgets"></div>
560
+
<h2>Log</h2>
561
+
<div id="log"></div>
562
+
563
+
<script type="module">
564
+
import { OcamlWorker } from '../client/ocaml-worker.js';
565
+
566
+
const logEl = document.getElementById('log');
567
+
const widgetsEl = document.getElementById('widgets');
568
+
let worker;
569
+
570
+
function log(msg) {
571
+
logEl.textContent += msg + '\n';
572
+
logEl.scrollTop = logEl.scrollHeight;
573
+
}
574
+
575
+
// --- View.node JSON renderer ---
576
+
function renderNode(node, worker) {
577
+
if (node.t === 'txt') {
578
+
return document.createTextNode(node.v);
579
+
}
580
+
if (node.t === 'el') {
581
+
const el = document.createElement(node.tag);
582
+
583
+
// Attributes
584
+
for (const attr of (node.a || [])) {
585
+
switch (attr.t) {
586
+
case 'prop':
587
+
el.setAttribute(attr.k, attr.v);
588
+
break;
589
+
case 'style':
590
+
el.style[attr.k] = attr.v;
591
+
break;
592
+
case 'cls':
593
+
el.classList.add(attr.v);
594
+
break;
595
+
case 'handler':
596
+
el.addEventListener(attr.ev, (event) => {
597
+
const isInput = ['INPUT', 'SELECT', 'TEXTAREA'].includes(el.tagName);
598
+
const value = isInput ? el.value : null;
599
+
const widgetId = el.closest('[data-widget-id]')?.dataset.widgetId;
600
+
if (widgetId) {
601
+
log(`Event: widget=${widgetId} handler=${attr.id} value=${value}`);
602
+
worker.sendWidgetEvent(widgetId, attr.id, attr.ev, value);
603
+
}
604
+
});
605
+
break;
606
+
}
607
+
}
608
+
609
+
// Children
610
+
for (const child of (node.c || [])) {
611
+
el.appendChild(renderNode(child, worker));
612
+
}
613
+
return el;
614
+
}
615
+
return document.createTextNode('');
616
+
}
617
+
618
+
function renderWidget(widgetId, viewJson) {
619
+
let container = document.getElementById('widget-' + widgetId);
620
+
if (!container) {
621
+
container = document.createElement('div');
622
+
container.id = 'widget-' + widgetId;
623
+
container.className = 'widget-container';
624
+
container.dataset.widgetId = widgetId;
625
+
container.innerHTML = `<h3>${widgetId}</h3>`;
626
+
widgetsEl.appendChild(container);
627
+
}
628
+
// Keep the heading, replace content
629
+
const heading = container.querySelector('h3');
630
+
container.innerHTML = '';
631
+
container.appendChild(heading);
632
+
container.dataset.widgetId = widgetId;
633
+
container.appendChild(renderNode(viewJson, worker));
634
+
}
635
+
636
+
async function run() {
637
+
log('Creating worker...');
638
+
worker = new OcamlWorker('_opam/worker.js', {
639
+
onWidgetUpdate: (msg) => {
640
+
log(`WidgetUpdate: id=${msg.widget_id}`);
641
+
renderWidget(msg.widget_id, msg.view);
642
+
},
643
+
onWidgetClear: (msg) => {
644
+
log(`WidgetClear: id=${msg.widget_id}`);
645
+
const container = document.getElementById('widget-' + msg.widget_id);
646
+
if (container) container.remove();
647
+
},
648
+
onOutputAt: (msg) => {
649
+
if (msg.caml_ppf) log(`OutputAt: ${msg.caml_ppf}`);
650
+
},
651
+
});
652
+
653
+
log('Initializing...');
654
+
await worker.init({
655
+
findlib_requires: [],
656
+
findlib_index: null,
657
+
});
658
+
log('Worker ready.');
659
+
660
+
// Test 1: Static widget (no FRP)
661
+
log('\n--- Test 1: Static widget ---');
662
+
const r1 = await worker.eval(`
663
+
Widget.display ~id:"hello"
664
+
~handlers:[]
665
+
(Widget_view.Element {
666
+
tag = "div"; attrs = [];
667
+
children = [Widget_view.Text "Hello from OCaml!"]
668
+
});;
669
+
`);
670
+
log(`Eval result: ${r1.caml_ppf}`);
671
+
672
+
// Test 2: Interactive counter with Note
673
+
log('\n--- Test 2: Interactive counter ---');
674
+
const r2 = await worker.eval(`
675
+
let inc_e, send_inc = Note.E.create ();;
676
+
let dec_e, send_dec = Note.E.create ();;
677
+
let count =
678
+
let delta = Note.E.select [
679
+
Note.E.map (fun () n -> n + 1) inc_e;
680
+
Note.E.map (fun () n -> n - 1) dec_e;
681
+
] in
682
+
Note.S.accum 0 delta;;
683
+
684
+
let counter_view n =
685
+
let open Widget_view in
686
+
Element { tag = "div"; attrs = [Class "counter"]; children = [
687
+
Element { tag = "button";
688
+
attrs = [Handler ("click", "dec")];
689
+
children = [Text "-"] };
690
+
Element { tag = "span";
691
+
attrs = [Style ("margin", "0 1em")];
692
+
children = [Text (string_of_int n)] };
693
+
Element { tag = "button";
694
+
attrs = [Handler ("click", "inc")];
695
+
children = [Text "+"] };
696
+
] };;
697
+
698
+
Widget.display ~id:"counter"
699
+
~handlers:[
700
+
"inc", (fun _ -> send_inc ());
701
+
"dec", (fun _ -> send_dec ());
702
+
]
703
+
(counter_view 0);;
704
+
705
+
let _logr = Note.S.log
706
+
(Note.S.map counter_view count)
707
+
(Widget.update ~id:"counter");;
708
+
Note.Logr.hold _logr;;
709
+
`);
710
+
log(`Eval result: ${r2.caml_ppf}`);
711
+
712
+
// Test 3: Interactive slider (cross-cell signals)
713
+
log('\n--- Test 3: Slider (cell 1) ---');
714
+
await worker.eval(`
715
+
let x_e, send_x = Note.E.create ();;
716
+
let x = Note.S.hold 50 x_e;;
717
+
718
+
let slider_view v =
719
+
let open Widget_view in
720
+
Element { tag = "div"; attrs = []; children = [
721
+
Element { tag = "label"; attrs = [];
722
+
children = [Text (Printf.sprintf "X: %d" v)] };
723
+
Element { tag = "input"; attrs = [
724
+
Property ("type", "range");
725
+
Property ("min", "0");
726
+
Property ("max", "100");
727
+
Property ("value", string_of_int v);
728
+
Handler ("input", "x");
729
+
]; children = [] };
730
+
] };;
731
+
732
+
Widget.display ~id:"slider"
733
+
~handlers:["x", (fun v ->
734
+
send_x (int_of_string (Option.get v)))]
735
+
(slider_view 50);;
736
+
737
+
let _logr2 = Note.S.log
738
+
(Note.S.map slider_view x)
739
+
(Widget.update ~id:"slider");;
740
+
Note.Logr.hold _logr2;;
741
+
`);
742
+
743
+
log('\n--- Test 3b: Derived widget (cell 2, uses x from cell 1) ---');
744
+
await worker.eval(`
745
+
let doubled_view v =
746
+
let open Widget_view in
747
+
Element { tag = "div"; attrs = []; children = [
748
+
Text (Printf.sprintf "2x = %d" (v * 2))
749
+
] };;
750
+
751
+
Widget.display ~id:"doubled"
752
+
~handlers:[]
753
+
(doubled_view (Note.S.value x));;
754
+
755
+
let _logr3 = Note.S.log
756
+
(Note.S.map doubled_view x)
757
+
(Widget.update ~id:"doubled");;
758
+
Note.Logr.hold _logr3;;
759
+
`);
760
+
761
+
log('\nAll tests dispatched. Interact with widgets above.');
762
+
}
763
+
764
+
run().catch(e => log('Error: ' + e.message));
765
+
</script>
766
+
</body>
767
+
</html>
768
+
```
769
+
770
+
**Step 3: Add widget_test.html to the default alias**
771
+
772
+
In `js_top_worker/example/dune`, add `widget_test.html` to the alias deps list.
773
+
774
+
**Step 4: Build and verify**
775
+
776
+
Run: `opam exec -- dune build js_top_worker/example/`
777
+
Expected: Clean build. The worker now includes Widget and Note modules.
778
+
779
+
**Step 5: Commit**
780
+
781
+
```bash
782
+
git add js_top_worker/example/dune js_top_worker/example/widget_test.html
783
+
git commit -m "feat: add widget test page with counter and slider examples"
784
+
```
785
+
786
+
---
787
+
788
+
### Task 8: Browser test
789
+
790
+
Serve the example directory and test the full round-trip in a browser.
791
+
792
+
**Step 1: Build and serve**
793
+
794
+
```bash
795
+
opam exec -- dune build js_top_worker/example/
796
+
cd _build/default/js_top_worker/example
797
+
python3 -m http.server 8080
798
+
```
799
+
800
+
**Step 2: Open widget_test.html**
801
+
802
+
Navigate to `http://localhost:8080/widget_test.html`.
803
+
804
+
Expected behavior:
805
+
1. Log shows "Worker ready."
806
+
2. "hello" widget appears with "Hello from OCaml!" text
807
+
3. "counter" widget appears with - 0 + buttons
808
+
4. Clicking + increments the counter, clicking - decrements
809
+
5. "slider" widget appears with a range input at 50
810
+
6. "doubled" widget appears with "2x = 100"
811
+
7. Dragging the slider updates both the slider label AND the doubled display
812
+
813
+
**Step 3: Fix any issues found during testing**
814
+
815
+
If events don't route or views don't render, debug by checking the browser console log (the worker logs all messages).
816
+
817
+
**Step 4: Commit any fixes**
818
+
819
+
```bash
820
+
git add -A
821
+
git commit -m "fix: browser test fixes for widget protocol"
822
+
```
823
+
824
+
---
825
+
826
+
## Summary
827
+
828
+
| Task | What | Files |
829
+
|------|------|-------|
830
+
| 1 | View types in message lib | `idl/widget_view.ml`, `idl/dune` |
831
+
| 2 | View.node JSON encoding | `idl/message.ml` |
832
+
| 3 | Widget message types | `idl/message.ml` |
833
+
| 4 | Widget module | `widget/widget.ml`, `widget.mli`, `dune` |
834
+
| 5 | Worker integration | `lib/worker.ml`, `lib/dune` |
835
+
| 6 | JS client updates | `client/ocaml-worker.js`, `.d.ts` |
836
+
| 7 | Test page + worker deps | `example/dune`, `example/widget_test.html` |
837
+
| 8 | Browser test | Manual verification |
838
+
839
+
All paths relative to `js_top_worker/`. Tasks 1–3 are protocol-only (no runtime behavior). Tasks 4–5 add worker-side runtime. Task 6 adds client-side runtime. Tasks 7–8 validate end-to-end.
+332
experiments/widget-bridge/RESULTS.md
+332
experiments/widget-bridge/RESULTS.md
···
1
+
# Widget/FRP Bridge — Experiment Results
2
+
3
+
*2026-02-24*
4
+
5
+
Both experiments implement an identical counter widget (decrement,
6
+
display, increment) with the same architecture: FRP-driven view
7
+
derivation in a Web Worker, serialized via Marshal over postMessage,
8
+
rendered to DOM by a shared Brr renderer on the main thread.
9
+
10
+
## Measurements
11
+
12
+
| Metric | Lwd (Exp A) | Note (Exp B) |
13
+
|--------------------------------|-------------|--------------|
14
+
| Worker lines of OCaml | 42 | 49 |
15
+
| Main lines of OCaml | 24 | 24 |
16
+
| Worker JS bundle (uncompressed)| 2.2 MB | 2.7 MB |
17
+
| Main JS bundle (uncompressed) | 2.7 MB | 2.7 MB |
18
+
| Initial render latency | ~0.5 ms | ~0.6 ms |
19
+
| Update render latency (median) | ~0.2 ms | ~0.3 ms |
20
+
21
+
Shared code: `view.ml` (32 lines), `renderer.ml` (29 lines).
22
+
23
+
Bundle sizes are dominated by js_of_ocaml runtime + stdlib (~2 MB
24
+
baseline). The FRP library contribution is small: Lwd adds ~200 KB,
25
+
Note adds ~700 KB over the base worker.
26
+
27
+
Render latencies are effectively identical — both sub-millisecond for
28
+
this trivial view tree. The bottleneck would be postMessage
29
+
serialization and DOM replacement, not the FRP library.
30
+
31
+
## Ergonomics
32
+
33
+
### Lwd
34
+
35
+
**State model:** Mutable variables (`Lwd.var`) with explicit
36
+
get/set/peek. Feels like working with `ref` cells, but with automatic
37
+
dependency tracking.
38
+
39
+
```ocaml
40
+
let count = Lwd.var 0
41
+
let view =
42
+
Lwd.map (Lwd.get count) ~f:(fun n -> ... view tree ...)
43
+
let root = Lwd.observe view
44
+
45
+
(* Update: explicit set + explicit re-sample *)
46
+
Lwd.set count (Lwd.peek count + 1);
47
+
let v = Lwd.quick_sample root in
48
+
post_message v
49
+
```
50
+
51
+
**Pros:**
52
+
- Familiar imperative style — `set`/`peek` on vars
53
+
- Pull-based: view is only computed when sampled (explicit control)
54
+
- Smaller bundle size
55
+
- Simple mental model for workers: update state, sample, send
56
+
57
+
**Cons:**
58
+
- Must manually trigger re-sampling after state changes
59
+
- `Lwd.map` uses labeled `~f` argument (minor style preference)
60
+
- The `observe`/`quick_sample` ceremony is slightly verbose
61
+
- No built-in mechanism to react to changes — must wire it yourself
62
+
63
+
### Note
64
+
65
+
**State model:** Events (`E`) and signals (`S`) with automatic
66
+
propagation. Classic FRP: define the dataflow graph, then push events
67
+
into it.
68
+
69
+
```ocaml
70
+
let inc_e, send_inc = Note.E.create ()
71
+
let dec_e, send_dec = Note.E.create ()
72
+
let count = Note.S.accum 0 (Note.E.select [
73
+
Note.E.map (fun () n -> n + 1) inc_e;
74
+
Note.E.map (fun () n -> n - 1) dec_e;
75
+
])
76
+
let view = Note.S.map (fun n -> ... view tree ...) count
77
+
78
+
(* Observe: automatic push on signal change *)
79
+
let logr = Note.S.log view send_to_main in
80
+
Note.Logr.hold logr
81
+
82
+
(* Update: just fire the event, propagation is automatic *)
83
+
send_inc ()
84
+
```
85
+
86
+
**Pros:**
87
+
- Push-based: signal changes propagate automatically to the logger
88
+
- No manual re-sampling — the `S.log` callback fires on every change
89
+
- Cleaner separation between event sources and derived state
90
+
- Better fit for the worker model: events come in, views go out
91
+
automatically
92
+
- `E.select` / `E.map` compose naturally for multiple event sources
93
+
94
+
**Cons:**
95
+
- More boilerplate for event source creation (one `E.create` per
96
+
event type)
97
+
- Must remember `Logr.hold` or loggers get GC'd (silent failure)
98
+
- `S.accum` takes `('a -> 'a) event` — must map events to functions
99
+
first, which is slightly indirect
100
+
- 7 more lines of worker code than Lwd
101
+
102
+
## View Description (sample output)
103
+
104
+
Both produce identical view trees. For count=3:
105
+
106
+
```
107
+
<div .counter>
108
+
<button on:click->dec>
109
+
"-"
110
+
</button>
111
+
<span style:margin="0 1em">
112
+
"3"
113
+
</span>
114
+
<button on:click->inc>
115
+
"+"
116
+
</button>
117
+
</div>
118
+
```
119
+
120
+
Serialized via `Marshal.to_bytes` — binary OCaml marshalling, not
121
+
JSON. For production use, a JSON or structured-clone-safe encoding
122
+
would be needed.
123
+
124
+
## Recommendation
125
+
126
+
**Note is the better fit for the worker bridge architecture.**
127
+
128
+
The key differentiator is push-based propagation. In the worker
129
+
model, the natural flow is:
130
+
131
+
1. Event arrives from main thread
132
+
2. State updates
133
+
3. New view is computed
134
+
4. View is sent to main thread
135
+
136
+
With Note, steps 2–4 happen automatically via the signal graph and
137
+
`S.log`. With Lwd, step 4 requires explicit re-sampling after every
138
+
state change — easy to forget and a source of bugs as complexity
139
+
grows.
140
+
141
+
For a counter this doesn't matter much. But for Experiment C (multiple
142
+
interacting sliders), Note's automatic propagation would compose
143
+
better: add a new event source, wire it into the signal graph, and
144
+
the view updates automatically. With Lwd, every new event handler
145
+
would need to call `send_view()` explicitly.
146
+
147
+
The bundle size difference (2.2 vs 2.7 MB) is negligible given that
148
+
both are dominated by the js_of_ocaml baseline. The 7-line code
149
+
difference is also insignificant.
150
+
151
+
**Next steps if proceeding with Note:**
152
+
- Experiment C: Multi-slider widget to validate composition ✓
153
+
- Experiment D: TyXML functor integration for type-safe HTML ✓
154
+
- Replace `Marshal` with structured-clone-safe encoding
155
+
- Investigate `note.brr` for tighter Brr integration on the main
156
+
thread side (reactive DOM updates without full re-render)
157
+
158
+
---
159
+
160
+
## Experiment C — Multi-Slider Widget
161
+
162
+
A two-slider widget (X and Y, both range inputs 0–100) that displays
163
+
the product X × Y in real time. Tests Note's signal composition with
164
+
`S.hold` and `S.l2`, and validates that the renderer correctly
165
+
extracts `value` from `<input>` elements.
166
+
167
+
### Measurements (Exp C)
168
+
169
+
| Metric | Note Sliders (Exp C) |
170
+
|--------------------------------|---------------------|
171
+
| Worker lines of OCaml | 53 |
172
+
| Main lines of OCaml | 24 |
173
+
| Worker JS bundle (uncompressed)| 2.7 MB |
174
+
| Main JS bundle (uncompressed) | 2.7 MB |
175
+
| Render latency (median) | ~0.3 ms |
176
+
177
+
Shared code: `view.ml` (32 lines), `renderer.ml` (38 lines — 9 lines
178
+
added for input value extraction).
179
+
180
+
### Ergonomics
181
+
182
+
**Signal composition works cleanly.** Each slider's value is a signal
183
+
created with `S.hold`:
184
+
185
+
```ocaml
186
+
let x_input, send_x = Note.E.create ()
187
+
let x = Note.S.hold 50 x_input
188
+
```
189
+
190
+
The combined view uses `S.l2` to lift a function over two signals:
191
+
192
+
```ocaml
193
+
let view = Note.S.l2 (fun x y -> ... view tree ...) x y
194
+
```
195
+
196
+
Adding a third slider would mean `S.l3` — or, for more signals,
197
+
`S.map` over `S.Pair`. The composition scales linearly.
198
+
199
+
**Input value forwarding** required extending the renderer to extract
200
+
`.value` from `<input>`, `<select>`, and `<textarea>` elements. The
201
+
`event_msg.value` field (already `string option`) carries the value
202
+
from the DOM to the worker, where it's parsed:
203
+
204
+
```ocaml
205
+
match ev.handler_id, ev.value with
206
+
| "x", Some v -> send_x (int_of_string v)
207
+
| "y", Some v -> send_y (int_of_string v)
208
+
```
209
+
210
+
This is the minimum viable event payload — sufficient for sliders and
211
+
text inputs. Richer widgets (checkboxes, multi-selects) would need a
212
+
more structured event payload.
213
+
214
+
**Key takeaway:** Note's push-based propagation composes well. Adding
215
+
new event sources and signals requires no changes to the view-sending
216
+
machinery — `S.log` handles it automatically, exactly as predicted
217
+
after Experiments A/B.
218
+
219
+
---
220
+
221
+
## Experiment D — TyXML Functor Integration
222
+
223
+
Uses TyXML's functor API (`Html_f.Make`) over a custom XML backend
224
+
that produces `View.node` values, giving type-safe HTML construction
225
+
while maintaining the same serializable output format.
226
+
227
+
### Measurements (Exp D)
228
+
229
+
| Metric | Note Sliders (Exp C) | TyXML Sliders (Exp D) |
230
+
|--------------------------------|---------------------|----------------------|
231
+
| Worker lines of OCaml | 53 | 48 |
232
+
| Main lines of OCaml | 24 | 24 |
233
+
| Worker JS bundle (uncompressed)| 2.7 MB | 3.9 MB |
234
+
| Main JS bundle (uncompressed) | 2.7 MB | 2.7 MB |
235
+
| Render latency (median) | ~0.3 ms | ~0.3 ms |
236
+
237
+
TyXML backend code: `view_xml.ml` (54 lines) + `view_html.ml` (5
238
+
lines) = 59 lines of one-time setup.
239
+
240
+
### Bundle Size Impact
241
+
242
+
TyXML adds **+1.2 MB** to the worker bundle (2.7 → 3.9 MB). This is
243
+
the TyXML functor code and its generated HTML module. The main thread
244
+
bundle is unchanged since TyXML is only used in the worker.
245
+
246
+
For a worker that's already 2.7 MB (js_of_ocaml baseline + Note),
247
+
this is a ~44% increase. Whether that's acceptable depends on the
248
+
deployment context — for an educational tool where workers are loaded
249
+
once and cached, it's likely fine.
250
+
251
+
### Ergonomics
252
+
253
+
**The TyXML DSL is more concise.** Compare a slider row:
254
+
255
+
Manual (Exp C, 8 lines):
256
+
```ocaml
257
+
Element { tag = "div"; attrs = [Class "slider-row"]; children = [
258
+
Element { tag = "label"; attrs = []; children = [
259
+
Text (Printf.sprintf "%s: %d" label value)
260
+
] };
261
+
Element { tag = "input"; attrs = [
262
+
Property ("type", "range"); Property ("min", "0");
263
+
Property ("max", "100"); Property ("value", ...);
264
+
Handler ("input", handler_id);
265
+
]; children = [] };
266
+
] }
267
+
```
268
+
269
+
TyXML (Exp D, 5 lines):
270
+
```ocaml
271
+
div ~a:[a_class ["slider-row"]] [
272
+
label [txt (Printf.sprintf "%s: %d" label_text value)];
273
+
input ~a:[
274
+
a_input_type `Range; a_value (string_of_int value);
275
+
a_oninput handler_id;
276
+
] ()
277
+
] |> toelt
278
+
```
279
+
280
+
**Type safety catches mistakes.** TyXML enforces valid HTML at compile
281
+
time — you can't put a `<div>` inside a `<span>`, use an invalid
282
+
attribute on an element, or forget required attributes. With manual
283
+
`View.node` construction, any string goes.
284
+
285
+
**The backend is straightforward.** `view_xml.ml` implements TyXML's
286
+
`Xml_sigs.T` module type by mapping each operation to `View.node` /
287
+
`View.attr` constructors. Event handler attributes strip the "on"
288
+
prefix (e.g., `oninput` → `input`) to produce the event name expected
289
+
by the renderer. The full backend is 59 lines of mechanical code that
290
+
only needs to be written once.
291
+
292
+
**One friction point:** TyXML's `toelt` is needed to convert typed
293
+
HTML elements back to the underlying `View.node` type when mixing
294
+
TyXML-constructed subtrees with manually-constructed parent nodes.
295
+
This is a minor inconvenience, not a blocker.
296
+
297
+
### TyXML Recommendation
298
+
299
+
**Use TyXML for widget authors, keep raw View.node for the runtime.**
300
+
301
+
The type safety and conciseness gains are worth the +1.2 MB bundle
302
+
cost for an educational tool. Widget authors writing in the worker
303
+
benefit most from TyXML's compile-time HTML validation. The renderer
304
+
and main thread code remain unchanged — they only see `View.node`.
305
+
306
+
---
307
+
308
+
## Overall Conclusions
309
+
310
+
| | Exp A (Lwd) | Exp B (Note) | Exp C (Sliders) | Exp D (TyXML) |
311
+
|---|---|---|---|---|
312
+
| FRP lib | Lwd | Note | Note | Note |
313
+
| View DSL | Manual | Manual | Manual | TyXML |
314
+
| Worker LOC | 42 | 49 | 53 | 48 |
315
+
| Worker bundle | 2.2 MB | 2.7 MB | 2.7 MB | 3.9 MB |
316
+
317
+
**Architecture validated.** The worker bridge pattern — FRP-driven
318
+
view derivation in a worker, serialized view trees, Brr rendering on
319
+
the main thread — works well across all four experiments. Sub-
320
+
millisecond render latencies, clean separation of concerns, and
321
+
straightforward composition.
322
+
323
+
**Recommended stack:** Note + TyXML for widget authoring, raw
324
+
View.node + Brr for the runtime.
325
+
326
+
**Remaining work:**
327
+
- Replace `Marshal` with structured-clone-safe encoding (JSON or
328
+
custom binary) for production safety
329
+
- Investigate `note.brr` for incremental DOM updates (currently the
330
+
entire DOM subtree is replaced on every view change)
331
+
- Integrate with the toplevel worker to enable user-authored widgets
332
+
- Add CSS styling support beyond inline styles
+2
experiments/widget-bridge/dune-project
+2
experiments/widget-bridge/dune-project
+17
experiments/widget-bridge/html/lwd_counter.html
+17
experiments/widget-bridge/html/lwd_counter.html
···
1
+
<!DOCTYPE html>
2
+
<html>
3
+
<head>
4
+
<meta charset="utf-8">
5
+
<title>Experiment A: Lwd Counter</title>
6
+
<style>
7
+
body { font-family: system-ui, sans-serif; padding: 2rem; }
8
+
.counter { display: flex; align-items: center; font-size: 1.5rem; }
9
+
.counter button { font-size: 1.5rem; padding: 0.25em 0.75em; cursor: pointer; }
10
+
</style>
11
+
</head>
12
+
<body>
13
+
<h1>Experiment A: Lwd Counter</h1>
14
+
<div id="app">Loading...</div>
15
+
<script src="../lwd_counter/main.bc.js"></script>
16
+
</body>
17
+
</html>
+17
experiments/widget-bridge/html/note_counter.html
+17
experiments/widget-bridge/html/note_counter.html
···
1
+
<!DOCTYPE html>
2
+
<html>
3
+
<head>
4
+
<meta charset="utf-8">
5
+
<title>Experiment B: Note Counter</title>
6
+
<style>
7
+
body { font-family: system-ui, sans-serif; padding: 2rem; }
8
+
.counter { display: flex; align-items: center; font-size: 1.5rem; }
9
+
.counter button { font-size: 1.5rem; padding: 0.25em 0.75em; cursor: pointer; }
10
+
</style>
11
+
</head>
12
+
<body>
13
+
<h1>Experiment B: Note Counter</h1>
14
+
<div id="app">Loading...</div>
15
+
<script src="../note_counter/main.bc.js"></script>
16
+
</body>
17
+
</html>
+21
experiments/widget-bridge/html/sliders.html
+21
experiments/widget-bridge/html/sliders.html
···
1
+
<!DOCTYPE html>
2
+
<html>
3
+
<head>
4
+
<meta charset="utf-8">
5
+
<title>Experiment C: Two Sliders</title>
6
+
<style>
7
+
body { font-family: system-ui, sans-serif; padding: 2rem; }
8
+
.sliders { max-width: 400px; }
9
+
.slider-row { margin-bottom: 1rem; }
10
+
.slider-row label { display: block; margin-bottom: 0.25rem; font-size: 1.1rem; }
11
+
.slider-row input[type="range"] { width: 100%; }
12
+
.result { font-size: 1.5rem; margin-top: 1rem; padding: 0.5rem;
13
+
background: #f0f0f0; border-radius: 4px; text-align: center; }
14
+
</style>
15
+
</head>
16
+
<body>
17
+
<h1>Experiment C: Two Sliders</h1>
18
+
<div id="app">Loading...</div>
19
+
<script src="../sliders/main.bc.js"></script>
20
+
</body>
21
+
</html>
+21
experiments/widget-bridge/html/tyxml_sliders.html
+21
experiments/widget-bridge/html/tyxml_sliders.html
···
1
+
<!DOCTYPE html>
2
+
<html>
3
+
<head>
4
+
<meta charset="utf-8">
5
+
<title>Experiment D: TyXML Sliders</title>
6
+
<style>
7
+
body { font-family: system-ui, sans-serif; padding: 2rem; }
8
+
.sliders { max-width: 400px; }
9
+
.slider-row { margin-bottom: 1rem; }
10
+
.slider-row label { display: block; margin-bottom: 0.25rem; font-size: 1.1rem; }
11
+
.slider-row input[type="range"] { width: 100%; }
12
+
.result { font-size: 1.5rem; margin-top: 1rem; padding: 0.5rem;
13
+
background: #f0f0f0; border-radius: 4px; text-align: center; }
14
+
</style>
15
+
</head>
16
+
<body>
17
+
<h1>Experiment D: TyXML Sliders</h1>
18
+
<div id="app">Loading...</div>
19
+
<script src="../tyxml_sliders/main.bc.js"></script>
20
+
</body>
21
+
</html>
+32
experiments/widget-bridge/lib/view.ml
+32
experiments/widget-bridge/lib/view.ml
···
1
+
type event_id = string
2
+
3
+
type attr =
4
+
| Property of string * string
5
+
| Style of string * string
6
+
| Class of string
7
+
| Handler of string * event_id
8
+
9
+
type node =
10
+
| Text of string
11
+
| Element of { tag : string; attrs : attr list; children : node list }
12
+
13
+
type event_msg = {
14
+
handler_id : event_id;
15
+
event_type : string;
16
+
value : string option;
17
+
}
18
+
19
+
let pp_attr fmt = function
20
+
| Property (k, v) -> Format.fprintf fmt "%s=%S" k v
21
+
| Style (k, v) -> Format.fprintf fmt "style:%s=%S" k v
22
+
| Class c -> Format.fprintf fmt ".%s" c
23
+
| Handler (ev, id) -> Format.fprintf fmt "on:%s->%s" ev id
24
+
25
+
let rec pp_node fmt = function
26
+
| Text s -> Format.fprintf fmt "%S" s
27
+
| Element { tag; attrs; children } ->
28
+
Format.fprintf fmt "@[<v 2><%s" tag;
29
+
List.iter (fun a -> Format.fprintf fmt " %a" pp_attr a) attrs;
30
+
Format.fprintf fmt ">";
31
+
List.iter (fun c -> Format.fprintf fmt "@,%a" pp_node c) children;
32
+
Format.fprintf fmt "@]@,</%s>" tag
+25
experiments/widget-bridge/lib/view.mli
+25
experiments/widget-bridge/lib/view.mli
···
1
+
(** Serializable view descriptions for the widget bridge.
2
+
3
+
No closures, no JS references. Event handlers are symbolic
4
+
identifiers resolved by the worker. *)
5
+
6
+
type event_id = string
7
+
8
+
type attr =
9
+
| Property of string * string
10
+
| Style of string * string
11
+
| Class of string
12
+
| Handler of string * event_id (** event name, handler id *)
13
+
14
+
type node =
15
+
| Text of string
16
+
| Element of { tag : string; attrs : attr list; children : node list }
17
+
18
+
type event_msg = {
19
+
handler_id : event_id;
20
+
event_type : string;
21
+
value : string option;
22
+
}
23
+
24
+
(** Pretty-print a node tree (for evaluation/documentation). *)
25
+
val pp_node : Format.formatter -> node -> unit
+11
experiments/widget-bridge/lwd_counter/dune
+11
experiments/widget-bridge/lwd_counter/dune
+24
experiments/widget-bridge/lwd_counter/main.ml
+24
experiments/widget-bridge/lwd_counter/main.ml
···
1
+
module Worker = Brr_webworkers.Worker
2
+
open Brr
3
+
4
+
let () =
5
+
let container =
6
+
match Document.find_el_by_id G.document (Jstr.v "app") with
7
+
| Some el -> el
8
+
| None -> failwith "No #app element found"
9
+
in
10
+
let worker = Worker.create (Jstr.v "../lwd_counter/worker.bc.js") in
11
+
let on_event (ev : View.event_msg) =
12
+
Worker.post worker (Marshal.to_bytes ev [])
13
+
in
14
+
ignore @@ Ev.listen Brr_io.Message.Ev.message
15
+
(fun msg ->
16
+
let msg = Ev.as_type msg in
17
+
let data : bytes = Brr_io.Message.Ev.data msg in
18
+
let view : View.node = Marshal.from_bytes data 0 in
19
+
let t0 = Performance.now_ms G.performance in
20
+
let el = Renderer.render ~on_event view in
21
+
El.set_children container [el];
22
+
let t1 = Performance.now_ms G.performance in
23
+
Console.(log [str "Render:"; (t1 -. t0); str "ms"]))
24
+
(Worker.as_target worker)
+42
experiments/widget-bridge/lwd_counter/worker.ml
+42
experiments/widget-bridge/lwd_counter/worker.ml
···
1
+
open View
2
+
3
+
(* --- State --- *)
4
+
5
+
let count = Lwd.var 0
6
+
7
+
(* --- View derivation --- *)
8
+
9
+
let view =
10
+
Lwd.map (Lwd.get count) ~f:(fun n ->
11
+
Element { tag = "div"; attrs = [Class "counter"]; children = [
12
+
Element { tag = "button";
13
+
attrs = [Handler ("click", "dec")];
14
+
children = [Text "-"] };
15
+
Element { tag = "span";
16
+
attrs = [Style ("margin", "0 1em")];
17
+
children = [Text (string_of_int n)] };
18
+
Element { tag = "button";
19
+
attrs = [Handler ("click", "inc")];
20
+
children = [Text "+"] };
21
+
] })
22
+
23
+
let root = Lwd.observe view
24
+
25
+
(* --- Worker loop --- *)
26
+
27
+
let send_view () =
28
+
let v = Lwd.quick_sample root in
29
+
Js_of_ocaml.Worker.post_message (Marshal.to_bytes (v : node) [])
30
+
31
+
let handle_event (ev : event_msg) =
32
+
(match ev.handler_id with
33
+
| "inc" -> Lwd.set count (Lwd.peek count + 1)
34
+
| "dec" -> Lwd.set count (Lwd.peek count - 1)
35
+
| _ -> ());
36
+
send_view ()
37
+
38
+
let () =
39
+
send_view ();
40
+
Js_of_ocaml.Worker.set_onmessage (fun data ->
41
+
let ev : event_msg = Marshal.from_bytes data 0 in
42
+
handle_event ev)
+11
experiments/widget-bridge/note_counter/dune
+11
experiments/widget-bridge/note_counter/dune
+24
experiments/widget-bridge/note_counter/main.ml
+24
experiments/widget-bridge/note_counter/main.ml
···
1
+
module Worker = Brr_webworkers.Worker
2
+
open Brr
3
+
4
+
let () =
5
+
let container =
6
+
match Document.find_el_by_id G.document (Jstr.v "app") with
7
+
| Some el -> el
8
+
| None -> failwith "No #app element found"
9
+
in
10
+
let worker = Worker.create (Jstr.v "../note_counter/worker.bc.js") in
11
+
let on_event (ev : View.event_msg) =
12
+
Worker.post worker (Marshal.to_bytes ev [])
13
+
in
14
+
ignore @@ Ev.listen Brr_io.Message.Ev.message
15
+
(fun msg ->
16
+
let msg = Ev.as_type msg in
17
+
let data : bytes = Brr_io.Message.Ev.data msg in
18
+
let view : View.node = Marshal.from_bytes data 0 in
19
+
let t0 = Performance.now_ms G.performance in
20
+
let el = Renderer.render ~on_event view in
21
+
El.set_children container [el];
22
+
let t1 = Performance.now_ms G.performance in
23
+
Console.(log [str "Render:"; (t1 -. t0); str "ms"]))
24
+
(Worker.as_target worker)
+49
experiments/widget-bridge/note_counter/worker.ml
+49
experiments/widget-bridge/note_counter/worker.ml
···
1
+
open View
2
+
3
+
(* --- Event sources --- *)
4
+
5
+
let inc_e, send_inc = Note.E.create ()
6
+
let dec_e, send_dec = Note.E.create ()
7
+
8
+
(* --- Reactive state --- *)
9
+
10
+
let count =
11
+
let delta = Note.E.select [
12
+
Note.E.map (fun () n -> n + 1) inc_e;
13
+
Note.E.map (fun () n -> n - 1) dec_e;
14
+
] in
15
+
Note.S.accum 0 delta
16
+
17
+
(* --- View derivation --- *)
18
+
19
+
let view =
20
+
Note.S.map (fun n ->
21
+
Element { tag = "div"; attrs = [Class "counter"]; children = [
22
+
Element { tag = "button";
23
+
attrs = [Handler ("click", "dec")];
24
+
children = [Text "-"] };
25
+
Element { tag = "span";
26
+
attrs = [Style ("margin", "0 1em")];
27
+
children = [Text (string_of_int n)] };
28
+
Element { tag = "button";
29
+
attrs = [Handler ("click", "inc")];
30
+
children = [Text "+"] };
31
+
] })
32
+
count
33
+
34
+
(* --- Worker loop --- *)
35
+
36
+
let send_view (v : node) =
37
+
Js_of_ocaml.Worker.post_message (Marshal.to_bytes v [])
38
+
39
+
let () =
40
+
(* Observe view signal and send updates *)
41
+
let logr = Note.S.log view send_view in
42
+
Note.Logr.hold logr;
43
+
(* Handle incoming events *)
44
+
Js_of_ocaml.Worker.set_onmessage (fun data ->
45
+
let ev : event_msg = Marshal.from_bytes data 0 in
46
+
match ev.handler_id with
47
+
| "inc" -> send_inc ()
48
+
| "dec" -> send_dec ()
49
+
| _ -> ())
+3
experiments/widget-bridge/renderer/dune
+3
experiments/widget-bridge/renderer/dune
+38
experiments/widget-bridge/renderer/renderer.ml
+38
experiments/widget-bridge/renderer/renderer.ml
···
1
+
open Brr
2
+
3
+
let rec render ~on_event (node : View.node) : El.t =
4
+
match node with
5
+
| Text s ->
6
+
El.txt (Jstr.v s)
7
+
| Element { tag; attrs; children } ->
8
+
let brr_attrs = List.filter_map (fun (a : View.attr) ->
9
+
match a with
10
+
| Property (k, v) -> Some (At.v (Jstr.v k) (Jstr.v v))
11
+
| Style (k, v) -> Some (At.style (Jstr.v (k ^ ":" ^ v)))
12
+
| Class c -> Some (At.class' (Jstr.v c))
13
+
| Handler _ -> None
14
+
) attrs in
15
+
let el =
16
+
El.v (Jstr.v tag) ~at:brr_attrs
17
+
(List.map (render ~on_event) children)
18
+
in
19
+
List.iter (fun (a : View.attr) ->
20
+
match a with
21
+
| Handler (event_name, handler_id) ->
22
+
let is_input = match tag with
23
+
| "input" | "select" | "textarea" -> true
24
+
| _ -> false
25
+
in
26
+
ignore @@ Ev.listen
27
+
(Ev.Type.void (Jstr.v event_name))
28
+
(fun _ev ->
29
+
let value =
30
+
if is_input then
31
+
Some (Jstr.to_string (Jv.Jstr.get (El.to_jv el) "value"))
32
+
else None
33
+
in
34
+
on_event { View.handler_id; event_type = event_name; value })
35
+
(El.as_target el)
36
+
| _ -> ()
37
+
) attrs;
38
+
el
+6
experiments/widget-bridge/renderer/renderer.mli
+6
experiments/widget-bridge/renderer/renderer.mli
+11
experiments/widget-bridge/sliders/dune
+11
experiments/widget-bridge/sliders/dune
+24
experiments/widget-bridge/sliders/main.ml
+24
experiments/widget-bridge/sliders/main.ml
···
1
+
module Worker = Brr_webworkers.Worker
2
+
open Brr
3
+
4
+
let () =
5
+
let container =
6
+
match Document.find_el_by_id G.document (Jstr.v "app") with
7
+
| Some el -> el
8
+
| None -> failwith "No #app element found"
9
+
in
10
+
let worker = Worker.create (Jstr.v "../sliders/worker.bc.js") in
11
+
let on_event (ev : View.event_msg) =
12
+
Worker.post worker (Marshal.to_bytes ev [])
13
+
in
14
+
ignore @@ Ev.listen Brr_io.Message.Ev.message
15
+
(fun msg ->
16
+
let msg = Ev.as_type msg in
17
+
let data : bytes = Brr_io.Message.Ev.data msg in
18
+
let view : View.node = Marshal.from_bytes data 0 in
19
+
let t0 = Performance.now_ms G.performance in
20
+
let el = Renderer.render ~on_event view in
21
+
El.set_children container [el];
22
+
let t1 = Performance.now_ms G.performance in
23
+
Console.(log [str "Render:"; (t1 -. t0); str "ms"]))
24
+
(Worker.as_target worker)
+53
experiments/widget-bridge/sliders/worker.ml
+53
experiments/widget-bridge/sliders/worker.ml
···
1
+
open View
2
+
3
+
(* --- Event sources --- *)
4
+
5
+
let x_input, send_x = Note.E.create ()
6
+
let y_input, send_y = Note.E.create ()
7
+
8
+
(* --- Reactive state --- *)
9
+
10
+
let x = Note.S.hold 50 x_input
11
+
let y = Note.S.hold 50 y_input
12
+
13
+
(* --- View derivation --- *)
14
+
15
+
let slider ~label ~handler_id value =
16
+
Element { tag = "div"; attrs = [Class "slider-row"]; children = [
17
+
Element { tag = "label"; attrs = []; children = [
18
+
Text (Printf.sprintf "%s: %d" label value)
19
+
] };
20
+
Element { tag = "input"; attrs = [
21
+
Property ("type", "range");
22
+
Property ("min", "0");
23
+
Property ("max", "100");
24
+
Property ("value", string_of_int value);
25
+
Handler ("input", handler_id);
26
+
]; children = [] };
27
+
] }
28
+
29
+
let view =
30
+
Note.S.l2 (fun x y ->
31
+
Element { tag = "div"; attrs = [Class "sliders"]; children = [
32
+
slider ~label:"X" ~handler_id:"x" x;
33
+
slider ~label:"Y" ~handler_id:"y" y;
34
+
Element { tag = "div"; attrs = [Class "result"]; children = [
35
+
Text (Printf.sprintf "X × Y = %d" (x * y))
36
+
] };
37
+
] })
38
+
x y
39
+
40
+
(* --- Worker loop --- *)
41
+
42
+
let send_view (v : node) =
43
+
Js_of_ocaml.Worker.post_message (Marshal.to_bytes v [])
44
+
45
+
let () =
46
+
let logr = Note.S.log view send_view in
47
+
Note.Logr.hold logr;
48
+
Js_of_ocaml.Worker.set_onmessage (fun data ->
49
+
let ev : event_msg = Marshal.from_bytes data 0 in
50
+
match ev.handler_id, ev.value with
51
+
| "x", Some v -> (try send_x (int_of_string v) with _ -> ())
52
+
| "y", Some v -> (try send_y (int_of_string v) with _ -> ())
53
+
| _ -> ())
+3
experiments/widget-bridge/tyxml_backend/dune
+3
experiments/widget-bridge/tyxml_backend/dune
+5
experiments/widget-bridge/tyxml_backend/view_html.ml
+5
experiments/widget-bridge/tyxml_backend/view_html.ml
+54
experiments/widget-bridge/tyxml_backend/view_xml.ml
+54
experiments/widget-bridge/tyxml_backend/view_xml.ml
···
1
+
module W = Xml_wrap.NoWrap
2
+
3
+
type 'a wrap = 'a
4
+
type 'a list_wrap = 'a list
5
+
6
+
type uri = string
7
+
let uri_of_string s = s
8
+
let string_of_uri s = s
9
+
10
+
type aname = string
11
+
type event_handler = string
12
+
type mouse_event_handler = string
13
+
type keyboard_event_handler = string
14
+
type touch_event_handler = string
15
+
16
+
type attrib = View.attr
17
+
18
+
let float_attrib name value = View.Property (name, string_of_float value)
19
+
let int_attrib name value = View.Property (name, string_of_int value)
20
+
let string_attrib name value = View.Property (name, value)
21
+
let space_sep_attrib name values = View.Property (name, String.concat " " values)
22
+
let comma_sep_attrib name values = View.Property (name, String.concat "," values)
23
+
24
+
let event_name_of_aname aname =
25
+
if String.length aname > 2 && String.sub aname 0 2 = "on"
26
+
then String.sub aname 2 (String.length aname - 2)
27
+
else aname
28
+
29
+
let event_handler_attrib aname handler_id =
30
+
View.Handler (event_name_of_aname aname, handler_id)
31
+
let mouse_event_handler_attrib = event_handler_attrib
32
+
let keyboard_event_handler_attrib = event_handler_attrib
33
+
let touch_event_handler_attrib = event_handler_attrib
34
+
let uri_attrib name value = View.Property (name, value)
35
+
let uris_attrib name values = View.Property (name, String.concat " " values)
36
+
37
+
type elt = View.node
38
+
type ename = string
39
+
40
+
let empty () = View.Text ""
41
+
let comment _s = View.Text ""
42
+
let pcdata s = View.Text s
43
+
let encodedpcdata s = View.Text s
44
+
let entity e = View.Text ("&" ^ e ^ ";")
45
+
46
+
let leaf ?(a = []) name =
47
+
View.Element { tag = name; attrs = a; children = [] }
48
+
49
+
let node ?(a = []) name children =
50
+
View.Element { tag = name; attrs = a; children }
51
+
52
+
let cdata s = View.Text s
53
+
let cdata_script s = View.Text s
54
+
let cdata_style s = View.Text s
+11
experiments/widget-bridge/tyxml_sliders/dune
+11
experiments/widget-bridge/tyxml_sliders/dune
+24
experiments/widget-bridge/tyxml_sliders/main.ml
+24
experiments/widget-bridge/tyxml_sliders/main.ml
···
1
+
module Worker = Brr_webworkers.Worker
2
+
open Brr
3
+
4
+
let () =
5
+
let container =
6
+
match Document.find_el_by_id G.document (Jstr.v "app") with
7
+
| Some el -> el
8
+
| None -> failwith "No #app element found"
9
+
in
10
+
let worker = Worker.create (Jstr.v "../tyxml_sliders/worker.bc.js") in
11
+
let on_event (ev : View.event_msg) =
12
+
Worker.post worker (Marshal.to_bytes ev [])
13
+
in
14
+
ignore @@ Ev.listen Brr_io.Message.Ev.message
15
+
(fun msg ->
16
+
let msg = Ev.as_type msg in
17
+
let data : bytes = Brr_io.Message.Ev.data msg in
18
+
let view : View.node = Marshal.from_bytes data 0 in
19
+
let t0 = Performance.now_ms G.performance in
20
+
let el = Renderer.render ~on_event view in
21
+
El.set_children container [el];
22
+
let t1 = Performance.now_ms G.performance in
23
+
Console.(log [str "Render:"; (t1 -. t0); str "ms"]))
24
+
(Worker.as_target worker)
+48
experiments/widget-bridge/tyxml_sliders/worker.ml
+48
experiments/widget-bridge/tyxml_sliders/worker.ml
···
1
+
open View
2
+
open View_html
3
+
4
+
(* --- Event sources (same as Experiment C) --- *)
5
+
6
+
let x_input, send_x = Note.E.create ()
7
+
let y_input, send_y = Note.E.create ()
8
+
9
+
let x = Note.S.hold 50 x_input
10
+
let y = Note.S.hold 50 y_input
11
+
12
+
(* --- View derivation with TyXML DSL --- *)
13
+
14
+
let slider_row ~label_text ~handler_id value =
15
+
div ~a:[a_class ["slider-row"]] [
16
+
label [txt (Printf.sprintf "%s: %d" label_text value)];
17
+
input ~a:[
18
+
a_input_type `Range;
19
+
a_value (string_of_int value);
20
+
a_oninput handler_id;
21
+
] ()
22
+
] |> toelt
23
+
24
+
let view =
25
+
Note.S.l2 (fun x y ->
26
+
Element { tag = "div"; attrs = [Class "sliders"]; children = [
27
+
slider_row ~label_text:"X" ~handler_id:"x" x;
28
+
slider_row ~label_text:"Y" ~handler_id:"y" y;
29
+
toelt (div ~a:[a_class ["result"]] [
30
+
txt (Printf.sprintf "X * Y = %d" (x * y))
31
+
]);
32
+
] })
33
+
x y
34
+
35
+
(* --- Worker loop (identical to Experiment C) --- *)
36
+
37
+
let send_view (v : node) =
38
+
Js_of_ocaml.Worker.post_message (Marshal.to_bytes v [])
39
+
40
+
let () =
41
+
let logr = Note.S.log view send_view in
42
+
Note.Logr.hold logr;
43
+
Js_of_ocaml.Worker.set_onmessage (fun data ->
44
+
let ev : event_msg = Marshal.from_bytes data 0 in
45
+
match ev.handler_id, ev.value with
46
+
| "x", Some v -> (try send_x (int_of_string v) with _ -> ())
47
+
| "y", Some v -> (try send_y (int_of_string v) with _ -> ())
48
+
| _ -> ())
+1
-1
js_top_worker/bin/mk_backend.ml
+1
-1
js_top_worker/bin/mk_backend.ml
···
24
24
(* No longer query library stubs - they are now linked directly into each library's JS file *)
25
25
let cmd =
26
26
Bos.Cmd.(
27
-
js_of_ocaml_cmd % "--toplevel" % "--no-cmis" % "--linkall" % "--pretty")
27
+
js_of_ocaml_cmd % "--toplevel" % "--linkall" % "--pretty")
28
28
in
29
29
let cmd =
30
30
List.fold_right
+24
js_top_worker/client/ocaml-worker.d.ts
+24
js_top_worker/client/ocaml-worker.d.ts
···
126
126
mime_vals: MimeVal[];
127
127
}
128
128
129
+
export interface WidgetUpdateMessage {
130
+
type: string;
131
+
widget_id: string;
132
+
view: any;
133
+
}
134
+
135
+
export interface WidgetClearMessage {
136
+
type: string;
137
+
widget_id: string;
138
+
}
139
+
129
140
export interface OcamlWorkerOptions {
130
141
/** Timeout in milliseconds (default: 30000) */
131
142
timeout?: number;
132
143
/** Callback for incremental output after each phrase */
133
144
onOutputAt?: (output: OutputAt) => void;
145
+
/** Callback for widget view updates */
146
+
onWidgetUpdate?: (msg: WidgetUpdateMessage) => void;
147
+
/** Callback for widget clear events */
148
+
onWidgetClear?: (msg: WidgetClearMessage) => void;
134
149
}
135
150
136
151
export class OcamlWorker {
···
193
208
* @param envId - Environment ID
194
209
*/
195
210
destroyEnv(envId: string): Promise<EnvResult>;
211
+
212
+
/**
213
+
* Send a widget event to the worker.
214
+
* @param widgetId - Widget identifier
215
+
* @param handlerId - Handler identifier within the widget
216
+
* @param eventType - DOM event type (e.g., 'input', 'click')
217
+
* @param value - Input value if applicable
218
+
*/
219
+
sendWidgetEvent(widgetId: string, handlerId: string, eventType: string, value?: string | null): void;
196
220
197
221
/**
198
222
* Terminate the worker.
+31
js_top_worker/client/ocaml-worker.js
+31
js_top_worker/client/ocaml-worker.js
···
145
145
this.worker = new Worker(blobUrl);
146
146
this.timeout = options.timeout || 30000;
147
147
this.onOutputAt = options.onOutputAt || null;
148
+
this.onWidgetUpdate = options.onWidgetUpdate || null;
149
+
this.onWidgetClear = options.onWidgetClear || null;
148
150
this.cellIdCounter = 0;
149
151
this.pendingRequests = new Map();
150
152
this.readyPromise = null;
···
218
220
case 'env_created':
219
221
case 'env_destroyed':
220
222
this._resolveRequest(msg.env_id, msg);
223
+
break;
224
+
225
+
case 'widget_update':
226
+
if (this.onWidgetUpdate) {
227
+
this.onWidgetUpdate(msg);
228
+
}
229
+
break;
230
+
231
+
case 'widget_clear':
232
+
if (this.onWidgetClear) {
233
+
this.onWidgetClear(msg);
234
+
}
221
235
break;
222
236
223
237
default:
···
426
440
type: 'destroy_env',
427
441
env_id: envId,
428
442
}, envId);
443
+
}
444
+
445
+
/**
446
+
* Send a widget event to the worker.
447
+
* @param {string} widgetId - Widget identifier
448
+
* @param {string} handlerId - Handler identifier within the widget
449
+
* @param {string} eventType - DOM event type (e.g., 'input', 'click')
450
+
* @param {string|null} [value=null] - Input value if applicable
451
+
*/
452
+
sendWidgetEvent(widgetId, handlerId, eventType, value = null) {
453
+
this.worker.postMessage(JSON.stringify({
454
+
type: 'widget_event',
455
+
widget_id: widgetId,
456
+
handler_id: handlerId,
457
+
event_type: eventType,
458
+
value: value,
459
+
}));
429
460
}
430
461
431
462
/**
+9
-2
js_top_worker/example/dune
+9
-2
js_top_worker/example/dune
···
38
38
(js_of_ocaml
39
39
(javascript_files ../lib/stubs.js)
40
40
(flags --effects=disabled --toplevel --opt 3 +toplevel.js +dynlink.js))
41
-
(libraries js_top_worker-web logs.browser mime_printer tyxml))
41
+
(libraries js_top_worker-web logs.browser mime_printer tyxml js_top_worker-widget note))
42
+
43
+
(rule
44
+
(target ocaml-worker.js)
45
+
(deps ../client/ocaml-worker.js)
46
+
(action (copy ../client/ocaml-worker.js %{target})))
42
47
43
48
(rule
44
49
(targets
45
50
(dir _opam))
46
51
(action
47
-
(run jtw opam -o _opam str stringext mime_printer)))
52
+
(run jtw opam -o _opam str stringext mime_printer note)))
48
53
49
54
(alias
50
55
(name default)
···
62
67
index3.html
63
68
index4.html
64
69
index5.html
70
+
widget_test.html
71
+
ocaml-worker.js
65
72
_opam
66
73
server.py
67
74
(alias_rec all)))
+229
js_top_worker/example/widget_test.html
+229
js_top_worker/example/widget_test.html
···
1
+
<!DOCTYPE html>
2
+
<html>
3
+
<head>
4
+
<meta charset="utf-8">
5
+
<title>Widget Protocol Test</title>
6
+
<style>
7
+
body { font-family: monospace; max-width: 800px; margin: 2em auto; }
8
+
#log { background: #f5f5f5; padding: 1em; white-space: pre-wrap; max-height: 400px; overflow-y: auto; }
9
+
.widget-container { border: 1px solid #ccc; padding: 1em; margin: 1em 0; }
10
+
.widget-container h3 { margin-top: 0; color: #666; }
11
+
</style>
12
+
</head>
13
+
<body>
14
+
<h1>Widget Protocol Test</h1>
15
+
<div id="widgets"></div>
16
+
<h2>Log</h2>
17
+
<div id="log"></div>
18
+
19
+
<script type="module">
20
+
import { OcamlWorker } from './ocaml-worker.js';
21
+
22
+
const logEl = document.getElementById('log');
23
+
const widgetsEl = document.getElementById('widgets');
24
+
let worker;
25
+
26
+
function log(msg) {
27
+
logEl.textContent += msg + '\n';
28
+
logEl.scrollTop = logEl.scrollHeight;
29
+
}
30
+
31
+
// --- View.node JSON renderer ---
32
+
function renderNode(node) {
33
+
if (node.t === 'txt') {
34
+
return document.createTextNode(node.v);
35
+
}
36
+
if (node.t === 'el') {
37
+
const el = document.createElement(node.tag);
38
+
for (const attr of (node.a || [])) {
39
+
switch (attr.t) {
40
+
case 'prop':
41
+
el.setAttribute(attr.k, attr.v);
42
+
break;
43
+
case 'style':
44
+
el.style[attr.k] = attr.v;
45
+
break;
46
+
case 'cls':
47
+
el.classList.add(attr.v);
48
+
break;
49
+
case 'handler':
50
+
el.addEventListener(attr.ev, () => {
51
+
const isInput = ['INPUT', 'SELECT', 'TEXTAREA'].includes(el.tagName);
52
+
const value = isInput ? el.value : null;
53
+
const widgetId = el.closest('[data-widget-id]')?.dataset.widgetId;
54
+
if (widgetId) {
55
+
log('Event: widget=' + widgetId + ' handler=' + attr.id + ' value=' + value);
56
+
worker.sendWidgetEvent(widgetId, attr.id, attr.ev, value);
57
+
}
58
+
});
59
+
break;
60
+
}
61
+
}
62
+
for (const child of (node.c || [])) {
63
+
el.appendChild(renderNode(child));
64
+
}
65
+
return el;
66
+
}
67
+
return document.createTextNode('');
68
+
}
69
+
70
+
function renderWidget(widgetId, viewJson) {
71
+
let container = document.getElementById('widget-' + widgetId);
72
+
if (!container) {
73
+
container = document.createElement('div');
74
+
container.id = 'widget-' + widgetId;
75
+
container.className = 'widget-container';
76
+
container.dataset.widgetId = widgetId;
77
+
container.innerHTML = '<h3>' + widgetId + '</h3>';
78
+
widgetsEl.appendChild(container);
79
+
}
80
+
const heading = container.querySelector('h3');
81
+
container.innerHTML = '';
82
+
container.appendChild(heading);
83
+
container.dataset.widgetId = widgetId;
84
+
container.appendChild(renderNode(viewJson));
85
+
}
86
+
87
+
async function run() {
88
+
log('Creating worker...');
89
+
worker = new OcamlWorker('worker.bc.js', {
90
+
onWidgetUpdate: (msg) => {
91
+
log('WidgetUpdate: id=' + msg.widget_id);
92
+
renderWidget(msg.widget_id, msg.view);
93
+
},
94
+
onWidgetClear: (msg) => {
95
+
log('WidgetClear: id=' + msg.widget_id);
96
+
const container = document.getElementById('widget-' + msg.widget_id);
97
+
if (container) container.remove();
98
+
},
99
+
onOutputAt: (msg) => {
100
+
if (msg.caml_ppf) log('OutputAt: ' + msg.caml_ppf);
101
+
},
102
+
});
103
+
104
+
log('Initializing...');
105
+
await worker.init({
106
+
findlib_requires: [],
107
+
findlib_index: null,
108
+
});
109
+
log('Worker ready.');
110
+
111
+
// Helper to log eval results with errors
112
+
function logResult(label, r) {
113
+
if (r.caml_ppf) log(label + ': ' + r.caml_ppf);
114
+
if (r.stderr) log('STDERR: ' + r.stderr);
115
+
}
116
+
117
+
// Diagnostic: check module availability
118
+
log('\n--- Diagnostic: module availability ---');
119
+
const d1 = await worker.eval('module W = Widget;;');
120
+
logResult('Widget', d1);
121
+
const d2 = await worker.eval('let _ = Widget.View.Text "test";;');
122
+
logResult('Widget.View', d2);
123
+
124
+
// Test 1: Static widget
125
+
log('\n--- Test 1: Static widget ---');
126
+
const r1 = await worker.eval(
127
+
'Widget.display ~id:"hello" ~handlers:[] ' +
128
+
'(Widget.View.Element { tag = "div"; attrs = []; ' +
129
+
'children = [Widget.View.Text "Hello from OCaml!"] });;'
130
+
);
131
+
logResult('Eval', r1);
132
+
133
+
// Test 2: Interactive counter with Note
134
+
log('\n--- Test 2: Interactive counter ---');
135
+
const r2 = await worker.eval([
136
+
'let inc_e, send_inc = Note.E.create ();;',
137
+
'let dec_e, send_dec = Note.E.create ();;',
138
+
'let count =',
139
+
' let delta = Note.E.select [',
140
+
' Note.E.map (fun () n -> n + 1) inc_e;',
141
+
' Note.E.map (fun () n -> n - 1) dec_e;',
142
+
' ] in',
143
+
' Note.S.accum 0 delta;;',
144
+
'',
145
+
'let counter_view n =',
146
+
' let open Widget.View in',
147
+
' Element { tag = "div"; attrs = [Class "counter"]; children = [',
148
+
' Element { tag = "button";',
149
+
' attrs = [Handler ("click", "dec")];',
150
+
' children = [Text "-"] };',
151
+
' Element { tag = "span";',
152
+
' attrs = [Style ("margin", "0 1em")];',
153
+
' children = [Text (string_of_int n)] };',
154
+
' Element { tag = "button";',
155
+
' attrs = [Handler ("click", "inc")];',
156
+
' children = [Text "+"] };',
157
+
' ] };;',
158
+
'',
159
+
'Widget.display ~id:"counter"',
160
+
' ~handlers:[',
161
+
' "inc", (fun _ -> send_inc ());',
162
+
' "dec", (fun _ -> send_dec ());',
163
+
' ]',
164
+
' (counter_view 0);;',
165
+
'',
166
+
'let _logr = Note.S.log',
167
+
' (Note.S.map counter_view count)',
168
+
' (Widget.update ~id:"counter");;',
169
+
'Note.Logr.hold _logr;;',
170
+
].join('\n'));
171
+
logResult('Eval', r2);
172
+
173
+
// Test 3: Slider with cross-cell signal
174
+
log('\n--- Test 3: Slider ---');
175
+
await worker.eval([
176
+
'let x_e, send_x = Note.E.create ();;',
177
+
'let x = Note.S.hold 50 x_e;;',
178
+
'',
179
+
'let slider_view v =',
180
+
' let open Widget.View in',
181
+
' Element { tag = "div"; attrs = []; children = [',
182
+
' Element { tag = "label"; attrs = [];',
183
+
' children = [Text (Printf.sprintf "X: %d" v)] };',
184
+
' Element { tag = "input"; attrs = [',
185
+
' Property ("type", "range");',
186
+
' Property ("min", "0");',
187
+
' Property ("max", "100");',
188
+
' Property ("value", string_of_int v);',
189
+
' Handler ("input", "x");',
190
+
' ]; children = [] };',
191
+
' ] };;',
192
+
'',
193
+
'Widget.display ~id:"slider"',
194
+
' ~handlers:["x", (fun v ->',
195
+
' send_x (int_of_string (Option.get v)))]',
196
+
' (slider_view 50);;',
197
+
'',
198
+
'let _logr2 = Note.S.log',
199
+
' (Note.S.map slider_view x)',
200
+
' (Widget.update ~id:"slider");;',
201
+
'Note.Logr.hold _logr2;;',
202
+
].join('\n'));
203
+
204
+
// Test 3b: Cross-cell derived widget
205
+
log('\n--- Test 3b: Derived widget (uses x from cell above) ---');
206
+
await worker.eval([
207
+
'let doubled_view v =',
208
+
' let open Widget.View in',
209
+
' Element { tag = "div"; attrs = []; children = [',
210
+
' Text (Printf.sprintf "2x = %d" (v * 2))',
211
+
' ] };;',
212
+
'',
213
+
'Widget.display ~id:"doubled"',
214
+
' ~handlers:[]',
215
+
' (doubled_view (Note.S.value x));;',
216
+
'',
217
+
'let _logr3 = Note.S.log',
218
+
' (Note.S.map doubled_view x)',
219
+
' (Widget.update ~id:"doubled");;',
220
+
'Note.Logr.hold _logr3;;',
221
+
].join('\n'));
222
+
223
+
log('\nAll tests dispatched. Interact with widgets above.');
224
+
}
225
+
226
+
run().catch(e => log('Error: ' + e.message));
227
+
</script>
228
+
</body>
229
+
</html>
+1
-1
js_top_worker/idl/dune
+1
-1
js_top_worker/idl/dune
+106
-1
js_top_worker/idl/js_top_worker_client_msg.ml
+106
-1
js_top_worker/idl/js_top_worker_client_msg.ml
···
40
40
pending : (int, Msg.worker_msg Lwt.u) Hashtbl.t;
41
41
pending_env : (string, Msg.worker_msg Lwt.u) Hashtbl.t;
42
42
pending_stream : (int, eval_event option -> unit) Hashtbl.t;
43
+
mutable on_widget_update : (string -> Js_of_ocaml.Js.Unsafe.any -> unit) option;
44
+
mutable on_widget_clear : (string -> unit) option;
45
+
mutable on_widget_config : (string -> string -> unit) option;
46
+
mutable on_widget_command : (string -> string -> string -> unit) option;
47
+
mutable on_widget_register_adapter : (string -> string -> unit) option;
43
48
}
44
49
45
50
exception Timeout
···
139
144
caml_ppf = get_string "caml_ppf";
140
145
mime_vals;
141
146
}
147
+
| "widget_config" ->
148
+
Msg.WidgetConfig {
149
+
widget_id = get_string "widget_id";
150
+
config = get_string "config";
151
+
}
152
+
| "widget_command" ->
153
+
Msg.WidgetCommand {
154
+
widget_id = get_string "widget_id";
155
+
command = get_string "command";
156
+
data = get_string "data";
157
+
}
142
158
| _ -> failwith ("Unknown message type: " ^ typ)
143
159
144
160
(** Handle incoming message from worker *)
145
161
let handle_message t msg =
162
+
let open Js_of_ocaml in
146
163
let data = Brr_message.Ev.data (Brr.Ev.as_type msg) in
147
-
let parsed = parse_worker_msg (Js_of_ocaml.Js.to_string data) in
164
+
let json_str = Js.to_string data in
165
+
(* Check for widget messages before full parsing — these carry raw view JSON
166
+
that we forward directly without round-tripping through OCaml types. *)
167
+
let obj = plain_parse (Js.string json_str) in
168
+
let typ = Js.to_string (Js.Unsafe.get obj (Js.string "type")) in
169
+
if typ = "widget_update" then begin
170
+
match t.on_widget_update with
171
+
| Some cb ->
172
+
let widget_id = Js.to_string (Js.Unsafe.get obj (Js.string "widget_id")) in
173
+
let view = Js.Unsafe.get obj (Js.string "view") in
174
+
cb widget_id view
175
+
| None -> ()
176
+
end
177
+
else if typ = "widget_clear" then begin
178
+
match t.on_widget_clear with
179
+
| Some cb ->
180
+
let widget_id = Js.to_string (Js.Unsafe.get obj (Js.string "widget_id")) in
181
+
cb widget_id
182
+
| None -> ()
183
+
end
184
+
else if typ = "widget_config" then begin
185
+
match t.on_widget_config with
186
+
| Some cb ->
187
+
let widget_id = Js.to_string (Js.Unsafe.get obj (Js.string "widget_id")) in
188
+
let config = Js.to_string (Js.Unsafe.get obj (Js.string "config")) in
189
+
cb widget_id config
190
+
| None -> ()
191
+
end
192
+
else if typ = "widget_command" then begin
193
+
match t.on_widget_command with
194
+
| Some cb ->
195
+
let widget_id = Js.to_string (Js.Unsafe.get obj (Js.string "widget_id")) in
196
+
let command = Js.to_string (Js.Unsafe.get obj (Js.string "command")) in
197
+
let data = Js.to_string (Js.Unsafe.get obj (Js.string "data")) in
198
+
cb widget_id command data
199
+
| None -> ()
200
+
end
201
+
else if typ = "widget_register_adapter" then begin
202
+
match t.on_widget_register_adapter with
203
+
| Some cb ->
204
+
let kind = Js.to_string (Js.Unsafe.get obj (Js.string "kind")) in
205
+
let js_code = Js.to_string (Js.Unsafe.get obj (Js.string "js_code")) in
206
+
cb kind js_code
207
+
| None -> ()
208
+
end
209
+
else
210
+
let parsed = parse_worker_msg json_str in
148
211
match parsed with
149
212
| Msg.Ready ->
150
213
t.ready <- true;
···
199
262
Hashtbl.remove t.pending_env env_id;
200
263
Lwt.wakeup resolver parsed
201
264
| None -> ())
265
+
| Msg.WidgetUpdate _ | Msg.WidgetClear _
266
+
| Msg.WidgetConfig _ | Msg.WidgetCommand _
267
+
| Msg.WidgetRegisterAdapter _ ->
268
+
(* Handled above via raw JSON interception before parsing *)
269
+
()
202
270
203
271
(** Create a new worker client.
204
272
@param timeout Timeout in milliseconds (default: 30000) *)
···
213
281
pending = Hashtbl.create 16;
214
282
pending_env = Hashtbl.create 16;
215
283
pending_stream = Hashtbl.create 16;
284
+
on_widget_update = None;
285
+
on_widget_clear = None;
286
+
on_widget_config = None;
287
+
on_widget_command = None;
288
+
on_widget_register_adapter = None;
216
289
} in
217
290
let _listener =
218
291
Brr.Ev.listen Brr_message.Ev.message (handle_message t) (Brr_worker.as_target worker)
···
415
488
| Msg.EnvDestroyed _ -> Lwt.return_unit
416
489
| Msg.InitError { message } -> Lwt.fail (InitError message)
417
490
| _ -> Lwt.fail (Failure "Unexpected response")
491
+
492
+
(** Set callback for widget update messages.
493
+
The callback receives (widget_id, raw_view_json) where raw_view_json
494
+
is the unparsed JS object for the view node. *)
495
+
let set_on_widget_update t cb = t.on_widget_update <- Some cb
496
+
497
+
(** Set callback for widget clear messages. *)
498
+
let set_on_widget_clear t cb = t.on_widget_clear <- Some cb
499
+
500
+
(** Set callback for widget config messages. *)
501
+
let set_on_widget_config t cb = t.on_widget_config <- Some cb
502
+
503
+
(** Set callback for widget command messages. *)
504
+
let set_on_widget_command t cb = t.on_widget_command <- Some cb
505
+
506
+
(** Set callback for widget adapter registration messages. *)
507
+
let set_on_widget_register_adapter t cb = t.on_widget_register_adapter <- Some cb
508
+
509
+
(** Send a widget event back to the worker. *)
510
+
let send_widget_event t ~widget_id ~handler_id ~event_type ~value =
511
+
let open Js_of_ocaml in
512
+
let pairs = [|
513
+
("type", Js.Unsafe.inject (Js.string "widget_event"));
514
+
("widget_id", Js.Unsafe.inject (Js.string widget_id));
515
+
("handler_id", Js.Unsafe.inject (Js.string handler_id));
516
+
("event_type", Js.Unsafe.inject (Js.string event_type));
517
+
("value", match value with
518
+
| Some v -> Js.Unsafe.inject (Js.string v)
519
+
| None -> Js.Unsafe.inject Js.null);
520
+
|] in
521
+
let json = Js.to_string (plain_stringify (Js.Unsafe.obj pairs)) in
522
+
Brr_worker.post t.worker (Js.string json)
418
523
419
524
(** Terminate the worker *)
420
525
let terminate t =
+95
js_top_worker/idl/message.ml
+95
js_top_worker/idl/message.ml
···
67
67
| Errors of { cell_id : int; env_id : string; source : string; filename : string option }
68
68
| CreateEnv of { env_id : string }
69
69
| DestroyEnv of { env_id : string }
70
+
| WidgetEvent of { widget_id : string; handler_id : string; event_type : string; value : string option }
70
71
71
72
(** {1 Worker -> Client messages} *)
72
73
···
92
93
| EvalError of { cell_id : int; message : string }
93
94
| EnvCreated of { env_id : string }
94
95
| EnvDestroyed of { env_id : string }
96
+
| WidgetUpdate of { widget_id : string; view : Widget_view.node }
97
+
| WidgetClear of { widget_id : string }
98
+
| WidgetConfig of { widget_id : string; config : string }
99
+
| WidgetCommand of { widget_id : string; command : string; data : string }
100
+
| WidgetRegisterAdapter of { kind : string; js_code : string }
95
101
96
102
(** {1 JSON helpers} *)
97
103
···
139
145
let get_string_array obj key =
140
146
Array.to_list (Array.map Js.to_string (get_array obj key))
141
147
148
+
(** {1 View node JSON encoding} *)
149
+
150
+
let rec json_of_view_attr (a : Widget_view.attr) =
151
+
match a with
152
+
| Property (k, v) ->
153
+
json_of_obj [("t", json_string "prop"); ("k", json_string k); ("v", json_string v)]
154
+
| Style (k, v) ->
155
+
json_of_obj [("t", json_string "style"); ("k", json_string k); ("v", json_string v)]
156
+
| Class c ->
157
+
json_of_obj [("t", json_string "cls"); ("v", json_string c)]
158
+
| Handler (ev, id) ->
159
+
json_of_obj [("t", json_string "handler"); ("ev", json_string ev); ("id", json_string id)]
160
+
161
+
and json_of_view_node (n : Widget_view.node) =
162
+
match n with
163
+
| Text s ->
164
+
json_of_obj [("t", json_string "txt"); ("v", json_string s)]
165
+
| Element { tag; attrs; children } ->
166
+
json_of_obj [
167
+
("t", json_string "el");
168
+
("tag", json_string tag);
169
+
("a", json_array (List.map (fun a -> Js.Unsafe.inject (json_of_view_attr a)) attrs));
170
+
("c", json_array (List.map (fun c -> Js.Unsafe.inject (json_of_view_node c)) children));
171
+
]
172
+
| Managed { kind; config } ->
173
+
json_of_obj [
174
+
("t", json_string "managed");
175
+
("kind", json_string kind);
176
+
("config", json_string config);
177
+
]
178
+
179
+
let view_attr_of_json obj : Widget_view.attr =
180
+
let t = get_string obj "t" in
181
+
match t with
182
+
| "prop" -> Property (get_string obj "k", get_string obj "v")
183
+
| "style" -> Style (get_string obj "k", get_string obj "v")
184
+
| "cls" -> Class (get_string obj "v")
185
+
| "handler" -> Handler (get_string obj "ev", get_string obj "id")
186
+
| _ -> failwith ("Unknown attr type: " ^ t)
187
+
188
+
let rec view_node_of_json obj : Widget_view.node =
189
+
let t = get_string obj "t" in
190
+
match t with
191
+
| "txt" -> Text (get_string obj "v")
192
+
| "el" ->
193
+
let attrs = Array.to_list (Array.map view_attr_of_json (get_array obj "a")) in
194
+
let children = Array.to_list (Array.map view_node_of_json (get_array obj "c")) in
195
+
Element { tag = get_string obj "tag"; attrs; children }
196
+
| "managed" ->
197
+
Managed { kind = get_string obj "kind"; config = get_string obj "config" }
198
+
| _ -> failwith ("Unknown node type: " ^ t)
199
+
142
200
(** {1 Worker message serialization} *)
143
201
144
202
let json_of_position p =
···
252
310
("type", json_string "env_destroyed");
253
311
("env_id", json_string env_id);
254
312
]
313
+
| WidgetUpdate { widget_id; view } ->
314
+
json_of_obj [
315
+
("type", json_string "widget_update");
316
+
("widget_id", json_string widget_id);
317
+
("view", Js.Unsafe.inject (json_of_view_node view));
318
+
]
319
+
| WidgetClear { widget_id } ->
320
+
json_of_obj [
321
+
("type", json_string "widget_clear");
322
+
("widget_id", json_string widget_id);
323
+
]
324
+
| WidgetConfig { widget_id; config } ->
325
+
json_of_obj [
326
+
("type", json_string "widget_config");
327
+
("widget_id", json_string widget_id);
328
+
("config", json_string config);
329
+
]
330
+
| WidgetCommand { widget_id; command; data } ->
331
+
json_of_obj [
332
+
("type", json_string "widget_command");
333
+
("widget_id", json_string widget_id);
334
+
("command", json_string command);
335
+
("data", json_string data);
336
+
]
337
+
| WidgetRegisterAdapter { kind; js_code } ->
338
+
json_of_obj [
339
+
("type", json_string "widget_register_adapter");
340
+
("kind", json_string kind);
341
+
("js_code", json_string js_code);
342
+
]
255
343
in
256
344
Js.to_string (plain_stringify obj)
257
345
···
303
391
CreateEnv { env_id = get_string obj "env_id" }
304
392
| "destroy_env" ->
305
393
DestroyEnv { env_id = get_string obj "env_id" }
394
+
| "widget_event" ->
395
+
WidgetEvent {
396
+
widget_id = get_string obj "widget_id";
397
+
handler_id = get_string obj "handler_id";
398
+
event_type = get_string obj "event_type";
399
+
value = get_string_opt obj "value";
400
+
}
306
401
| _ ->
307
402
failwith ("Unknown message type: " ^ typ)
308
403
+23
js_top_worker/idl/widget_view.ml
+23
js_top_worker/idl/widget_view.ml
···
1
+
(** Serializable view descriptions for interactive widgets.
2
+
3
+
No closures, no JS references. Event handlers are symbolic
4
+
string identifiers resolved by the worker's handler registry. *)
5
+
6
+
type event_id = string
7
+
8
+
type attr =
9
+
| Property of string * string
10
+
| Style of string * string
11
+
| Class of string
12
+
| Handler of string * event_id (** event name, handler id *)
13
+
14
+
type node =
15
+
| Text of string
16
+
| Element of { tag : string; attrs : attr list; children : node list }
17
+
| Managed of { kind : string; config : string }
18
+
19
+
type event_msg = {
20
+
handler_id : event_id;
21
+
event_type : string;
22
+
value : string option;
23
+
}
+20
js_top_worker/js_top_worker-widget-leaflet.opam
+20
js_top_worker/js_top_worker-widget-leaflet.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-widget"
12
+
]
13
+
build : [
14
+
["dune" "subst"] {pinned}
15
+
["dune" "build" "-p" name "-j" jobs]
16
+
]
17
+
synopsis: "Leaflet.js map widget adapter for js_top_worker"
18
+
description: """
19
+
Provides a Leaflet map adapter that can be #require'd from the toplevel.
20
+
"""
+20
js_top_worker/js_top_worker-widget.opam
+20
js_top_worker/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
+
"""
+1
js_top_worker/lib/dune
+1
js_top_worker/lib/dune
+60
js_top_worker/lib/findlibish.ml
+60
js_top_worker/lib/findlibish.ml
···
17
17
in
18
18
List.map handle_lib libs |> List.flatten
19
19
20
+
(* Packages compiled into the worker binary. When #require loads a package
21
+
that is already linked into the worker, we must NOT call import_scripts on
22
+
its .cma.js — doing so would re-register CMI files that are already in the
23
+
virtual filesystem, causing a Sys_error "file already exists".
24
+
25
+
This list must match the transitive closure of the worker's library deps
26
+
(see example/dune). To regenerate:
27
+
ocamlfind query -recursive -format '%p' \
28
+
js_top_worker-web logs.browser mime_printer tyxml \
29
+
js_top_worker-widget note | sort -u *)
20
30
let preloaded =
21
31
[
22
32
"angstrom";
23
33
"astring";
34
+
"bigstringaf";
35
+
"compiler-libs";
36
+
"compiler-libs.bytecomp";
24
37
"compiler-libs.common";
25
38
"compiler-libs.toplevel";
39
+
"csexp";
26
40
"findlib";
41
+
"findlib.internal";
27
42
"findlib.top";
28
43
"fpath";
44
+
"gen";
45
+
"js_of_ocaml";
29
46
"js_of_ocaml-compiler";
47
+
"js_of_ocaml-compiler.dynlink";
48
+
"js_of_ocaml-compiler.runtime";
49
+
"js_of_ocaml-lwt";
30
50
"js_of_ocaml-ppx";
31
51
"js_of_ocaml-toplevel";
32
52
"js_top_worker";
53
+
"js_top_worker-rpc.message";
54
+
"js_top_worker-web";
55
+
"js_top_worker-widget";
33
56
"logs";
34
57
"logs.browser";
58
+
"lwt";
59
+
"menhirLib";
60
+
"merlin-lib.analysis";
61
+
"merlin-lib.config";
62
+
"merlin-lib.dot_protocol";
63
+
"merlin-lib.extend";
64
+
"merlin-lib.index_format";
35
65
"merlin-lib.kernel";
66
+
"merlin-lib.ocaml_compression";
67
+
"merlin-lib.ocaml_merlin_specific";
36
68
"merlin-lib.ocaml_parsing";
69
+
"merlin-lib.ocaml_preprocess";
70
+
"merlin-lib.ocaml_typing";
71
+
"merlin-lib.ocaml_utils";
72
+
"merlin-lib.os_ipc";
37
73
"merlin-lib.query_commands";
38
74
"merlin-lib.query_protocol";
75
+
"merlin-lib.sherlodoc";
39
76
"merlin-lib.utils";
40
77
"mime_printer";
78
+
"note";
79
+
"ocaml-compiler-libs.common";
80
+
"ocaml-compiler-libs.shadow";
81
+
"ppx_derivers";
82
+
"ppx_deriving.api";
83
+
"ppxlib";
84
+
"ppxlib.ast";
85
+
"ppxlib.astlib";
86
+
"ppxlib.print_diff";
87
+
"ppxlib.stdppx";
88
+
"ppxlib.traverse_builtins";
89
+
"re";
90
+
"sedlex";
91
+
"seq";
92
+
"sexplib0";
93
+
"stdlib-shims";
94
+
"str";
95
+
"stringext";
96
+
"tyxml";
97
+
"tyxml.functor";
98
+
"unix";
41
99
"uri";
100
+
"uutf";
101
+
"yojson";
42
102
]
43
103
44
104
let rec read_libraries_from_pkg_defs ~library_name ~dir meta_uri pkg_expr =
+9
js_top_worker/lib/worker.ml
+9
js_top_worker/lib/worker.ml
···
334
334
| Error (Impl.InternalError msg) ->
335
335
send_message (Msg.InitError { message = msg }))
336
336
337
+
| Msg.WidgetEvent { widget_id; handler_id; value; _ } ->
338
+
Widget.handle_event ~widget_id ~handler_id ~value;
339
+
Lwt.return_unit
340
+
337
341
let run () =
338
342
let open Js_of_ocaml in
339
343
try
···
341
345
342
346
Logs.set_reporter (Logs_browser.console_reporter ());
343
347
Logs.set_level (Some Logs.Debug);
348
+
349
+
(* Initialize Widget module sender *)
350
+
Widget.set_sender (fun json ->
351
+
Jslib.log "Widget sending: %s" json;
352
+
Js_of_ocaml.Worker.post_message (Js_of_ocaml.Js.string json));
344
353
345
354
Js_of_ocaml.Worker.set_onmessage (fun x ->
346
355
let s = Js_of_ocaml.Js.to_string x in
+4
js_top_worker/widget-leaflet/dune
+4
js_top_worker/widget-leaflet/dune
+69
js_top_worker/widget-leaflet/widget_leaflet.ml
+69
js_top_worker/widget-leaflet/widget_leaflet.ml
···
1
+
let leaflet_adapter_js = {js|
2
+
(function() {
3
+
var CSS_URL = "https://unpkg.com/leaflet@1.9.4/dist/leaflet.css";
4
+
var JS_URL = "https://unpkg.com/leaflet@1.9.4/dist/leaflet.js";
5
+
function ensureCSS(url) {
6
+
if (!document.querySelector("link[href='" + url + "']")) {
7
+
var l = document.createElement("link");
8
+
l.rel = "stylesheet"; l.href = url;
9
+
document.head.appendChild(l);
10
+
}
11
+
}
12
+
function ensureScript(url, cb) {
13
+
if (window.L) return cb();
14
+
var s = document.createElement("script");
15
+
s.src = url; s.onload = cb;
16
+
document.body.appendChild(s);
17
+
}
18
+
return {
19
+
create: function(container, config, send) {
20
+
var state = { map: null, geojsonLayer: null };
21
+
ensureCSS(CSS_URL);
22
+
ensureScript(JS_URL, function() {
23
+
var cfg = JSON.parse(config);
24
+
container.style.height = cfg.height || "400px";
25
+
var div = document.createElement("div");
26
+
div.style.cssText = "width:100%;height:100%";
27
+
container.appendChild(div);
28
+
var map = L.map(div).setView(cfg.center, cfg.zoom);
29
+
L.tileLayer(cfg.tileUrl || "https://tile.openstreetmap.org/{z}/{x}/{y}.png", {
30
+
maxZoom: 19, attribution: "© OpenStreetMap"
31
+
}).addTo(map);
32
+
map.on("click", function(e) {
33
+
send("click", JSON.stringify({lat: e.latlng.lat, lng: e.latlng.lng}));
34
+
});
35
+
map.on("moveend", function() {
36
+
var c = map.getCenter(), z = map.getZoom(), b = map.getBounds();
37
+
send("moveend", JSON.stringify({
38
+
center: [c.lat, c.lng], zoom: z,
39
+
bounds: {south: b.getSouthWest().lat, west: b.getSouthWest().lng,
40
+
north: b.getNorthEast().lat, east: b.getNorthEast().lng}
41
+
}));
42
+
});
43
+
state.map = map;
44
+
});
45
+
return state;
46
+
},
47
+
update: function(state, config) {
48
+
if (!state.map) return;
49
+
var cfg = JSON.parse(config);
50
+
if (cfg.center) state.map.setView(cfg.center, cfg.zoom || state.map.getZoom());
51
+
},
52
+
command: function(state, cmd, data) {
53
+
if (!state.map) return;
54
+
var d = JSON.parse(data);
55
+
if (cmd === "flyTo") state.map.flyTo(L.latLng(d.lat, d.lng), d.zoom || state.map.getZoom());
56
+
else if (cmd === "fitBounds") state.map.fitBounds(d);
57
+
else if (cmd === "setData") {
58
+
if (state.geojsonLayer) state.map.removeLayer(state.geojsonLayer);
59
+
state.geojsonLayer = L.geoJSON(d).addTo(state.map);
60
+
}
61
+
else if (cmd === "invalidateSize") state.map.invalidateSize();
62
+
},
63
+
destroy: function(state) { if (state.map) state.map.remove(); }
64
+
};
65
+
})()
66
+
|js}
67
+
68
+
let register () =
69
+
Widget.register_adapter ~kind:"leaflet-map" ~js:leaflet_adapter_js
+3
js_top_worker/widget-leaflet/widget_leaflet.mli
+3
js_top_worker/widget-leaflet/widget_leaflet.mli
+4
js_top_worker/widget/dune
+4
js_top_worker/widget/dune
+57
js_top_worker/widget/widget.ml
+57
js_top_worker/widget/widget.ml
···
1
+
open Js_top_worker_message.Message
2
+
3
+
(** Re-export Widget_view so user code can write [Widget.View.Element] etc. *)
4
+
module View = Js_top_worker_message.Widget_view
5
+
6
+
(* --- Send function, injected by worker at startup --- *)
7
+
8
+
let sender : (string -> unit) ref = ref (fun _ -> ())
9
+
10
+
let set_sender f = sender := f
11
+
12
+
let send_msg msg =
13
+
let json = json_of_worker_msg msg in
14
+
!sender json
15
+
16
+
(* --- Handler registry --- *)
17
+
18
+
type widget_state = {
19
+
handlers : (string * (string option -> unit)) list;
20
+
}
21
+
22
+
let widgets : (string, widget_state) Hashtbl.t = Hashtbl.create 16
23
+
24
+
(* --- Public API --- *)
25
+
26
+
let display ~id ~handlers view =
27
+
Hashtbl.replace widgets id { handlers };
28
+
send_msg (WidgetUpdate { widget_id = id; view })
29
+
30
+
let update ~id view =
31
+
send_msg (WidgetUpdate { widget_id = id; view })
32
+
33
+
let clear ~id =
34
+
Hashtbl.remove widgets id;
35
+
send_msg (WidgetClear { widget_id = id })
36
+
37
+
let 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
+
42
+
let update_config ~id config =
43
+
send_msg (WidgetConfig { widget_id = id; config })
44
+
45
+
let command ~id cmd data =
46
+
send_msg (WidgetCommand { widget_id = id; command = cmd; data })
47
+
48
+
let register_adapter ~kind ~js =
49
+
send_msg (WidgetRegisterAdapter { kind; js_code = js })
50
+
51
+
let 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
+90
js_top_worker/widget/widget.mli
+90
js_top_worker/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
+
{!View.node} trees. Event handlers in the view are symbolic string
5
+
identifiers — when the user interacts with a widget, the client sends
6
+
the handler ID and input value back to the worker, where the registered
7
+
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
+
let open Widget.View in
16
+
Widget.display ~id:"my-slider"
17
+
~handlers:["x", (fun v ->
18
+
send (int_of_string (Option.get v)))]
19
+
(Element { tag = "input";
20
+
attrs = [Property ("type", "range")];
21
+
children = [] })
22
+
23
+
(* Wire up automatic updates via Note: *)
24
+
let _logr = Note.S.log
25
+
(Note.S.map (fun v -> ... build view ...) s)
26
+
(Widget.update ~id:"my-slider")
27
+
]} *)
28
+
29
+
(** Re-export of {!Js_top_worker_message.Widget_view} for convenient access
30
+
from toplevel code. Use [let open Widget.View in ...] to access
31
+
constructors like [Element], [Text], [Property], [Handler], etc. *)
32
+
module View = Js_top_worker_message.Widget_view
33
+
34
+
val display :
35
+
id:string ->
36
+
handlers:(string * (string option -> unit)) list ->
37
+
View.node ->
38
+
unit
39
+
(** [display ~id ~handlers view] registers a widget with the given [id],
40
+
installs [handlers] for routing incoming events, and sends the
41
+
initial [view] to the client. If a widget with this [id] already
42
+
exists, it is replaced. *)
43
+
44
+
val update : id:string -> View.node -> unit
45
+
(** [update ~id view] sends an updated view for an existing widget.
46
+
The handler map is not changed. *)
47
+
48
+
val clear : id:string -> unit
49
+
(** [clear ~id] removes the widget and its handlers. Sends a
50
+
WidgetClear message to the client. *)
51
+
52
+
val display_managed :
53
+
id:string ->
54
+
kind:string ->
55
+
config:string ->
56
+
handlers:(string * (string option -> unit)) list ->
57
+
unit
58
+
(** [display_managed ~id ~kind ~config ~handlers] registers a managed widget.
59
+
The client delegates rendering to the adapter registered for [kind].
60
+
[config] is a JSON string interpreted by the adapter.
61
+
[handlers] route incoming events, same as {!display}. *)
62
+
63
+
val update_config : id:string -> string -> unit
64
+
(** [update_config ~id config] sends an updated config to a managed widget.
65
+
The adapter decides how to reconcile the change (e.g. flyTo, setData). *)
66
+
67
+
val command : id:string -> string -> string -> unit
68
+
(** [command ~id cmd data] sends an imperative command to a managed widget.
69
+
[cmd] is the command name, [data] is a JSON string payload.
70
+
Use for one-shot actions like animations that don't represent state. *)
71
+
72
+
val register_adapter : kind:string -> js:string -> unit
73
+
(** [register_adapter ~kind ~js] sends a JavaScript adapter to the client.
74
+
The JS code must be an IIFE that returns an object with methods:
75
+
- [create(container, config, send)] — creates the widget, returns state
76
+
- [update(state, config)] — reconciles a config change
77
+
- [command(state, cmd, data)] — handles an imperative command
78
+
- [destroy(state)] — cleans up
79
+
where [send(handler_id, value)] sends an event back to the worker. *)
80
+
81
+
val handle_event :
82
+
widget_id:string -> handler_id:string -> value:string option -> unit
83
+
(** [handle_event ~widget_id ~handler_id ~value] routes an incoming
84
+
event to the registered handler. Called by the worker message loop
85
+
when a WidgetEvent is received. *)
86
+
87
+
val set_sender : (string -> unit) -> unit
88
+
(** [set_sender f] installs the function used to send JSON strings to
89
+
the client. Called once by the worker at startup. The function [f]
90
+
should call [Worker.post_message]. *)
+61
odoc-interactive-extension/doc/demo_map.mld
+61
odoc-interactive-extension/doc/demo_map.mld
···
1
+
{0 Interactive Map Demo}
2
+
3
+
@x-ocaml.universe ./universe
4
+
@x-ocaml.worker ./universe/worker.js
5
+
6
+
This page demonstrates a managed Leaflet map widget with FRP signals
7
+
and commands.
8
+
9
+
{@ocaml[
10
+
#require "note";;
11
+
#require "js_top_worker-widget";;
12
+
#require "js_top_worker-widget-leaflet";;
13
+
Widget_leaflet.register ();;
14
+
]}
15
+
16
+
{1 Map Widget}
17
+
18
+
Click on the map to see coordinates. The click position is captured
19
+
as a [Note] event and displayed as a signal:
20
+
21
+
{@ocaml[
22
+
let click_e, send_click = Note.E.create ()
23
+
let last_click = Note.S.hold "No clicks yet" click_e
24
+
25
+
let () =
26
+
Widget.display_managed ~id:"mymap"
27
+
~kind:"leaflet-map"
28
+
~config:{| {"center": [51.505, -0.09], "zoom": 13, "height": "400px"} |}
29
+
~handlers:[
30
+
"click", (fun v ->
31
+
let json = Option.get v in
32
+
send_click (Printf.sprintf "Clicked at: %s" json));
33
+
]
34
+
35
+
let click_view text =
36
+
let open Widget.View in
37
+
Element { tag = "div"; attrs = [Style ("padding", "8px")];
38
+
children = [Text text] }
39
+
40
+
let () = Widget.display ~id:"click-info" ~handlers:[] (click_view "No clicks yet")
41
+
let _logr = Note.S.log (Note.S.map click_view last_click)
42
+
(Widget.update ~id:"click-info")
43
+
let () = Note.Logr.hold _logr
44
+
]}
45
+
46
+
{1 Fly To Command}
47
+
48
+
This cell sends a command to the map — clicking the button flies to Paris:
49
+
50
+
{@ocaml[
51
+
let fly_view =
52
+
let open Widget.View in
53
+
Element { tag = "button"; attrs = [Handler ("click", "fly")];
54
+
children = [Text "Fly to Paris"] }
55
+
56
+
let () = Widget.display ~id:"fly-btn" ~handlers:[
57
+
"fly", (fun _ ->
58
+
Widget.command ~id:"mymap" "flyTo"
59
+
{| {"lat": 48.8566, "lng": 2.3522, "zoom": 14} |})
60
+
] fly_view
61
+
]}
+125
odoc-interactive-extension/doc/demo_widgets.mld
+125
odoc-interactive-extension/doc/demo_widgets.mld
···
1
+
{0 Widget Demo}
2
+
3
+
@x-ocaml.universe ./universe
4
+
@x-ocaml.worker ./universe/worker.js
5
+
6
+
This page demonstrates interactive FRP widgets powered by
7
+
[Widget] and [Note].
8
+
9
+
{@ocaml[
10
+
#require "note";;
11
+
#require "js_top_worker-widget";;
12
+
]}
13
+
14
+
{1 Static Widget}
15
+
16
+
A simple widget that renders static HTML:
17
+
18
+
{@ocaml[
19
+
let open Widget.View in
20
+
Widget.display ~id:"hello" ~handlers:[]
21
+
(Element { tag = "div"; attrs = [];
22
+
children = [Text "Hello from an OCaml widget!"] })
23
+
]}
24
+
25
+
{1 Counter (FRP with Note)}
26
+
27
+
A counter driven by [Note] signals. Pressing the buttons sends events
28
+
back to the worker, which updates the signal:
29
+
30
+
{@ocaml[
31
+
let inc_e, send_inc = Note.E.create ()
32
+
let dec_e, send_dec = Note.E.create ()
33
+
34
+
let count =
35
+
let delta = Note.E.select [
36
+
Note.E.map (fun () n -> n + 1) inc_e;
37
+
Note.E.map (fun () n -> n - 1) dec_e;
38
+
] in
39
+
Note.S.accum 0 delta
40
+
41
+
let counter_view n =
42
+
let open Widget.View in
43
+
Element { tag = "div"; attrs = [Class "counter"]; children = [
44
+
Element { tag = "button";
45
+
attrs = [Handler ("click", "dec")];
46
+
children = [Text "-"] };
47
+
Element { tag = "span";
48
+
attrs = [Style ("margin", "0 1em")];
49
+
children = [Text (string_of_int n)] };
50
+
Element { tag = "button";
51
+
attrs = [Handler ("click", "inc")];
52
+
children = [Text "+"] };
53
+
] }
54
+
55
+
let () =
56
+
Widget.display ~id:"counter"
57
+
~handlers:[
58
+
"inc", (fun _ -> send_inc ());
59
+
"dec", (fun _ -> send_dec ());
60
+
]
61
+
(counter_view 0)
62
+
63
+
let _logr = Note.S.log
64
+
(Note.S.map counter_view count)
65
+
(Widget.update ~id:"counter")
66
+
let () = Note.Logr.hold _logr
67
+
]}
68
+
69
+
{1 Slider}
70
+
71
+
An input slider that drives a signal. Moving the slider sends the value
72
+
back to the worker:
73
+
74
+
{@ocaml[
75
+
let x_e, send_x = Note.E.create ()
76
+
let x = Note.S.hold 50 x_e
77
+
78
+
let slider_view v =
79
+
let open Widget.View in
80
+
Element { tag = "div"; attrs = []; children = [
81
+
Element { tag = "label"; attrs = [];
82
+
children = [Text (Printf.sprintf "X: %d" v)] };
83
+
Element { tag = "input"; attrs = [
84
+
Property ("type", "range");
85
+
Property ("min", "0");
86
+
Property ("max", "100");
87
+
Property ("value", string_of_int v);
88
+
Handler ("input", "x");
89
+
]; children = [] };
90
+
] }
91
+
92
+
let () =
93
+
Widget.display ~id:"slider"
94
+
~handlers:["x", (fun v ->
95
+
send_x (int_of_string (Option.get v)))]
96
+
(slider_view 50)
97
+
98
+
let _logr2 = Note.S.log
99
+
(Note.S.map slider_view x)
100
+
(Widget.update ~id:"slider")
101
+
let () = Note.Logr.hold _logr2
102
+
]}
103
+
104
+
{1 Cross-cell Derived Widget}
105
+
106
+
This widget derives from the slider signal [x] defined above. Moving
107
+
the slider updates this widget too:
108
+
109
+
{@ocaml[
110
+
let doubled_view v =
111
+
let open Widget.View in
112
+
Element { tag = "div"; attrs = []; children = [
113
+
Text (Printf.sprintf "2x = %d" (v * 2))
114
+
] }
115
+
116
+
let () =
117
+
Widget.display ~id:"doubled"
118
+
~handlers:[]
119
+
(doubled_view (Note.S.value x))
120
+
121
+
let _logr3 = Note.S.log
122
+
(Note.S.map doubled_view x)
123
+
(Widget.update ~id:"doubled")
124
+
let () = Note.Logr.hold _logr3
125
+
]}
+26
-1
x-ocaml/src/jtw_client.cppo.ml
+26
-1
x-ocaml/src/jtw_client.cppo.ml
···
42
42
let make url =
43
43
let effective_url = make_effective_url url in
44
44
let client = Jtw.create effective_url in
45
-
{ client; url; init_config = None; on_message_cb = (fun _ -> ()) }
45
+
let t = { client; url; init_config = None; on_message_cb = (fun _ -> ()) } in
46
+
(* Wire widget rendering: forward widget messages from the worker to the
47
+
DOM renderer, and send widget events back to the worker. *)
48
+
let send_fn ~widget_id ~handler_id ~event_type ~value =
49
+
Jtw.send_widget_event client ~widget_id ~handler_id ~event_type ~value
50
+
in
51
+
Jtw.set_on_widget_update client (fun widget_id view_any ->
52
+
(* view_any is Js.Unsafe.any — coerce to Jv.t (they are the same repr) *)
53
+
let view_jv : Jv.t = Obj.magic view_any in
54
+
Widget_render.update_widget ~send:send_fn widget_id view_jv);
55
+
Jtw.set_on_widget_clear client (fun widget_id ->
56
+
Widget_render.clear_widget widget_id);
57
+
Jtw.set_on_widget_config client (fun widget_id config ->
58
+
Widget_render.config_widget widget_id config);
59
+
Jtw.set_on_widget_command client (fun widget_id cmd data ->
60
+
Widget_render.command_widget widget_id cmd data);
61
+
Jtw.set_on_widget_register_adapter client (fun kind js_code ->
62
+
Widget_render.register_js_adapter ~send:send_fn kind js_code);
63
+
t
46
64
47
65
let on_message t fn = t.on_message_cb <- fn
48
66
···
165
183
let post t (req : X_protocol.request) =
166
184
match req with
167
185
| X_protocol.Eval (id, _line_number, code) ->
186
+
(* Tell widget_render which cell is executing so widgets are placed
187
+
right after this cell's <x-ocaml> element in the DOM. *)
188
+
let doc = Brr.Document.to_jv Brr.G.document in
189
+
let cells = Jv.call doc "querySelectorAll" [| Jv.of_string "x-ocaml" |] in
190
+
let cell_el = Jv.call cells "item" [| Jv.of_int id |] in
191
+
if not (Jv.is_null cell_el) then
192
+
Widget_render.set_active_cell cell_el;
168
193
let stream = Jtw.eval_stream t.client code in
169
194
Lwt.async (fun () ->
170
195
Lwt.catch (fun () ->
+247
x-ocaml/src/widget_render.ml
+247
x-ocaml/src/widget_render.ml
···
1
+
(** Widget renderer for x-ocaml.
2
+
3
+
Renders view node JSON (from js_top_worker widget protocol) into real DOM
4
+
elements using Brr, and wires event handlers back to the worker.
5
+
6
+
Supports two kinds of widgets:
7
+
- Element/Text views: declarative DOM trees, fully replaced on each update
8
+
- Managed widgets: delegate to registered adapters (e.g. Leaflet maps) that
9
+
manage their own DOM and respond to config updates and commands *)
10
+
11
+
open Brr
12
+
13
+
(** Type alias for the function that sends widget events back to the worker. *)
14
+
type send_fn =
15
+
widget_id:string -> handler_id:string ->
16
+
event_type:string -> value:string option -> unit
17
+
18
+
(** A managed widget adapter. Registered client-side per [kind].
19
+
All functions receive and return raw Jv.t values (JS objects). *)
20
+
type adapter = {
21
+
create : Jv.t -> string -> send_fn -> Jv.t;
22
+
(** [create container config send] creates the widget and returns adapter state *)
23
+
update : Jv.t -> string -> unit;
24
+
(** [update state config] reconciles a config change *)
25
+
command : Jv.t -> string -> string -> unit;
26
+
(** [command state cmd data] handles an imperative command *)
27
+
destroy : Jv.t -> unit;
28
+
(** [destroy state] cleans up *)
29
+
}
30
+
31
+
(** Global adapter registry: kind -> adapter *)
32
+
let adapters : (string, adapter) Hashtbl.t = Hashtbl.create 8
33
+
34
+
(** Register an adapter for the given [kind] string. *)
35
+
let register_adapter kind adapter =
36
+
Hashtbl.replace adapters kind adapter
37
+
38
+
(** Register an adapter from JavaScript code.
39
+
The JS must be an IIFE returning [{create, update, command, destroy}].
40
+
[send] in JS is [send(handler_id, value_string)]. *)
41
+
let register_js_adapter ~(send : send_fn) kind js_code =
42
+
let obj = Jv.call Jv.global "eval" [| Jv.of_string js_code |] in
43
+
let adapter = {
44
+
create = (fun container_jv config_str send_fn ->
45
+
let js_send = Jv.repr (fun handler_id value ->
46
+
let hid = Jv.to_string handler_id in
47
+
let v =
48
+
if Jv.is_null value || Jv.is_undefined value then None
49
+
else Some (Jv.to_string value)
50
+
in
51
+
send_fn ~widget_id:"" ~handler_id:hid ~event_type:hid ~value:v
52
+
) in
53
+
Jv.call obj "create" [| container_jv; Jv.of_string config_str; js_send |]);
54
+
update = (fun state config_str ->
55
+
Jv.call obj "update" [| state; Jv.of_string config_str |] |> ignore);
56
+
command = (fun state cmd data ->
57
+
Jv.call obj "command" [| state; Jv.of_string cmd; Jv.of_string data |] |> ignore);
58
+
destroy = (fun state ->
59
+
Jv.call obj "destroy" [| state |] |> ignore);
60
+
} in
61
+
ignore send; (* send is captured by the adapter's create wrapper at call time *)
62
+
Hashtbl.replace adapters kind adapter
63
+
64
+
(** Per-widget state *)
65
+
type widget_entry = {
66
+
container : El.t;
67
+
widget_id : string;
68
+
managed : (string * Jv.t) option;
69
+
(** For managed widgets: (kind, adapter_state) *)
70
+
}
71
+
72
+
(** Global registry of active widgets *)
73
+
let widgets : (string, widget_entry) Hashtbl.t = Hashtbl.create 16
74
+
75
+
(** The current anchor element — new widget containers are inserted after this.
76
+
Set by [set_active_cell] before each cell eval begins. *)
77
+
let active_cell : Jv.t option ref = ref None
78
+
79
+
(** Set the currently active cell element. Call this before each eval so that
80
+
any widgets created during that eval are placed right after the cell. *)
81
+
let set_active_cell (el : Jv.t) = active_cell := Some el
82
+
83
+
(** Recursively render a view node JSON object to a DOM element.
84
+
[send] is called when an event handler fires. *)
85
+
let rec render_node ~widget_id ~(send : send_fn) (node : Jv.t) : El.t =
86
+
let t = Jv.to_string (Jv.get node "t") in
87
+
match t with
88
+
| "txt" ->
89
+
let v = Jv.to_string (Jv.get node "v") in
90
+
El.span [ El.txt' v ]
91
+
| "el" ->
92
+
let tag = Jv.to_string (Jv.get node "tag") in
93
+
let attrs_arr =
94
+
let a = Jv.get node "a" in
95
+
if Jv.is_none a || Jv.is_undefined a then [||]
96
+
else Jv.to_jv_array a
97
+
in
98
+
let children_arr =
99
+
let c = Jv.get node "c" in
100
+
if Jv.is_none c || Jv.is_undefined c then [||]
101
+
else Jv.to_jv_array c
102
+
in
103
+
let el = El.v (Jstr.v tag) [] in
104
+
(* Apply attributes *)
105
+
Array.iter (fun attr ->
106
+
let at = Jv.to_string (Jv.get attr "t") in
107
+
match at with
108
+
| "prop" ->
109
+
let k = Jv.to_string (Jv.get attr "k") in
110
+
let v = Jv.to_string (Jv.get attr "v") in
111
+
El.set_at (Jstr.v k) (Some (Jstr.v v)) el
112
+
| "style" ->
113
+
let k = Jv.to_string (Jv.get attr "k") in
114
+
let v = Jv.to_string (Jv.get attr "v") in
115
+
El.set_inline_style (Jstr.v k) (Jstr.v v) el
116
+
| "cls" ->
117
+
let v = Jv.to_string (Jv.get attr "v") in
118
+
El.set_class (Jstr.v v) true el
119
+
| "handler" ->
120
+
let ev_name = Jv.to_string (Jv.get attr "ev") in
121
+
let handler_id = Jv.to_string (Jv.get attr "id") in
122
+
let ev_type = Ev.Type.create (Jstr.v ev_name) in
123
+
let _listener = Ev.listen ev_type (fun _ev ->
124
+
let is_input =
125
+
let tn = Jstr.to_string (El.tag_name el) in
126
+
tn = "input" || tn = "select" || tn = "textarea"
127
+
in
128
+
let value =
129
+
if is_input then
130
+
Some (Jv.to_string (Jv.get (El.to_jv el) "value"))
131
+
else None
132
+
in
133
+
send ~widget_id ~handler_id ~event_type:ev_name ~value
134
+
) (El.as_target el) in
135
+
()
136
+
| _ -> ()
137
+
) attrs_arr;
138
+
(* Append children *)
139
+
Array.iter (fun child ->
140
+
let child_el = render_node ~widget_id ~send child in
141
+
El.append_children el [ child_el ]
142
+
) children_arr;
143
+
el
144
+
| _ ->
145
+
El.span []
146
+
147
+
(** Find or create a widget container. New containers are inserted right after
148
+
the currently active x-ocaml cell element, so widgets appear inline with
149
+
their code. On subsequent updates the existing container is reused in place. *)
150
+
let find_or_create_container widget_id =
151
+
match Hashtbl.find_opt widgets widget_id with
152
+
| Some entry -> entry.container
153
+
| None ->
154
+
let container = El.div ~at:[ At.class' (Jstr.v "widget-container") ] [] in
155
+
El.set_at (Jstr.v "data-widget-id") (Some (Jstr.v widget_id)) container;
156
+
(* Insert after the active cell element, or fall back to document.body *)
157
+
(match !active_cell with
158
+
| Some cell_jv ->
159
+
(* Walk past any existing widget-containers that are already siblings
160
+
right after this cell, so multiple widgets from the same cell
161
+
stack in creation order. *)
162
+
let next_sibling = ref (Jv.get cell_jv "nextElementSibling") in
163
+
let insert_after = ref cell_jv in
164
+
while not (Jv.is_null !next_sibling || Jv.is_undefined !next_sibling) &&
165
+
(let cls = Jv.to_jstr (Jv.get !next_sibling "className") in
166
+
Jstr.equal cls (Jstr.v "widget-container")) do
167
+
insert_after := !next_sibling;
168
+
next_sibling := Jv.get !next_sibling "nextElementSibling"
169
+
done;
170
+
Jv.call !insert_after "insertAdjacentElement"
171
+
[| Jv.of_string "afterend"; El.to_jv container |] |> ignore
172
+
| None ->
173
+
(* No active cell — fall back to document.body *)
174
+
let body = El.to_jv (Document.body G.document) in
175
+
Jv.call body "appendChild" [| El.to_jv container |] |> ignore);
176
+
let entry = { container; widget_id; managed = None } in
177
+
Hashtbl.replace widgets widget_id entry;
178
+
container
179
+
180
+
(** Update (or create) a widget with a new view. *)
181
+
let update_widget ~(send : send_fn) widget_id (view_json : Jv.t) =
182
+
let t = Jv.to_string (Jv.get view_json "t") in
183
+
if t = "managed" then begin
184
+
let kind = Jv.to_string (Jv.get view_json "kind") in
185
+
let config = Jv.to_string (Jv.get view_json "config") in
186
+
match Hashtbl.find_opt widgets widget_id with
187
+
| Some entry when entry.managed <> None ->
188
+
(* Already created — just update config *)
189
+
let (_k, state) = Option.get entry.managed in
190
+
(match Hashtbl.find_opt adapters kind with
191
+
| Some adapter -> adapter.update state config
192
+
| None -> ())
193
+
| _ ->
194
+
(* First render — create via adapter *)
195
+
let container = find_or_create_container widget_id in
196
+
(match Hashtbl.find_opt adapters kind with
197
+
| None ->
198
+
(* No adapter registered — render an error message *)
199
+
El.set_children container
200
+
[El.span [El.txt' (Printf.sprintf "No adapter for '%s'" kind)]]
201
+
| Some adapter ->
202
+
(* Wrap send so the adapter doesn't need to know its widget_id *)
203
+
let wrapped_send ~widget_id:_ ~handler_id ~event_type ~value =
204
+
send ~widget_id ~handler_id ~event_type ~value
205
+
in
206
+
let state = adapter.create (El.to_jv container) config wrapped_send in
207
+
let entry = { container; widget_id; managed = Some (kind, state) } in
208
+
Hashtbl.replace widgets widget_id entry)
209
+
end else begin
210
+
(* Existing Element/Text path — full DOM replacement *)
211
+
let container = find_or_create_container widget_id in
212
+
El.set_children container [];
213
+
let dom = render_node ~widget_id ~send view_json in
214
+
El.append_children container [ dom ]
215
+
end
216
+
217
+
(** Update config for a managed widget. *)
218
+
let config_widget widget_id config =
219
+
match Hashtbl.find_opt widgets widget_id with
220
+
| Some { managed = Some (kind, state); _ } ->
221
+
(match Hashtbl.find_opt adapters kind with
222
+
| Some adapter -> adapter.update state config
223
+
| None -> ())
224
+
| _ -> ()
225
+
226
+
(** Send a command to a managed widget. *)
227
+
let command_widget widget_id cmd data =
228
+
match Hashtbl.find_opt widgets widget_id with
229
+
| Some { managed = Some (kind, state); _ } ->
230
+
(match Hashtbl.find_opt adapters kind with
231
+
| Some adapter -> adapter.command state cmd data
232
+
| None -> ())
233
+
| _ -> ()
234
+
235
+
(** Remove a widget and its container. Calls adapter destroy for managed widgets. *)
236
+
let clear_widget widget_id =
237
+
match Hashtbl.find_opt widgets widget_id with
238
+
| Some entry ->
239
+
(match entry.managed with
240
+
| Some (kind, state) ->
241
+
(match Hashtbl.find_opt adapters kind with
242
+
| Some adapter -> adapter.destroy state
243
+
| None -> ())
244
+
| None -> ());
245
+
El.remove entry.container;
246
+
Hashtbl.remove widgets widget_id
247
+
| None -> ()