forked from
anil.recoil.org/monopam-myspace
My aggregated monorepo of OCaml code, automaintained
Merge branch 'x-ocaml-modes'
# Conflicts:
# FEATURE.md
# x-ocaml/src/jtw_client.ml
+981
-234
+12
-12
FEATURE.md
+12
-12
FEATURE.md
···
1
-
# Feature: universe builder
1
+
# Feature: x-ocaml cell modes
2
2
3
-
CLI tool that builds a self-contained universe of compiled OCaml packages
4
-
from an opam switch — the artifacts needed for the browser toplevel to
5
-
load libraries at runtime.
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.
6
6
7
7
## Scope
8
8
9
-
- Walk an opam switch and for each installed package:
10
-
- Copy META file
11
-
- Compile `.cma` to `.cma.js` via js_of_ocaml
12
-
- Generate `dynamic_cmis.json` from `.cmi` files
13
-
- Write `findlib_index.json` listing all packages
14
-
- Output a directory layout ready to serve over HTTP
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
15
15
16
16
## References
17
17
18
-
- [Design](docs/plans/2026-02-20-ocaml-interactive-tutorials-design.md) — Section 1
19
-
- [Plan](docs/plans/2026-02-20-ocaml-interactive-tutorials-plan.md) — Stream 3 (tasks 3.1–3.3)
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)
+128
docs/plans/2026-02-20-filename-and-message-protocol-design.md
+128
docs/plans/2026-02-20-filename-and-message-protocol-design.md
···
1
+
# Per-cell filename attribute and message protocol migration
2
+
3
+
## Problem
4
+
5
+
Two related issues:
6
+
7
+
1. **No filename support for Merlin.** All code cells are treated as `.ml`
8
+
(implementation) by Merlin. Tutorials that show `.mli` interface syntax
9
+
get incorrect error diagnostics because Merlin parses them as
10
+
implementation code. Merlin determines `.ml` vs `.mli` from
11
+
`Mconfig.query.filename` — currently unset, defaulting to `Impl`.
12
+
13
+
2. **x-ocaml's jtw_client still uses the old RPC layer.** The js_top_worker
14
+
`worker.ml` already speaks the new JSON message protocol (`message.ml`),
15
+
and a matching client library (`js_top_worker_client_msg.ml`) exists.
16
+
But x-ocaml's `jtw_client.ml` still uses `Js_top_worker_client_fut`
17
+
(the old `deriving rpcty` / IDL-based client), creating an unnecessary
18
+
dependency on `js_top_worker-rpc`, `rpclib`, and `ppx_deriving_rpc`.
19
+
20
+
## Design
21
+
22
+
### Part 1: Port jtw_client.ml to the message protocol
23
+
24
+
**x-ocaml/src/dune** — Replace `js_top_worker-client_fut` with
25
+
`js_top_worker-client.msg`.
26
+
27
+
**x-ocaml/src/jtw_client.ml** — Rewrite to use
28
+
`Js_top_worker_client_msg` instead of `Js_top_worker_client_fut`. The
29
+
new client speaks JSON messages directly — no type conversions from
30
+
`Toplevel_api_gen` needed.
31
+
32
+
The current `jtw_client.ml` converts between three type systems:
33
+
- `X_protocol` (x-ocaml's internal protocol)
34
+
- `Toplevel_api_gen` (the old RPC types)
35
+
- `Protocol` (merlin-js protocol types for completions, errors, etc.)
36
+
37
+
After the port, `jtw_client.ml` converts only between:
38
+
- `X_protocol` (x-ocaml's internal protocol)
39
+
- `Js_top_worker_message.Message` (simple record types with string fields)
40
+
41
+
The `Js_top_worker_client_msg` API:
42
+
- `create url` — create worker, returns `t`
43
+
- `init t config` — initialise, returns `unit Lwt.t`
44
+
- `eval t ?env_id code` — evaluate code, returns `output Lwt.t`
45
+
- `eval_stream t ?env_id code` — streaming eval, returns `eval_event Lwt_stream.t`
46
+
- `complete t ?env_id source position` — completions, returns `Msg.completions Lwt.t`
47
+
- `type_at t ?env_id source position` — types, returns `Msg.type_info list Lwt.t`
48
+
- `errors t ?env_id source` — errors, returns `Msg.error list Lwt.t`
49
+
- `create_env t env_id` / `destroy_env t env_id` — environment management
50
+
- `terminate t` — shut down worker
51
+
52
+
### Part 2: Add filename to the message protocol
53
+
54
+
**js_top_worker/idl/message.ml** — Add `filename : string option` to
55
+
the three Merlin-facing client messages:
56
+
57
+
```ocaml
58
+
| Complete of { cell_id : int; env_id : string; source : string;
59
+
position : int; filename : string option }
60
+
| TypeAt of { cell_id : int; env_id : string; source : string;
61
+
position : int; filename : string option }
62
+
| Errors of { cell_id : int; env_id : string; source : string;
63
+
filename : string option }
64
+
```
65
+
66
+
Add JSON serialization (`"filename"` field, omitted when None) and
67
+
parsing (with `get_string_opt` for backwards compatibility).
68
+
69
+
**js_top_worker/idl/js_top_worker_client_msg.ml** — Add optional
70
+
`?filename` parameter to `complete`, `type_at`, `errors`.
71
+
72
+
**js_top_worker/client/ocaml-worker.js** — Add optional `filename`
73
+
parameter to the JS client methods.
74
+
75
+
**js_top_worker/lib/impl.ml** — Accept optional filename in `config`:
76
+
77
+
```ocaml
78
+
let config ?filename () =
79
+
let initial = Merlin_kernel.Mconfig.initial in
80
+
let query = match filename with
81
+
| Some f -> { initial.query with filename = f }
82
+
| None -> initial.query
83
+
in
84
+
{ initial with
85
+
merlin = { initial.merlin with stdlib = Some path };
86
+
query }
87
+
```
88
+
89
+
Thread through `wdispatch`, `query_errors`, `complete_prefix`, and
90
+
`type_enclosing`.
91
+
92
+
**js_top_worker/lib/worker.ml** — Extract filename from messages and
93
+
pass to `M.query_errors`, `M.complete_prefix`, `M.type_enclosing`.
94
+
This requires the `Impl.Make(S)` functions to accept an optional
95
+
`?filename` parameter.
96
+
97
+
### Part 3: x-ocaml integration
98
+
99
+
**x-ocaml WebComponent** — Read `data-filename` from the element, pass
100
+
it through when sending Merlin requests via the backend.
101
+
102
+
**x-ocaml/src/jtw_client.ml** — Thread filename from x-ocaml to the
103
+
`Js_top_worker_client_msg` API.
104
+
105
+
**Authoring format** — A new per-cell attribute:
106
+
107
+
```
108
+
{@ocaml interactive filename=map.mli [
109
+
val map : ('a -> 'b) -> 'a list -> 'b list
110
+
]}
111
+
```
112
+
113
+
The odoc plugin emits `<x-ocaml mode="interactive" data-filename="map.mli">`.
114
+
115
+
## What doesn't change
116
+
117
+
- `X_protocol` — the builtin merlin-js backend still uses this.
118
+
- `Protocol` (merlin-js.protocol) — still used by the builtin backend
119
+
and merlin-codemirror.
120
+
- `add_cmi` in impl.ml — cell dependency CMI generation is always `.ml`.
121
+
- `exec` / `Eval` messages — execution always goes through `Toploop`
122
+
which is `.ml` toplevel syntax.
123
+
124
+
## Backwards compatibility
125
+
126
+
The `filename` field is optional in the JSON protocol. Workers that don't
127
+
understand it will ignore it. Clients that don't send it get the existing
128
+
behaviour (treated as `.ml`).
+683
docs/plans/2026-02-20-filename-and-message-protocol-plan.md
+683
docs/plans/2026-02-20-filename-and-message-protocol-plan.md
···
1
+
# Filename attribute & message protocol migration — Implementation Plan
2
+
3
+
> **For Claude:** REQUIRED SUB-SKILL: Use superpowers:executing-plans to implement this plan task-by-task.
4
+
5
+
**Goal:** Port x-ocaml's jtw backend from the old RPC/IDL layer to the JSON message protocol, and add per-cell filename support so Merlin handles `.mli` syntax correctly.
6
+
7
+
**Architecture:** The js_top_worker `worker.ml` already uses the JSON message protocol (`message.ml`). The matching client library `js_top_worker_client_msg.ml` exists. We rewrite x-ocaml's `jtw_client.ml` to use it, add `filename` to the message types, and thread it through to Merlin's `Mconfig.query.filename`.
8
+
9
+
**Tech Stack:** OCaml, js_of_ocaml, merlin-lib, Brr, Lwt
10
+
11
+
**Design doc:** `docs/plans/2026-02-20-filename-and-message-protocol-design.md`
12
+
13
+
---
14
+
15
+
## Batch 1: Add filename to js_top_worker message protocol
16
+
17
+
These changes are in the monorepo's `js_top_worker/` subtree.
18
+
19
+
### Task 1.1: Add filename field to message.ml client messages
20
+
21
+
**Files:**
22
+
- Modify: `js_top_worker/idl/message.ml`
23
+
24
+
**Step 1: Add `filename : string option` to Complete, TypeAt, Errors**
25
+
26
+
In `message.ml`, change the three Merlin-facing `client_msg` variants:
27
+
28
+
```ocaml
29
+
type client_msg =
30
+
| Init of init_config
31
+
| Eval of { cell_id : int; env_id : string; code : string }
32
+
| Complete of { cell_id : int; env_id : string; source : string; position : int; filename : string option }
33
+
| TypeAt of { cell_id : int; env_id : string; source : string; position : int; filename : string option }
34
+
| Errors of { cell_id : int; env_id : string; source : string; filename : string option }
35
+
| CreateEnv of { env_id : string }
36
+
| DestroyEnv of { env_id : string }
37
+
```
38
+
39
+
**Step 2: Update `client_msg_of_string` parsing**
40
+
41
+
In each of the `"complete"`, `"type_at"`, and `"errors"` cases, add:
42
+
43
+
```ocaml
44
+
filename = get_string_opt obj "filename";
45
+
```
46
+
47
+
This uses the existing `get_string_opt` helper, so missing/null fields produce `None` (backwards compatible).
48
+
49
+
**Step 3: Build to verify**
50
+
51
+
Run: `dune build js_top_worker/idl/`
52
+
53
+
Expected: compilation succeeds. `worker.ml` will fail because it passes messages without the new field — that's Task 1.3.
54
+
55
+
**Step 4: Commit**
56
+
57
+
```
58
+
feat(js_top_worker): add filename field to message protocol
59
+
```
60
+
61
+
### Task 1.2: Add filename to impl.ml's Merlin config
62
+
63
+
**Files:**
64
+
- Modify: `js_top_worker/lib/impl.ml`
65
+
66
+
**Step 1: Make `config` accept optional filename**
67
+
68
+
Replace `config()` (around line 832):
69
+
70
+
```ocaml
71
+
let config ?filename () =
72
+
let path =
73
+
match !path with Some p -> p | None -> failwith "Path not set"
74
+
in
75
+
let initial = Merlin_kernel.Mconfig.initial in
76
+
let query = match filename with
77
+
| Some f -> { initial.query with filename = f }
78
+
| None -> initial.query
79
+
in
80
+
{ initial with
81
+
merlin = { initial.merlin with stdlib = Some path };
82
+
query }
83
+
```
84
+
85
+
**Step 2: Thread filename through `make_pipeline` and `wdispatch`**
86
+
87
+
```ocaml
88
+
let make_pipeline ?filename source =
89
+
Merlin_kernel.Mpipeline.make (config ?filename ()) source
90
+
91
+
let wdispatch ?filename source query =
92
+
let pipeline = make_pipeline ?filename source in
93
+
Merlin_kernel.Mpipeline.with_pipeline pipeline @@ fun () ->
94
+
Query_commands.dispatch pipeline query
95
+
```
96
+
97
+
**Step 3: Add `?filename` to `complete_prefix`, `query_errors`, `type_enclosing`**
98
+
99
+
For `complete_prefix` (line 943):
100
+
```ocaml
101
+
let complete_prefix ?filename env_id id deps is_toplevel source position =
102
+
```
103
+
And pass `?filename` to `wdispatch` in `Completion.at_pos` (need to thread
104
+
through) — or simpler: move the `wdispatch` call in `complete_prefix` to
105
+
use `?filename` directly after constructing the source.
106
+
107
+
For `query_errors` (line 1092):
108
+
```ocaml
109
+
let query_errors ?filename env_id id deps is_toplevel orig_source =
110
+
```
111
+
And use `wdispatch ?filename source query` on line 1105.
112
+
113
+
For `type_enclosing` (line 1148):
114
+
```ocaml
115
+
let type_enclosing ?filename env_id _id deps is_toplevel orig_source position =
116
+
```
117
+
And use `wdispatch ?filename source query` on line 1165.
118
+
119
+
**Step 4: Build to verify**
120
+
121
+
Run: `dune build js_top_worker/lib/`
122
+
123
+
Expected: success (the `?filename` params are optional, so existing callers still work).
124
+
125
+
**Step 5: Commit**
126
+
127
+
```
128
+
feat(js_top_worker): thread filename through Merlin config
129
+
```
130
+
131
+
### Task 1.3: Thread filename in worker.ml
132
+
133
+
**Files:**
134
+
- Modify: `js_top_worker/lib/worker.ml`
135
+
136
+
**Step 1: Extract filename from messages and pass to impl**
137
+
138
+
In `handle_message`, update the three Merlin cases:
139
+
140
+
```ocaml
141
+
| Msg.Complete { cell_id; env_id = _; source; position; filename } ->
142
+
let pos = position_of_int position in
143
+
Rpc_lwt.T.get (M.complete_prefix ?filename "" None [] false source pos) >|= fun result ->
144
+
...
145
+
146
+
| Msg.TypeAt { cell_id; env_id = _; source; position; filename } ->
147
+
let pos = position_of_int position in
148
+
Rpc_lwt.T.get (M.type_enclosing ?filename "" None [] false source pos) >|= fun result ->
149
+
...
150
+
151
+
| Msg.Errors { cell_id; env_id = _; source; filename } ->
152
+
Rpc_lwt.T.get (M.query_errors ?filename "" None [] false source) >|= fun result ->
153
+
...
154
+
```
155
+
156
+
**Step 2: Build to verify**
157
+
158
+
Run: `dune build js_top_worker/`
159
+
160
+
Expected: full build succeeds.
161
+
162
+
**Step 3: Commit**
163
+
164
+
```
165
+
feat(js_top_worker): pass filename from messages to Merlin queries
166
+
```
167
+
168
+
### Task 1.4: Add filename to client_msg.ml
169
+
170
+
**Files:**
171
+
- Modify: `js_top_worker/idl/js_top_worker_client_msg.ml`
172
+
173
+
**Step 1: Add `?filename` parameter to `complete`, `type_at`, `errors`**
174
+
175
+
For `complete` (around line 329):
176
+
```ocaml
177
+
let complete t ?filename ?(env_id = "default") source position =
178
+
```
179
+
And in the `send` call, use `` `Complete (cell_id, env_id, source, position, filename) `` — but this depends on the `send` function's message encoding. The `send` function constructs JSON inline. Update the `Complete case:
180
+
181
+
```ocaml
182
+
| `Complete (cell_id, env_id, source, position, filename) ->
183
+
let pairs = [|
184
+
("type", Js.Unsafe.inject (Js.string "complete"));
185
+
("cell_id", Js.Unsafe.inject cell_id);
186
+
("env_id", Js.Unsafe.inject (Js.string env_id));
187
+
("source", Js.Unsafe.inject (Js.string source));
188
+
("position", Js.Unsafe.inject position);
189
+
|] in
190
+
let pairs = match filename with
191
+
| Some f -> Array.append pairs [| ("filename", Js.Unsafe.inject (Js.string f)) |]
192
+
| None -> pairs
193
+
in
194
+
Js.to_string (Json.output (Js.Unsafe.obj pairs))
195
+
```
196
+
197
+
Similarly for `TypeAt and `Errors.
198
+
199
+
**Step 2: Build to verify**
200
+
201
+
Run: `dune build js_top_worker/idl/`
202
+
203
+
Expected: success.
204
+
205
+
**Step 3: Commit**
206
+
207
+
```
208
+
feat(js_top_worker): add filename parameter to client_msg API
209
+
```
210
+
211
+
### Task 1.5: Add filename to ocaml-worker.js
212
+
213
+
**Files:**
214
+
- Modify: `js_top_worker/client/ocaml-worker.js`
215
+
- Modify: `js_top_worker/client/ocaml-worker.d.ts`
216
+
217
+
**Step 1: Add optional `filename` param to `complete`, `typeAt`, `errors`**
218
+
219
+
In the JS client, the methods that send messages to the worker need a
220
+
`filename` option. For example, in `errors(code, opts)`:
221
+
222
+
```javascript
223
+
errors(code, { envId = 'default', filename = undefined } = {}) {
224
+
return this.#request({
225
+
type: 'errors',
226
+
cell_id: this.#nextId(),
227
+
env_id: envId,
228
+
source: code,
229
+
...(filename && { filename }),
230
+
});
231
+
}
232
+
```
233
+
234
+
Similarly for `complete` and `typeAt`.
235
+
236
+
**Step 2: Update TypeScript definitions**
237
+
238
+
In `ocaml-worker.d.ts`, add the `filename?: string` option.
239
+
240
+
**Step 3: Commit**
241
+
242
+
```
243
+
feat(js_top_worker): add filename option to JS client
244
+
```
245
+
246
+
---
247
+
248
+
## Batch 2: Port x-ocaml jtw_client to message protocol
249
+
250
+
### Task 2.1: Update dune dependencies
251
+
252
+
**Files:**
253
+
- Modify: `x-ocaml/src/dune`
254
+
255
+
**Step 1: Replace js_top_worker-client_fut with js_top_worker-client.msg**
256
+
257
+
```
258
+
(executable
259
+
(name x_ocaml)
260
+
(libraries
261
+
brr
262
+
code-mirror
263
+
js_top_worker-client.msg
264
+
merlin-js.client
265
+
merlin-js.code-mirror
266
+
merlin-js.protocol
267
+
x_protocol)
268
+
(modes js)
269
+
(preprocess
270
+
(pps ppx_blob))
271
+
(preprocessor_deps
272
+
(file style.css)))
273
+
```
274
+
275
+
**Step 2: Verify the build fails**
276
+
277
+
Run: `dune build x-ocaml/src/`
278
+
279
+
Expected: fails — `jtw_client.ml` still references `Js_top_worker_client_fut`.
280
+
281
+
**Step 3: Commit**
282
+
283
+
```
284
+
chore(x-ocaml): switch dune dep from client_fut to client.msg
285
+
```
286
+
287
+
### Task 2.2: Rewrite jtw_client.ml
288
+
289
+
**Files:**
290
+
- Modify: `x-ocaml/src/jtw_client.ml`
291
+
- Modify: `x-ocaml/src/jtw_client.mli`
292
+
293
+
**Step 1: Rewrite jtw_client.ml**
294
+
295
+
Replace the entire file. The new version uses `Js_top_worker_client_msg`
296
+
(aliased as `Jtw`) and converts between `X_protocol` types and
297
+
`Js_top_worker_message.Message` types.
298
+
299
+
```ocaml
300
+
(** Bridge between x-ocaml's X_protocol and js_top_worker's message protocol. *)
301
+
302
+
module Jtw = Js_top_worker_client_msg
303
+
module Msg = Js_top_worker_message.Message
304
+
305
+
type t = {
306
+
client : Jtw.t;
307
+
mutable on_message_cb : X_protocol.response -> unit;
308
+
}
309
+
310
+
let make url =
311
+
let client = Jtw.create url in
312
+
{ client; on_message_cb = (fun _ -> ()) }
313
+
314
+
let on_message t fn = t.on_message_cb <- fn
315
+
316
+
(** Send a response back to x-ocaml via the stored callback. *)
317
+
let respond t resp = t.on_message_cb resp
318
+
319
+
(** Convert Msg.completions to Protocol.completions *)
320
+
let convert_completions (c : Msg.completions) : Protocol.completions =
321
+
let convert_kind s : [ `Value | `Constructor | `Variant | `Label
322
+
| `Module | `Modtype | `Type | `MethodCall | `Keyword ] =
323
+
match s with
324
+
| "Constructor" -> `Constructor
325
+
| "Keyword" -> `Keyword
326
+
| "Label" -> `Label
327
+
| "MethodCall" -> `MethodCall
328
+
| "Modtype" -> `Modtype
329
+
| "Module" -> `Module
330
+
| "Type" -> `Type
331
+
| "Variant" -> `Variant
332
+
| _ -> `Value
333
+
in
334
+
{
335
+
Protocol.from = c.from;
336
+
to_ = c.to_;
337
+
entries = List.map (fun (e : Msg.compl_entry) ->
338
+
{ Query_protocol.Compl.name = e.name;
339
+
kind = convert_kind e.kind;
340
+
desc = e.desc;
341
+
info = e.info;
342
+
deprecated = e.deprecated }
343
+
) c.entries;
344
+
}
345
+
346
+
(** Convert Msg.error to Protocol.error *)
347
+
let convert_error (e : Msg.error) : Protocol.error =
348
+
let loc_of_msg_loc (l : Msg.location) : Ocaml_parsing.Location.t =
349
+
{ loc_start = { pos_fname = ""; pos_lnum = l.loc_start.pos_lnum;
350
+
pos_bol = l.loc_start.pos_bol; pos_cnum = l.loc_start.pos_cnum };
351
+
loc_end = { pos_fname = ""; pos_lnum = l.loc_end.pos_lnum;
352
+
pos_bol = l.loc_end.pos_bol; pos_cnum = l.loc_end.pos_cnum };
353
+
loc_ghost = false }
354
+
in
355
+
let kind = match e.kind with
356
+
| "error" -> Ocaml_parsing.Location.Report_error
357
+
| s when String.length s > 8 && String.sub s 0 8 = "warning:" ->
358
+
Report_warning (String.sub s 8 (String.length s - 8))
359
+
| s when String.length s > 17 && String.sub s 0 17 = "warning_as_error:" ->
360
+
Report_warning_as_error (String.sub s 17 (String.length s - 17))
361
+
| s when String.length s > 6 && String.sub s 0 6 = "alert:" ->
362
+
Report_alert (String.sub s 6 (String.length s - 6))
363
+
| s when String.length s > 15 && String.sub s 0 15 = "alert_as_error:" ->
364
+
Report_alert_as_error (String.sub s 15 (String.length s - 15))
365
+
| _ -> Report_error
366
+
in
367
+
let source = match e.source with
368
+
| "lexer" -> Ocaml_parsing.Location.Lexer
369
+
| "parser" -> Parser
370
+
| "typer" -> Typer
371
+
| "warning" -> Warning
372
+
| "env" -> Env
373
+
| "config" -> Config
374
+
| _ -> Unknown
375
+
in
376
+
{ Protocol.kind; loc = loc_of_msg_loc e.loc; main = e.main; sub = e.sub; source }
377
+
378
+
(** Convert Msg.type_info to typed_enclosings *)
379
+
let convert_type_info (t : Msg.type_info) =
380
+
let loc : Ocaml_parsing.Location.t =
381
+
{ loc_start = { pos_fname = ""; pos_lnum = t.loc.loc_start.pos_lnum;
382
+
pos_bol = t.loc.loc_start.pos_bol; pos_cnum = t.loc.loc_start.pos_cnum };
383
+
loc_end = { pos_fname = ""; pos_lnum = t.loc.loc_end.pos_lnum;
384
+
pos_bol = t.loc.loc_end.pos_bol; pos_cnum = t.loc.loc_end.pos_cnum };
385
+
loc_ghost = false }
386
+
in
387
+
let tail = match t.tail with
388
+
| "tail_position" -> `Tail_position
389
+
| "tail_call" -> `Tail_call
390
+
| _ -> `No
391
+
in
392
+
(loc, `String t.type_str, tail)
393
+
394
+
let init t =
395
+
let config : Msg.init_config = {
396
+
findlib_requires = [];
397
+
stdlib_dcs = None;
398
+
findlib_index = None;
399
+
} in
400
+
Lwt.async (fun () ->
401
+
let open Lwt.Infix in
402
+
Jtw.init t.client config >>= fun () ->
403
+
Lwt.return_unit)
404
+
405
+
let post t (req : X_protocol.request) =
406
+
match req with
407
+
| X_protocol.Eval (id, line_number, code) ->
408
+
Lwt.async (fun () ->
409
+
let open Lwt.Infix in
410
+
Lwt.catch (fun () ->
411
+
Jtw.eval t.client code >|= fun output ->
412
+
let outputs = ref [] in
413
+
if output.caml_ppf <> "" then
414
+
outputs := X_protocol.Meta output.caml_ppf :: !outputs;
415
+
if output.stdout <> "" then
416
+
outputs := X_protocol.Stdout output.stdout :: !outputs;
417
+
if output.stderr <> "" then
418
+
outputs := X_protocol.Stderr output.stderr :: !outputs;
419
+
let outputs = List.rev !outputs in
420
+
if line_number > 0 then
421
+
respond t (X_protocol.Top_response_at (id, line_number, outputs))
422
+
else
423
+
respond t (X_protocol.Top_response (id, outputs)))
424
+
(fun _exn ->
425
+
respond t (X_protocol.Top_response
426
+
(id, [X_protocol.Stderr "Internal error during evaluation"]));
427
+
Lwt.return_unit))
428
+
429
+
| X_protocol.Merlin (id, Protocol.Complete_prefix (src, pos)) ->
430
+
let position = match pos with
431
+
| `Offset n -> n
432
+
| _ -> 0
433
+
in
434
+
Lwt.async (fun () ->
435
+
let open Lwt.Infix in
436
+
Lwt.catch (fun () ->
437
+
Jtw.complete t.client src position >|= fun completions ->
438
+
respond t (X_protocol.Merlin_response
439
+
(id, Protocol.Completions (convert_completions completions))))
440
+
(fun _exn ->
441
+
respond t (X_protocol.Merlin_response
442
+
(id, Protocol.Completions { Protocol.from = 0; to_ = 0; entries = [] }));
443
+
Lwt.return_unit))
444
+
445
+
| X_protocol.Merlin (id, Protocol.Type_enclosing (src, pos)) ->
446
+
let position = match pos with
447
+
| `Offset n -> n
448
+
| _ -> 0
449
+
in
450
+
Lwt.async (fun () ->
451
+
let open Lwt.Infix in
452
+
Lwt.catch (fun () ->
453
+
Jtw.type_at t.client src position >|= fun types ->
454
+
respond t (X_protocol.Merlin_response
455
+
(id, Protocol.Typed_enclosings (List.map convert_type_info types))))
456
+
(fun _exn ->
457
+
respond t (X_protocol.Merlin_response
458
+
(id, Protocol.Typed_enclosings []));
459
+
Lwt.return_unit))
460
+
461
+
| X_protocol.Merlin (id, Protocol.All_errors src) ->
462
+
Lwt.async (fun () ->
463
+
let open Lwt.Infix in
464
+
Lwt.catch (fun () ->
465
+
Jtw.errors t.client src >|= fun errors ->
466
+
respond t (X_protocol.Merlin_response
467
+
(id, Protocol.Errors (List.map convert_error errors))))
468
+
(fun _exn ->
469
+
respond t (X_protocol.Merlin_response (id, Protocol.Errors []));
470
+
Lwt.return_unit))
471
+
472
+
| X_protocol.Merlin (id, Protocol.Add_cmis _) ->
473
+
respond t (X_protocol.Merlin_response (id, Protocol.Added_cmis))
474
+
475
+
| X_protocol.Format (id, code) ->
476
+
respond t (X_protocol.Formatted_source (id, code))
477
+
478
+
| X_protocol.Format_config _ -> ()
479
+
480
+
| X_protocol.Setup -> ()
481
+
482
+
let eval ~id ~line_number t code =
483
+
post t (X_protocol.Eval (id, line_number, code))
484
+
485
+
let fmt ~id t code =
486
+
post t (X_protocol.Format (id, code))
487
+
```
488
+
489
+
**Step 2: Update jtw_client.mli if it exists**
490
+
491
+
Verify the interface file matches — the signature should be unchanged
492
+
since the types `t`, `make`, `on_message`, `post`, `eval`, `fmt`, `init`
493
+
are the same.
494
+
495
+
**Step 3: Build**
496
+
497
+
Run: `dune build x-ocaml/src/`
498
+
499
+
Expected: success.
500
+
501
+
**Step 4: Commit**
502
+
503
+
```
504
+
refactor(x-ocaml): rewrite jtw_client to use message protocol
505
+
506
+
Replace Js_top_worker_client_fut (old RPC/IDL layer) with
507
+
Js_top_worker_client_msg (JSON message protocol). This removes the
508
+
dependency on rpclib, ppx_deriving_rpc, and toplevel_api_gen types
509
+
from the x-ocaml frontend.
510
+
```
511
+
512
+
---
513
+
514
+
## Batch 3: Wire filename through x-ocaml
515
+
516
+
### Task 3.1: Thread filename through jtw_client Merlin requests
517
+
518
+
**Files:**
519
+
- Modify: `x-ocaml/src/jtw_client.ml`
520
+
521
+
**Step 1: Store filename on the client, pass to Merlin calls**
522
+
523
+
This requires the Merlin requests in `post` to have access to a filename.
524
+
The filename comes from the `<x-ocaml>` element's `data-filename` attribute.
525
+
Since Merlin requests flow through `X_protocol.Merlin` which doesn't carry
526
+
filename, we need to either:
527
+
528
+
(a) Add filename to `X_protocol.Merlin`, or
529
+
(b) Store a per-cell filename mapping in jtw_client
530
+
531
+
Option (a) is cleaner — the Protocol.action variants already carry source,
532
+
so adding filename there is natural. But Protocol is shared with the
533
+
builtin backend (merlin-js).
534
+
535
+
For now, use option (a): extend `Protocol.action` to carry an optional
536
+
filename. This benefits both backends.
537
+
538
+
**Files:**
539
+
- Modify: `x-ocaml/merlin-js/src/protocol/protocol.ml`
540
+
- Modify: `x-ocaml/src/merlin_ext.ml`
541
+
- Modify: `x-ocaml/src/jtw_client.ml`
542
+
543
+
In `protocol.ml`, change:
544
+
545
+
```ocaml
546
+
type action =
547
+
| Complete_prefix of source * Msource.position * string option
548
+
| Type_enclosing of source * Msource.position * string option
549
+
| All_errors of source * string option
550
+
| Add_cmis of cmis
551
+
```
552
+
553
+
Update all pattern matches in:
554
+
- `merlin_ext.ml` (`fix_request`, `fix_answer`)
555
+
- `jtw_client.ml` (the `post` function's Merlin cases)
556
+
- `x-ocaml/merlin-js/src/worker/worker.ml` (the builtin backend dispatch)
557
+
- `x-ocaml/merlin-js/src/client/merlin_client.ml` (if it constructs actions)
558
+
559
+
In `jtw_client.ml`, pass filename through to `Jtw.complete`, `Jtw.type_at`,
560
+
`Jtw.errors`:
561
+
562
+
```ocaml
563
+
| X_protocol.Merlin (id, Protocol.Complete_prefix (src, pos, filename)) ->
564
+
...
565
+
Jtw.complete ?filename t.client src position >|= fun completions ->
566
+
```
567
+
568
+
**Step 2: Build**
569
+
570
+
Run: `dune build x-ocaml/`
571
+
572
+
Expected: success (filename is `None` everywhere by default).
573
+
574
+
**Step 3: Commit**
575
+
576
+
```
577
+
feat: add optional filename to Protocol.action for Merlin queries
578
+
```
579
+
580
+
### Task 3.2: Read data-filename from x-ocaml element
581
+
582
+
**Files:**
583
+
- Modify: `x-ocaml/src/x_ocaml.ml`
584
+
- Modify: `x-ocaml/src/cell.ml`
585
+
- Modify: `x-ocaml/src/cell.mli`
586
+
- Modify: `x-ocaml/src/merlin_ext.ml`
587
+
588
+
**Step 1: Read attribute in x_ocaml.ml and pass to cell**
589
+
590
+
In `x_ocaml.ml`, when creating a cell (around line 67):
591
+
592
+
```ocaml
593
+
let filename =
594
+
Option.map Jstr.to_string (Webcomponent.get_attribute this "data-filename")
595
+
in
596
+
let editor = Cell.init ~id ~run_on ~filename ...
597
+
```
598
+
599
+
**Step 2: Store filename in cell and use in Merlin requests**
600
+
601
+
In `cell.ml`, add `filename : string option` to the cell record.
602
+
In `merlin_ext.ml`, `fix_request` should inject the filename into the
603
+
Protocol action:
604
+
605
+
```ocaml
606
+
let fix_request t msg =
607
+
let pre = t.context () in
608
+
let pre_len = String.length pre in
609
+
let filename = t.filename in
610
+
match msg with
611
+
| Protocol.Complete_prefix (src, position, _) ->
612
+
let position = fix_position pre_len position in
613
+
Protocol.Complete_prefix (pre ^ src, position, filename)
614
+
| Protocol.Type_enclosing (src, position, _) ->
615
+
let position = fix_position pre_len position in
616
+
Protocol.Type_enclosing (pre ^ src, position, filename)
617
+
| Protocol.All_errors (src, _) ->
618
+
Protocol.All_errors (pre ^ src, filename)
619
+
| Protocol.Add_cmis _ as other -> other
620
+
```
621
+
622
+
Add `filename` to `merlin_ext.t`:
623
+
624
+
```ocaml
625
+
type t = { id : int; mutable context : unit -> string;
626
+
post_fn : X_protocol.request -> unit;
627
+
filename : string option }
628
+
```
629
+
630
+
**Step 3: Build and test**
631
+
632
+
Run: `dune build x-ocaml/`
633
+
634
+
Expected: success.
635
+
636
+
**Step 4: Test manually**
637
+
638
+
Create a test HTML page with:
639
+
640
+
```html
641
+
<x-ocaml data-filename="test.mli">
642
+
val x : int
643
+
</x-ocaml>
644
+
```
645
+
646
+
Verify that Merlin doesn't report errors for interface syntax.
647
+
648
+
**Step 5: Commit**
649
+
650
+
```
651
+
feat(x-ocaml): read data-filename and pass to Merlin queries
652
+
```
653
+
654
+
---
655
+
656
+
## Batch 4: Verify and clean up
657
+
658
+
### Task 4.1: Full build and test
659
+
660
+
**Step 1: Build everything**
661
+
662
+
Run: `dune build`
663
+
664
+
Expected: clean build with no warnings.
665
+
666
+
**Step 2: Run js_top_worker tests**
667
+
668
+
Run: `dune build @js_top_worker/test/runtest`
669
+
670
+
Expected: all tests pass (filename is backwards-compatible — None by default).
671
+
672
+
**Step 3: Commit any fixups**
673
+
674
+
### Task 4.2: Final commit and review
675
+
676
+
**Step 1: Review all changes**
677
+
678
+
Review the full diff against main to ensure:
679
+
- No dead code from the old RPC layer left in x-ocaml's deps
680
+
- `message.ml` changes are backwards compatible (optional field)
681
+
- All pattern matches handle the new filename field
682
+
683
+
**Step 2: Commit any remaining cleanup**
+3
-1
x-ocaml/src/dune
+3
-1
x-ocaml/src/dune
+155
-221
x-ocaml/src/jtw_client.ml
+155
-221
x-ocaml/src/jtw_client.ml
···
1
-
(** Bridge between x-ocaml's X_protocol and js_top_worker's JSON-RPC protocol.
1
+
(** Bridge between x-ocaml's X_protocol and js_top_worker's message protocol.
2
2
3
-
This module translates X_protocol requests into js_top_worker RPC calls
4
-
and converts the results back into X_protocol responses. *)
3
+
This module translates X_protocol requests into js_top_worker message
4
+
protocol calls and converts the results back into X_protocol responses. *)
5
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
6
+
module Jtw = Js_top_worker_client_msg
7
+
module Msg = Js_top_worker_message.Message
10
8
11
9
type t = {
12
-
rpc : Jtw.rpc;
10
+
client : Jtw.t;
13
11
mutable on_message_cb : X_protocol.response -> unit;
14
12
}
15
13
16
14
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 _ -> ()) }
15
+
let client = Jtw.create url in
16
+
{ client; on_message_cb = (fun _ -> ()) }
22
17
23
18
let on_message t fn = t.on_message_cb <- fn
24
19
25
20
(** Send a response back to x-ocaml via the stored callback. *)
26
21
let respond t resp = t.on_message_cb resp
27
22
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 =
23
+
(** Convert Msg.completions to Protocol.completions *)
24
+
let convert_completions (c : Msg.completions) : Protocol.completions =
25
+
let convert_kind s : [ `Value | `Constructor | `Variant | `Label
26
+
| `Module | `Modtype | `Type | `MethodCall | `Keyword ] =
27
+
match s with
28
+
| "Constructor" -> `Constructor
29
+
| "Keyword" -> `Keyword
30
+
| "Label" -> `Label
31
+
| "MethodCall" -> `MethodCall
32
+
| "Modtype" -> `Modtype
33
+
| "Module" -> `Module
34
+
| "Type" -> `Type
35
+
| "Variant" -> `Variant
36
+
| _ -> `Value
37
+
in
64
38
{
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;
39
+
Protocol.from = c.from;
40
+
to_ = c.to_;
41
+
entries = List.map (fun (e : Msg.compl_entry) ->
42
+
{ Query_protocol.Compl.name = e.name;
43
+
kind = convert_kind e.kind;
44
+
desc = e.desc;
45
+
info = e.info;
46
+
deprecated = e.deprecated }
47
+
) c.entries;
89
48
}
90
49
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
50
+
(** Convert Msg.error to Protocol.error *)
51
+
let convert_error (e : Msg.error) : Protocol.error =
52
+
let loc_of_msg_loc (l : Msg.location) : Ocaml_parsing.Location.t =
53
+
{ loc_start = { pos_fname = ""; pos_lnum = l.loc_start.pos_lnum;
54
+
pos_bol = l.loc_start.pos_bol; pos_cnum = l.loc_start.pos_cnum };
55
+
loc_end = { pos_fname = ""; pos_lnum = l.loc_end.pos_lnum;
56
+
pos_bol = l.loc_end.pos_bol; pos_cnum = l.loc_end.pos_cnum };
57
+
loc_ghost = false }
58
+
in
59
+
let kind = match e.kind with
60
+
| "error" -> Ocaml_parsing.Location.Report_error
61
+
| s when String.length s > 8 && String.sub s 0 8 = "warning:" ->
62
+
Report_warning (String.sub s 8 (String.length s - 8))
63
+
| s when String.length s > 17 && String.sub s 0 17 = "warning_as_error:" ->
64
+
Report_warning_as_error (String.sub s 17 (String.length s - 17))
65
+
| s when String.length s > 6 && String.sub s 0 6 = "alert:" ->
66
+
Report_alert (String.sub s 6 (String.length s - 6))
67
+
| s when String.length s > 15 && String.sub s 0 15 = "alert_as_error:" ->
68
+
Report_alert_as_error (String.sub s 15 (String.length s - 15))
69
+
| _ -> Report_error
70
+
in
71
+
let source = match e.source with
72
+
| "lexer" -> Ocaml_parsing.Location.Lexer
73
+
| "parser" -> Parser
74
+
| "typer" -> Typer
75
+
| "warning" -> Warning
76
+
| "env" -> Env
77
+
| "config" -> Config
78
+
| "unknown" -> Unknown
79
+
| _ -> Unknown
80
+
in
81
+
{ Protocol.kind; loc = loc_of_msg_loc e.loc; main = e.main; sub = e.sub; source }
134
82
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
-
}
83
+
(** Convert Msg.type_info to typed_enclosings entry *)
84
+
let convert_type_info (t : Msg.type_info) =
85
+
let loc : Ocaml_parsing.Location.t =
86
+
{ loc_start = { pos_fname = ""; pos_lnum = t.loc.loc_start.pos_lnum;
87
+
pos_bol = t.loc.loc_start.pos_bol; pos_cnum = t.loc.loc_start.pos_cnum };
88
+
loc_end = { pos_fname = ""; pos_lnum = t.loc.loc_end.pos_lnum;
89
+
pos_bol = t.loc.loc_end.pos_bol; pos_cnum = t.loc.loc_end.pos_cnum };
90
+
loc_ghost = false }
151
91
in
152
-
let _fut : unit Fut.t =
153
-
let* result = W.init t.rpc config in
154
-
(match result with
155
-
| Ok () ->
156
-
(* Setup the default environment (loads stdlib, etc.) *)
157
-
let* _setup = W.setup t.rpc "" in
158
-
Fut.return ()
159
-
| Error (Api.InternalError _msg) ->
160
-
Console.(log [ str "jtw_client init error:"; str _msg ]);
161
-
Fut.return ())
92
+
let tail = match t.tail with
93
+
| "tail_position" -> `Tail_position
94
+
| "tail_call" -> `Tail_call
95
+
| _ -> `No
162
96
in
163
-
()
97
+
(loc, `String t.type_str, tail)
98
+
99
+
let init t =
100
+
let config : Msg.init_config = {
101
+
findlib_requires = [];
102
+
stdlib_dcs = None;
103
+
findlib_index = None;
104
+
} in
105
+
Lwt.async (fun () ->
106
+
let open Lwt.Infix in
107
+
Jtw.init t.client config >>= fun () ->
108
+
Lwt.return_unit)
164
109
165
110
let post t (req : X_protocol.request) =
166
-
let open Fut.Syntax in
167
111
match req with
168
112
| X_protocol.Eval (id, line_number, code) ->
169
-
let _fut : unit Fut.t =
170
-
let* result = W.exec t.rpc "" code in
171
-
(match handle_error result with
172
-
| Some exec_result ->
173
-
let outputs = convert_exec_result exec_result in
174
-
if line_number > 0 then
175
-
respond t (X_protocol.Top_response_at (id, line_number, outputs))
176
-
else
177
-
respond t (X_protocol.Top_response (id, outputs))
178
-
| None ->
179
-
respond t
180
-
(X_protocol.Top_response
181
-
(id, [ X_protocol.Stderr "Internal error during evaluation" ])));
182
-
Fut.return ()
183
-
in
184
-
()
185
-
| X_protocol.Merlin (id, Protocol.Complete_prefix (src, pos, _filename)) ->
186
-
let jtw_pos = convert_position pos in
187
-
let _fut : unit Fut.t =
188
-
let* result =
189
-
W.complete_prefix t.rpc "" None [] false src jtw_pos
190
-
in
191
-
(match handle_error result with
192
-
| Some completions ->
193
-
let converted = convert_completions completions in
194
-
respond t
195
-
(X_protocol.Merlin_response (id, Protocol.Completions converted))
196
-
| None ->
197
-
respond t
198
-
(X_protocol.Merlin_response
199
-
(id,
200
-
Protocol.Completions
201
-
{ Protocol.from = 0; to_ = 0; entries = [] })));
202
-
Fut.return ()
203
-
in
204
-
()
205
-
| X_protocol.Merlin (id, Protocol.Type_enclosing (src, pos, _filename)) ->
206
-
let jtw_pos = convert_position pos in
207
-
let _fut : unit Fut.t =
208
-
let* result =
209
-
W.type_enclosing t.rpc "" None [] false src jtw_pos
210
-
in
211
-
(match handle_error result with
212
-
| Some enclosings ->
213
-
let converted = List.map convert_typed_enclosing enclosings in
214
-
respond t
215
-
(X_protocol.Merlin_response
216
-
(id, Protocol.Typed_enclosings converted))
217
-
| None ->
218
-
respond t
219
-
(X_protocol.Merlin_response
220
-
(id, Protocol.Typed_enclosings [])));
221
-
Fut.return ()
113
+
Lwt.async (fun () ->
114
+
let open Lwt.Infix in
115
+
Lwt.catch (fun () ->
116
+
Jtw.eval t.client code >|= fun output ->
117
+
let outputs = ref [] in
118
+
if output.caml_ppf <> "" then
119
+
outputs := X_protocol.Meta output.caml_ppf :: !outputs;
120
+
if output.stdout <> "" then
121
+
outputs := X_protocol.Stdout output.stdout :: !outputs;
122
+
if output.stderr <> "" then
123
+
outputs := X_protocol.Stderr output.stderr :: !outputs;
124
+
let outputs = List.rev !outputs in
125
+
if line_number > 0 then
126
+
respond t (X_protocol.Top_response_at (id, line_number, outputs))
127
+
else
128
+
respond t (X_protocol.Top_response (id, outputs)))
129
+
(fun _exn ->
130
+
respond t (X_protocol.Top_response
131
+
(id, [X_protocol.Stderr "Internal error during evaluation"]));
132
+
Lwt.return_unit))
133
+
134
+
| X_protocol.Merlin (id, Protocol.Complete_prefix (src, pos, filename)) ->
135
+
let position = match pos with
136
+
| `Offset n -> n
137
+
| _ -> 0
222
138
in
223
-
()
224
-
| X_protocol.Merlin (id, Protocol.All_errors (src, _filename)) ->
225
-
let _fut : unit Fut.t =
226
-
let* result =
227
-
W.query_errors t.rpc "" None [] false src
228
-
in
229
-
(match handle_error result with
230
-
| Some errors ->
231
-
let converted = List.map convert_error errors in
232
-
respond t
233
-
(X_protocol.Merlin_response (id, Protocol.Errors converted))
234
-
| None ->
235
-
respond t
236
-
(X_protocol.Merlin_response (id, Protocol.Errors [])));
237
-
Fut.return ()
139
+
Lwt.async (fun () ->
140
+
let open Lwt.Infix in
141
+
Lwt.catch (fun () ->
142
+
Jtw.complete ?filename t.client src position >|= fun completions ->
143
+
respond t (X_protocol.Merlin_response
144
+
(id, Protocol.Completions (convert_completions completions))))
145
+
(fun _exn ->
146
+
respond t (X_protocol.Merlin_response
147
+
(id, Protocol.Completions { Protocol.from = 0; to_ = 0; entries = [] }));
148
+
Lwt.return_unit))
149
+
150
+
| X_protocol.Merlin (id, Protocol.Type_enclosing (src, pos, filename)) ->
151
+
let position = match pos with
152
+
| `Offset n -> n
153
+
| _ -> 0
238
154
in
239
-
()
155
+
Lwt.async (fun () ->
156
+
let open Lwt.Infix in
157
+
Lwt.catch (fun () ->
158
+
Jtw.type_at ?filename t.client src position >|= fun types ->
159
+
respond t (X_protocol.Merlin_response
160
+
(id, Protocol.Typed_enclosings (List.map convert_type_info types))))
161
+
(fun _exn ->
162
+
respond t (X_protocol.Merlin_response
163
+
(id, Protocol.Typed_enclosings []));
164
+
Lwt.return_unit))
165
+
166
+
| X_protocol.Merlin (id, Protocol.All_errors (src, filename)) ->
167
+
Lwt.async (fun () ->
168
+
let open Lwt.Infix in
169
+
Lwt.catch (fun () ->
170
+
Jtw.errors ?filename t.client src >|= fun errors ->
171
+
respond t (X_protocol.Merlin_response
172
+
(id, Protocol.Errors (List.map convert_error errors))))
173
+
(fun _exn ->
174
+
respond t (X_protocol.Merlin_response (id, Protocol.Errors []));
175
+
Lwt.return_unit))
176
+
240
177
| X_protocol.Merlin (id, Protocol.Add_cmis _) ->
241
-
(* js_top_worker handles CMI loading internally via its init config *)
242
178
respond t (X_protocol.Merlin_response (id, Protocol.Added_cmis))
179
+
243
180
| X_protocol.Format (id, code) ->
244
-
(* js_top_worker doesn't support formatting; return the code as-is *)
245
181
respond t (X_protocol.Formatted_source (id, code))
246
-
| X_protocol.Format_config _ ->
247
-
(* No-op: js_top_worker doesn't support format configuration *)
248
-
()
249
-
| X_protocol.Setup ->
250
-
(* init already called by make_jtw; no-op here *)
251
-
()
182
+
183
+
| X_protocol.Format_config _ -> ()
184
+
185
+
| X_protocol.Setup -> ()
252
186
253
187
let eval ~id ~line_number t code =
254
188
post t (X_protocol.Eval (id, line_number, code))