jon.recoil.org
this repo has no description
feat(x-ocaml): implement js_top_worker backend bridge
Add jtw_client.ml that bridges x-ocaml's X_protocol with js_top_worker's
JSON-RPC protocol. This enables using js_top_worker as an alternative
backend for code evaluation, type checking, and completion.
The bridge translates:
- Eval requests to W.exec RPC calls
- Complete_prefix/Type_enclosing/All_errors to corresponding W.* calls
- Merlin position types (polymorphic variants) to js_top_worker's
msource_position (regular variants)
- js_top_worker result types back to Protocol/X_protocol response types
Also add backend.ml abstraction layer that dispatches between the built-in
x-ocaml worker and the js_top_worker backend based on configuration.
Add vendored mime_printer library required by js_top_worker-rpc.
Co-Authored-By: Claude Opus 4.6 <noreply@anthropic.com>
+92
src/backend.ml
+92
src/backend.ml
···
1
+
(** Backend abstraction for x-ocaml.
2
+
3
+
This module provides a unified client type that can use either the built-in
4
+
x-ocaml worker or js_top_worker as the backend. *)
5
+
6
+
module type S = sig
7
+
type t
8
+
val make : ?extra_load:string -> string -> t
9
+
val on_message : t -> (X_protocol.response -> unit) -> unit
10
+
val post : t -> X_protocol.request -> unit
11
+
val eval : id:int -> line_number:int -> t -> string -> unit
12
+
val fmt : id:int -> t -> string -> unit
13
+
val has_merlin : bool
14
+
end
15
+
16
+
(** Unified client type that works with any backend *)
17
+
type t =
18
+
| Builtin of Client.t
19
+
| Jtw of Jtw_client.t
20
+
21
+
let has_merlin = function
22
+
| Builtin _ -> true
23
+
| Jtw _ -> true (* js_top_worker has complete, type_at, and errors *)
24
+
25
+
let make_builtin ?extra_load url =
26
+
Builtin (Client.make ?extra_load url)
27
+
28
+
let make_jtw url =
29
+
let client = Jtw_client.make url in
30
+
Jtw_client.init client;
31
+
Jtw client
32
+
33
+
let make ~backend ?extra_load url =
34
+
match String.lowercase_ascii backend with
35
+
| "jtw" | "js_top_worker" -> make_jtw url
36
+
| "builtin" | "x-ocaml" | _ -> make_builtin ?extra_load url
37
+
38
+
let on_message t fn =
39
+
match t with
40
+
| Builtin client -> Client.on_message client fn
41
+
| Jtw client -> Jtw_client.on_message client fn
42
+
43
+
let post t msg =
44
+
match t with
45
+
| Builtin client -> Client.post client msg
46
+
| Jtw client -> Jtw_client.post client msg
47
+
48
+
let eval ~id ~line_number t code =
49
+
match t with
50
+
| Builtin client -> Client.eval ~id ~line_number client code
51
+
| Jtw client -> Jtw_client.eval ~id ~line_number client code
52
+
53
+
let fmt ~id t code =
54
+
match t with
55
+
| Builtin client -> Client.fmt ~id client code
56
+
| Jtw client -> Jtw_client.fmt ~id client code
57
+
58
+
(** Module-based interface for advanced use cases *)
59
+
60
+
module Builtin_mod : S = struct
61
+
type nonrec t = Client.t
62
+
let make = Client.make
63
+
let on_message = Client.on_message
64
+
let post = Client.post
65
+
let eval = Client.eval
66
+
let fmt = Client.fmt
67
+
let has_merlin = true
68
+
end
69
+
70
+
module Jtw_mod : S = struct
71
+
type nonrec t = Jtw_client.t
72
+
73
+
let make ?extra_load:_ url =
74
+
let t = Jtw_client.make url in
75
+
Jtw_client.init t;
76
+
t
77
+
78
+
let on_message = Jtw_client.on_message
79
+
80
+
let post = Jtw_client.post
81
+
82
+
let eval = Jtw_client.eval
83
+
84
+
let fmt = Jtw_client.fmt
85
+
86
+
let has_merlin = true (* js_top_worker has complete, type_at, and errors *)
87
+
end
88
+
89
+
let select name =
90
+
match String.lowercase_ascii name with
91
+
| "jtw" | "js_top_worker" -> (module Jtw_mod : S)
92
+
| "builtin" | "x-ocaml" | _ -> (module Builtin_mod : S)
+92
src/backend.mli
+92
src/backend.mli
···
1
+
(** Backend abstraction for x-ocaml.
2
+
3
+
This module provides a unified client type that can use either the built-in
4
+
x-ocaml worker or js_top_worker as the backend.
5
+
6
+
Usage:
7
+
{[
8
+
(* Select backend from attribute *)
9
+
let worker = Backend.make ~backend:"jtw" worker_url in
10
+
11
+
(* Use unified API *)
12
+
Backend.on_message worker (fun msg -> ...);
13
+
Backend.eval ~id:1 ~line_number:1 worker "let x = 1";
14
+
]} *)
15
+
16
+
(** The backend module signature *)
17
+
module type S = sig
18
+
type t
19
+
20
+
(** Create a new backend client.
21
+
@param extra_load Optional URL to load before the worker
22
+
@param url URL to the worker script *)
23
+
val make : ?extra_load:string -> string -> t
24
+
25
+
(** Set the response handler. Called for each response from the worker. *)
26
+
val on_message : t -> (X_protocol.response -> unit) -> unit
27
+
28
+
(** Send a raw protocol message to the worker.
29
+
Note: Some backends may not support all message types (e.g., Merlin). *)
30
+
val post : t -> X_protocol.request -> unit
31
+
32
+
(** Evaluate OCaml code.
33
+
@param id Cell identifier
34
+
@param line_number Starting line number
35
+
@param t The client
36
+
@param code OCaml code to evaluate *)
37
+
val eval : id:int -> line_number:int -> t -> string -> unit
38
+
39
+
(** Format OCaml code using ocamlformat.
40
+
@param id Cell identifier
41
+
@param t The client
42
+
@param code OCaml code to format *)
43
+
val fmt : id:int -> t -> string -> unit
44
+
45
+
(** Whether this backend supports Merlin integration *)
46
+
val has_merlin : bool
47
+
end
48
+
49
+
(** {1 Unified Client Type} *)
50
+
51
+
(** Unified client type that can hold any backend *)
52
+
type t
53
+
54
+
(** Check if the backend supports Merlin integration *)
55
+
val has_merlin : t -> bool
56
+
57
+
(** Create a client with the built-in x-ocaml worker backend *)
58
+
val make_builtin : ?extra_load:string -> string -> t
59
+
60
+
(** Create a client with the js_top_worker backend *)
61
+
val make_jtw : string -> t
62
+
63
+
(** Create a client with the specified backend.
64
+
@param backend Backend name: "builtin", "x-ocaml", "jtw", or "js_top_worker"
65
+
@param extra_load Optional URL to load before the worker (builtin only)
66
+
@param url URL to the worker script *)
67
+
val make : backend:string -> ?extra_load:string -> string -> t
68
+
69
+
(** Set the response handler *)
70
+
val on_message : t -> (X_protocol.response -> unit) -> unit
71
+
72
+
(** Send a raw protocol message (no-op for jtw backend) *)
73
+
val post : t -> X_protocol.request -> unit
74
+
75
+
(** Evaluate OCaml code *)
76
+
val eval : id:int -> line_number:int -> t -> string -> unit
77
+
78
+
(** Format OCaml code *)
79
+
val fmt : id:int -> t -> string -> unit
80
+
81
+
(** {1 Module-based Interface} *)
82
+
83
+
(** Built-in x-ocaml worker backend module *)
84
+
module Builtin_mod : S
85
+
86
+
(** js_top_worker backend module *)
87
+
module Jtw_mod : S
88
+
89
+
(** Select backend module by name.
90
+
@param name "builtin" or "jtw"
91
+
@return The backend module *)
92
+
val select : string -> (module S)
+2
src/dune
+2
src/dune
+253
src/jtw_client.ml
+253
src/jtw_client.ml
···
1
+
(** Bridge between x-ocaml's X_protocol and js_top_worker's JSON-RPC protocol.
2
+
3
+
This module translates X_protocol requests into js_top_worker RPC calls
4
+
and converts the results back into X_protocol responses. *)
5
+
6
+
open Brr
7
+
module Jtw = Js_top_worker_client_fut
8
+
module W = Jtw.W
9
+
module Api = Js_top_worker_rpc.Toplevel_api_gen
10
+
11
+
type t = {
12
+
rpc : Jtw.rpc;
13
+
mutable on_message_cb : X_protocol.response -> unit;
14
+
}
15
+
16
+
let make url =
17
+
let timeout_fn () =
18
+
Brr.Console.(log [ str "js_top_worker: timeout" ])
19
+
in
20
+
let rpc = Jtw.start url 30_000 timeout_fn in
21
+
{ rpc; on_message_cb = (fun _ -> ()) }
22
+
23
+
let on_message t fn = t.on_message_cb <- fn
24
+
25
+
(** Send a response back to x-ocaml via the stored callback. *)
26
+
let respond t resp = t.on_message_cb resp
27
+
28
+
(** Convert a merlin position (polymorphic variant) to js_top_worker's
29
+
msource_position (regular variant). *)
30
+
let convert_position
31
+
(pos : [ `Start | `Offset of int | `Logical of int * int | `End ]) :
32
+
Api.msource_position =
33
+
match pos with
34
+
| `Start -> Api.Start
35
+
| `Offset n -> Api.Offset n
36
+
| `Logical (line, col) -> Api.Logical (line, col)
37
+
| `End -> Api.End
38
+
39
+
(** Convert js_top_worker kind_ty to merlin's Query_protocol.Compl.entry kind *)
40
+
let convert_kind (k : Api.kind_ty) :
41
+
[ `Value
42
+
| `Constructor
43
+
| `Variant
44
+
| `Label
45
+
| `Module
46
+
| `Modtype
47
+
| `Type
48
+
| `MethodCall
49
+
| `Keyword ] =
50
+
match k with
51
+
| Api.Value -> `Value
52
+
| Api.Constructor -> `Constructor
53
+
| Api.Variant -> `Variant
54
+
| Api.Label -> `Label
55
+
| Api.Module -> `Module
56
+
| Api.Modtype -> `Modtype
57
+
| Api.Type -> `Type
58
+
| Api.MethodCall -> `MethodCall
59
+
| Api.Keyword -> `Keyword
60
+
61
+
(** Convert js_top_worker completion entry to merlin's Query_protocol.Compl.entry *)
62
+
let convert_compl_entry (e : Api.query_protocol_compl_entry) :
63
+
Query_protocol.Compl.entry =
64
+
{
65
+
Query_protocol.Compl.name = e.Api.name;
66
+
kind = convert_kind e.Api.kind;
67
+
desc = e.Api.desc;
68
+
info = e.Api.info;
69
+
deprecated = e.Api.deprecated;
70
+
}
71
+
72
+
(** Convert js_top_worker completions to Protocol.completions *)
73
+
let convert_completions (c : Api.completions) : Protocol.completions =
74
+
{
75
+
Protocol.from = c.Api.from;
76
+
to_ = c.Api.to_;
77
+
entries = List.map convert_compl_entry c.Api.entries;
78
+
}
79
+
80
+
(** Convert js_top_worker error to Protocol.error.
81
+
Both use Ocaml_parsing.Location types, so this is a direct mapping. *)
82
+
let convert_error (e : Api.error) : Protocol.error =
83
+
{
84
+
Protocol.kind = e.Api.kind;
85
+
loc = e.Api.loc;
86
+
main = e.Api.main;
87
+
sub = e.Api.sub;
88
+
source = e.Api.source;
89
+
}
90
+
91
+
(** Convert js_top_worker is_tail_position to Protocol.is_tail_position *)
92
+
let convert_tail_position (tp : Api.is_tail_position) :
93
+
Protocol.is_tail_position =
94
+
match tp with
95
+
| Api.No -> `No
96
+
| Api.Tail_position -> `Tail_position
97
+
| Api.Tail_call -> `Tail_call
98
+
99
+
(** Convert js_top_worker index_or_string to the polymorphic variant form *)
100
+
let convert_index_or_string (ios : Api.index_or_string) :
101
+
[ `Index of int | `String of string ] =
102
+
match ios with
103
+
| Api.Index i -> `Index i
104
+
| Api.String s -> `String s
105
+
106
+
(** Convert a js_top_worker typed_enclosings entry to Protocol format *)
107
+
let convert_typed_enclosing
108
+
((loc, ios, tp) : Api.typed_enclosings) :
109
+
Ocaml_parsing.Location.t
110
+
* [ `Index of int | `String of string ]
111
+
* Protocol.is_tail_position =
112
+
(loc, convert_index_or_string ios, convert_tail_position tp)
113
+
114
+
(** Convert exec_result to X_protocol output list *)
115
+
let convert_exec_result (r : Api.exec_result) : X_protocol.output list =
116
+
let outputs = ref [] in
117
+
(* Add sharp_ppf output (toplevel responses like "val x : int = 1") *)
118
+
(match r.Api.sharp_ppf with
119
+
| Some s when s <> "" -> outputs := X_protocol.Meta s :: !outputs
120
+
| _ -> ());
121
+
(* Add caml_ppf output (type/module signatures) *)
122
+
(match r.Api.caml_ppf with
123
+
| Some s when s <> "" -> outputs := X_protocol.Meta s :: !outputs
124
+
| _ -> ());
125
+
(* Add stdout *)
126
+
(match r.Api.stdout with
127
+
| Some s when s <> "" -> outputs := X_protocol.Stdout s :: !outputs
128
+
| _ -> ());
129
+
(* Add stderr *)
130
+
(match r.Api.stderr with
131
+
| Some s when s <> "" -> outputs := X_protocol.Stderr s :: !outputs
132
+
| _ -> ());
133
+
List.rev !outputs
134
+
135
+
(** Ignore errors from async operations, logging them to the console *)
136
+
let handle_error = function
137
+
| Ok v -> Some v
138
+
| Error (Api.InternalError _msg) ->
139
+
Console.(log [ str "jtw_client error:"; str _msg ]);
140
+
None
141
+
142
+
let init t =
143
+
let open Fut.Syntax in
144
+
let config : Api.init_config =
145
+
{
146
+
findlib_requires = [];
147
+
stdlib_dcs = None;
148
+
findlib_index = None;
149
+
execute = true;
150
+
}
151
+
in
152
+
let _fut : unit Fut.t =
153
+
let* result = W.init t.rpc config in
154
+
(match result with
155
+
| Ok () -> ()
156
+
| Error (Api.InternalError _msg) ->
157
+
Console.(log [ str "jtw_client init error:"; str _msg ]));
158
+
Fut.return ()
159
+
in
160
+
()
161
+
162
+
let post t (req : X_protocol.request) =
163
+
let open Fut.Syntax in
164
+
match req with
165
+
| X_protocol.Eval (id, line_number, code) ->
166
+
let _fut : unit Fut.t =
167
+
let* result = W.exec t.rpc "" code in
168
+
(match handle_error result with
169
+
| Some exec_result ->
170
+
let outputs = convert_exec_result exec_result in
171
+
if line_number > 0 then
172
+
respond t (X_protocol.Top_response_at (id, line_number, outputs))
173
+
else
174
+
respond t (X_protocol.Top_response (id, outputs))
175
+
| None ->
176
+
respond t
177
+
(X_protocol.Top_response
178
+
(id, [ X_protocol.Stderr "Internal error during evaluation" ])));
179
+
Fut.return ()
180
+
in
181
+
()
182
+
| X_protocol.Merlin (id, Protocol.Complete_prefix (src, pos)) ->
183
+
let jtw_pos = convert_position pos in
184
+
let _fut : unit Fut.t =
185
+
let* result =
186
+
W.complete_prefix t.rpc "" None [] false src jtw_pos
187
+
in
188
+
(match handle_error result with
189
+
| Some completions ->
190
+
let converted = convert_completions completions in
191
+
respond t
192
+
(X_protocol.Merlin_response (id, Protocol.Completions converted))
193
+
| None ->
194
+
respond t
195
+
(X_protocol.Merlin_response
196
+
(id,
197
+
Protocol.Completions
198
+
{ Protocol.from = 0; to_ = 0; entries = [] })));
199
+
Fut.return ()
200
+
in
201
+
()
202
+
| X_protocol.Merlin (id, Protocol.Type_enclosing (src, pos)) ->
203
+
let jtw_pos = convert_position pos in
204
+
let _fut : unit Fut.t =
205
+
let* result =
206
+
W.type_enclosing t.rpc "" None [] false src jtw_pos
207
+
in
208
+
(match handle_error result with
209
+
| Some enclosings ->
210
+
let converted = List.map convert_typed_enclosing enclosings in
211
+
respond t
212
+
(X_protocol.Merlin_response
213
+
(id, Protocol.Typed_enclosings converted))
214
+
| None ->
215
+
respond t
216
+
(X_protocol.Merlin_response
217
+
(id, Protocol.Typed_enclosings [])));
218
+
Fut.return ()
219
+
in
220
+
()
221
+
| X_protocol.Merlin (id, Protocol.All_errors src) ->
222
+
let _fut : unit Fut.t =
223
+
let* result =
224
+
W.query_errors t.rpc "" None [] false src
225
+
in
226
+
(match handle_error result with
227
+
| Some errors ->
228
+
let converted = List.map convert_error errors in
229
+
respond t
230
+
(X_protocol.Merlin_response (id, Protocol.Errors converted))
231
+
| None ->
232
+
respond t
233
+
(X_protocol.Merlin_response (id, Protocol.Errors [])));
234
+
Fut.return ()
235
+
in
236
+
()
237
+
| X_protocol.Merlin (id, Protocol.Add_cmis _) ->
238
+
(* js_top_worker handles CMI loading internally via its init config *)
239
+
respond t (X_protocol.Merlin_response (id, Protocol.Added_cmis))
240
+
| X_protocol.Format (id, code) ->
241
+
(* js_top_worker doesn't support formatting; return the code as-is *)
242
+
respond t (X_protocol.Formatted_source (id, code))
243
+
| X_protocol.Format_config _ ->
244
+
(* No-op: js_top_worker doesn't support format configuration *)
245
+
()
246
+
| X_protocol.Setup ->
247
+
init t
248
+
249
+
let eval ~id ~line_number t code =
250
+
post t (X_protocol.Eval (id, line_number, code))
251
+
252
+
let fmt ~id t code =
253
+
post t (X_protocol.Format (id, code))
+8
src/jtw_client.mli
+8
src/jtw_client.mli
···
1
+
(* Stub: js_top_worker backend removed to avoid dependency *)
2
+
type t
3
+
val make : string -> t
4
+
val on_message : t -> (X_protocol.response -> unit) -> unit
5
+
val init : t -> unit
6
+
val post : t -> X_protocol.request -> unit
7
+
val eval : id:int -> line_number:int -> t -> string -> unit
8
+
val fmt : id:int -> t -> string -> unit