forked from
anil.recoil.org/monopam-myspace
My aggregated monorepo of OCaml code, automaintained
feat(x-ocaml): wire jtw backend and enable type-on-hover in playground
- Fix client.ml absolute_url to handle root-relative paths (/ prefix)
using window.location.origin instead of page directory path
- Abstract merlin_ext.ml to use a post function closure instead of
concrete Client.t, decoupling from specific backend
- Update cell.ml/mli to accept eval/fmt/post function closures
instead of Client.t, and split init/start to avoid synchronous
response race condition with jtw backend
- Wire x_ocaml.ml to read backend attribute and dispatch through
Backend module (jtw or builtin)
- Add W.setup call after W.init in jtw_client to load stdlib
- Create rpc_worker.ml: full-featured JSON-RPC worker combining
the complete S module (findlibish, stdlib) with JSON-RPC protocol
Verified: code execution and Merlin type-on-hover both work in the
scrollycode playground overlay (hovering shows type tooltips like
"type bool = false | true").
Co-Authored-By: Claude Opus 4.6 <noreply@anthropic.com>
+156
-30
+11
js_top_worker/example/dune
+11
js_top_worker/example/dune
···
41
41
(libraries js_top_worker-web logs.browser mime_printer tyxml))
42
42
43
43
(executable
44
+
(name rpc_worker)
45
+
(modes js)
46
+
(modules rpc_worker)
47
+
(link_flags (-linkall))
48
+
(preprocess (pps js_of_ocaml-ppx))
49
+
(js_of_ocaml
50
+
(javascript_files ../lib/stubs.js)
51
+
(flags --effects=disabled --toplevel --opt 3 +toplevel.js +dynlink.js))
52
+
(libraries js_top_worker js_top_worker-web js_top_worker-rpc logs.browser mime_printer tyxml))
53
+
54
+
(executable
44
55
(name unix_worker)
45
56
(public_name unix_worker)
46
57
(modes byte)
+92
js_top_worker/example/rpc_worker.ml
+92
js_top_worker/example/rpc_worker.ml
···
1
+
(** Full-featured JSON-RPC worker for x-ocaml integration.
2
+
3
+
Uses the same full S module as worker.ml (with Findlibish, sync/async
4
+
get, etc.) but speaks JSON-RPC instead of the message protocol. *)
5
+
6
+
open Js_top_worker_rpc
7
+
open Js_top_worker
8
+
module Server = Toplevel_api_gen.Make (Impl.IdlM.GenServer ())
9
+
10
+
let server process e =
11
+
let _, id, call = Jsonrpc.version_id_and_call_of_string e in
12
+
Lwt.bind (process call) (fun response ->
13
+
let rtxt = Jsonrpc.string_of_response ~id response in
14
+
Js_of_ocaml.Worker.post_message (Js_of_ocaml.Js.string rtxt);
15
+
Lwt.return ())
16
+
17
+
module S : Impl.S = struct
18
+
type findlib_t = Js_top_worker_web.Findlibish.t
19
+
20
+
let capture : (unit -> 'a) -> unit -> Impl.captured * 'a =
21
+
fun f () ->
22
+
let stdout_buff = Buffer.create 1024 in
23
+
let stderr_buff = Buffer.create 1024 in
24
+
Js_of_ocaml.Sys_js.set_channel_flusher stdout
25
+
(Buffer.add_string stdout_buff);
26
+
Js_of_ocaml.Sys_js.set_channel_flusher stderr
27
+
(Buffer.add_string stderr_buff);
28
+
let x = f () in
29
+
let captured =
30
+
{
31
+
Impl.stdout = Buffer.contents stdout_buff;
32
+
stderr = Buffer.contents stderr_buff;
33
+
}
34
+
in
35
+
(captured, x)
36
+
37
+
let sync_get = Js_top_worker_web.Jslib.sync_get
38
+
let async_get = Js_top_worker_web.Jslib.async_get
39
+
40
+
let create_file ~name ~content =
41
+
try Js_of_ocaml.Sys_js.create_file ~name ~content
42
+
with Sys_error _ -> ()
43
+
44
+
let get_stdlib_dcs uri =
45
+
Js_top_worker_web.Findlibish.fetch_dynamic_cmis sync_get uri
46
+
|> Result.to_list
47
+
48
+
let import_scripts urls =
49
+
let absolute_urls = List.map Js_top_worker_web.Jslib.map_url urls in
50
+
Js_of_ocaml.Worker.import_scripts absolute_urls
51
+
52
+
let findlib_init = Js_top_worker_web.Findlibish.init async_get
53
+
54
+
let require b v = function
55
+
| [] -> []
56
+
| packages ->
57
+
Js_top_worker_web.Findlibish.require ~import_scripts sync_get b v
58
+
packages
59
+
60
+
let init_function func_name =
61
+
let open Js_of_ocaml in
62
+
let func = Js.Unsafe.js_expr func_name in
63
+
fun () -> Js.Unsafe.fun_call func [| Js.Unsafe.inject Dom_html.window |]
64
+
65
+
let path = "/static/cmis"
66
+
end
67
+
68
+
module M = Impl.Make (S)
69
+
70
+
let run () =
71
+
let open Js_of_ocaml in
72
+
let open M in
73
+
Console.console##log (Js.string "RPC worker starting...");
74
+
Logs.set_reporter (Logs_browser.console_reporter ());
75
+
Logs.set_level (Some Logs.Debug);
76
+
Server.init (Impl.IdlM.T.lift init);
77
+
Server.create_env (Impl.IdlM.T.lift create_env);
78
+
Server.destroy_env (Impl.IdlM.T.lift destroy_env);
79
+
Server.list_envs (Impl.IdlM.T.lift list_envs);
80
+
Server.setup (Impl.IdlM.T.lift setup);
81
+
Server.exec execute;
82
+
Server.complete_prefix complete_prefix;
83
+
Server.query_errors query_errors;
84
+
Server.type_enclosing type_enclosing;
85
+
Server.exec_toplevel exec_toplevel;
86
+
let rpc_fn = Impl.IdlM.server Server.implementation in
87
+
Worker.set_onmessage (fun x ->
88
+
let s = Js.to_string x in
89
+
ignore (server rpc_fn s));
90
+
Console.console##log (Js.string "RPC worker ready")
91
+
92
+
let () = run ()
+11
-7
x-ocaml/src/cell.ml
+11
-7
x-ocaml/src/cell.ml
···
8
8
mutable next : t option;
9
9
mutable status : status;
10
10
cm : Editor.t;
11
-
worker : Client.t;
11
+
eval_fn : id:int -> line_number:int -> string -> unit;
12
+
fmt_fn : id:int -> string -> unit;
12
13
merlin_worker : Merlin_ext.Client.worker;
13
14
run_on : [ `Click | `Load ];
14
15
}
···
62
63
editor.status <- Running;
63
64
let code_txt = Editor.source editor.cm in
64
65
let line_number = 1 + Editor.get_previous_lines editor.cm in
65
-
Client.eval ~id:editor.id ~line_number editor.worker code_txt)
66
+
editor.eval_fn ~id:editor.id ~line_number code_txt)
66
67
67
68
let set_prev ~prev t =
68
69
let () = match t.prev with None -> () | Some prev -> prev.next <- None in
···
81
82
let doc = String.trim doc in
82
83
Editor.set_source editor.cm doc;
83
84
invalidate_from ~editor;
84
-
Client.fmt ~id:editor.id editor.worker doc
85
+
editor.fmt_fn ~id:editor.id doc
85
86
86
87
let init_css shadow ~extra_style ~inline_style =
87
88
El.append_children shadow
···
112
113
();
113
114
]
114
115
115
-
let init ~id ~run_on ?extra_style ?inline_style worker this =
116
+
let init ~id ~run_on ?extra_style ?inline_style ~eval_fn ~fmt_fn ~post_fn this =
116
117
let shadow = Webcomponent.attach_shadow this in
117
118
init_css shadow ~extra_style ~inline_style;
118
119
···
122
123
123
124
let cm = Editor.make shadow in
124
125
125
-
let merlin = Merlin_ext.make ~id worker in
126
+
let merlin = Merlin_ext.make ~id post_fn in
126
127
let merlin_worker = Merlin_ext.Client.make_worker merlin in
127
128
let editor =
128
129
{
···
131
132
cm;
132
133
prev = None;
133
134
next = None;
134
-
worker;
135
+
eval_fn;
136
+
fmt_fn;
135
137
merlin_worker;
136
138
run_on;
137
139
}
138
140
in
139
141
Editor.on_change cm (fun () -> invalidate_after ~editor);
140
-
set_source_from_html editor this;
141
142
142
143
Merlin_ext.set_context merlin (fun () -> pre_source editor);
143
144
Editor.configure_merlin cm (fun () -> Merlin_ext.extensions merlin_worker);
···
152
153
in
153
154
154
155
editor
156
+
157
+
let start editor this =
158
+
set_source_from_html editor this
155
159
156
160
let set_source editor doc =
157
161
Editor.set_source editor.cm doc;
+4
-1
x-ocaml/src/cell.mli
+4
-1
x-ocaml/src/cell.mli
···
5
5
run_on:[ `Click | `Load ] ->
6
6
?extra_style:Jstr.t ->
7
7
?inline_style:Jstr.t ->
8
-
Client.t ->
8
+
eval_fn:(id:int -> line_number:int -> string -> unit) ->
9
+
fmt_fn:(id:int -> string -> unit) ->
10
+
post_fn:(X_protocol.request -> unit) ->
9
11
Webcomponent.t ->
10
12
t
11
13
···
15
17
val completed_run : t -> X_protocol.output list -> unit
16
18
val set_prev : prev:t option -> t -> unit
17
19
val receive_merlin : t -> Protocol.answer -> unit
20
+
val start : t -> Webcomponent.t -> unit
18
21
val loadable : t -> bool
19
22
val run : t -> unit
+8
-6
x-ocaml/src/client.ml
+8
-6
x-ocaml/src/client.ml
···
17
17
in
18
18
Jstr.to_string (Uri.to_jstr url)
19
19
20
+
let origin =
21
+
Jstr.to_string (Jv.Jstr.get (Jv.get (Window.to_jv G.window) "location") "origin")
22
+
20
23
let absolute_url url =
21
-
if
22
-
not
23
-
(String.starts_with ~prefix:"http:" url
24
-
|| String.starts_with ~prefix:"https:" url)
25
-
then current_url ^ url
26
-
else url
24
+
if String.starts_with ~prefix:"http:" url || String.starts_with ~prefix:"https:" url
25
+
then url
26
+
else if String.starts_with ~prefix:"/" url then
27
+
origin ^ url
28
+
else current_url ^ url
27
29
28
30
let wrap_url ?extra_load url =
29
31
let url = absolute_url url in
+8
-4
x-ocaml/src/jtw_client.ml
+8
-4
x-ocaml/src/jtw_client.ml
···
152
152
let _fut : unit Fut.t =
153
153
let* result = W.init t.rpc config in
154
154
(match result with
155
-
| Ok () -> ()
155
+
| Ok () ->
156
+
(* Setup the default environment (loads stdlib, etc.) *)
157
+
let* _setup = W.setup t.rpc "" in
158
+
Fut.return ()
156
159
| Error (Api.InternalError _msg) ->
157
-
Console.(log [ str "jtw_client init error:"; str _msg ]));
158
-
Fut.return ()
160
+
Console.(log [ str "jtw_client init error:"; str _msg ]);
161
+
Fut.return ())
159
162
in
160
163
()
161
164
···
244
247
(* No-op: js_top_worker doesn't support format configuration *)
245
248
()
246
249
| X_protocol.Setup ->
247
-
init t
250
+
(* init already called by make_jtw; no-op here *)
251
+
()
248
252
249
253
let eval ~id ~line_number t code =
250
254
post t (X_protocol.Eval (id, line_number, code))
+4
-6
x-ocaml/src/merlin_ext.ml
+4
-6
x-ocaml/src/merlin_ext.ml
···
1
-
module Worker = Brr_webworkers.Worker
2
-
3
-
type t = { id : int; mutable context : unit -> string; client : Client.t }
1
+
type t = { id : int; mutable context : unit -> string; post_fn : X_protocol.request -> unit }
4
2
5
3
let set_context t fn = t.context <- fn
6
4
7
-
let make ~id client =
8
-
{ id; context = (fun () -> failwith "Merlin_ext.context"); client }
5
+
let make ~id post_fn =
6
+
{ id; context = (fun () -> failwith "Merlin_ext.context"); post_fn }
9
7
10
8
let fix_position pre_len = function
11
9
| `Offset at -> `Offset (at + pre_len)
···
63
61
64
62
let post t msg =
65
63
let msg = fix_request t msg in
66
-
Client.post t.client (Merlin (t.id, msg))
64
+
t.post_fn (Merlin (t.id, msg))
67
65
end
68
66
69
67
module Client = Merlin_client.Make (Merlin_send)
+18
-6
x-ocaml/src/x_ocaml.ml
+18
-6
x-ocaml/src/x_ocaml.ml
···
11
11
| None -> None
12
12
| Some url -> Some (Jstr.to_string url)
13
13
14
+
let backend_name =
15
+
match current_attribute "backend" with
16
+
| None -> "builtin"
17
+
| Some name -> Jstr.to_string name
18
+
14
19
let worker_url =
15
20
match current_attribute "src-worker" with
16
-
| None -> failwith "x-ocaml script missing src-worker attribute"
21
+
| None ->
22
+
if backend_name = "builtin" then
23
+
failwith "x-ocaml script missing src-worker attribute"
24
+
else ""
17
25
| Some url -> Jstr.to_string url
18
26
19
-
let worker = Client.make ?extra_load worker_url
27
+
let backend = Backend.make ~backend:backend_name ?extra_load worker_url
20
28
21
29
let () =
22
-
Client.on_message worker @@ function
30
+
Backend.on_message backend @@ function
23
31
| Formatted_source (id, code_fmt) -> Cell.set_source (find_by_id id) code_fmt
24
32
| Top_response_at (id, loc, msg) -> Cell.add_message (find_by_id id) loc msg
25
33
| Top_response (id, msg) -> Cell.completed_run (find_by_id id) msg
26
34
| Merlin_response (id, msg) -> Cell.receive_merlin (find_by_id id) msg
27
35
28
-
let () = Client.post worker Setup
36
+
let () = Backend.post backend Setup
29
37
30
38
let () =
31
39
match current_attribute "x-ocamlformat" with
32
40
| None -> ()
33
-
| Some conf -> Client.post worker (Format_config (Jstr.to_string conf))
41
+
| Some conf -> Backend.post backend (Format_config (Jstr.to_string conf))
34
42
35
43
let elt_name =
36
44
match current_attribute "elt-name" with
···
53
61
| None -> Option.value ~default:"load" run_on
54
62
in
55
63
let id = List.length !all in
56
-
let editor = Cell.init ~id ~run_on ?extra_style ?inline_style worker this in
64
+
let eval_fn ~id ~line_number code = Backend.eval ~id ~line_number backend code in
65
+
let fmt_fn ~id code = Backend.fmt ~id backend code in
66
+
let post_fn msg = Backend.post backend msg in
67
+
let editor = Cell.init ~id ~run_on ?extra_style ?inline_style ~eval_fn ~fmt_fn ~post_fn this in
57
68
all := editor :: !all;
58
69
Cell.set_prev ~prev editor;
70
+
Cell.start editor this;
59
71
if List.for_all Cell.loadable !all then Cell.run editor;
60
72
()