forked from
anil.recoil.org/monopam-myspace
My aggregated monorepo of OCaml code, automaintained
feat(js_top_worker): add filename field to message protocol
Add optional filename parameter to Complete, TypeAt, and Errors
messages so Merlin can be configured for .mli vs .ml files.
Thread filename through impl.ml's config/wdispatch/query functions
and wire it in worker.ml's message handler.
Co-Authored-By: Claude Opus 4.6 <noreply@anthropic.com>
+31
-22
+6
-3
js_top_worker/idl/message.ml
+6
-3
js_top_worker/idl/message.ml
···
62
62
type client_msg =
63
63
| Init of init_config
64
64
| Eval of { cell_id : int; env_id : string; code : string }
65
-
| Complete of { cell_id : int; env_id : string; source : string; position : int }
66
-
| TypeAt of { cell_id : int; env_id : string; source : string; position : int }
67
-
| Errors of { cell_id : int; env_id : string; source : string }
65
+
| Complete of { cell_id : int; env_id : string; source : string; position : int; filename : string option }
66
+
| TypeAt of { cell_id : int; env_id : string; source : string; position : int; filename : string option }
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
70
···
273
273
env_id = get_string obj "env_id";
274
274
source = get_string obj "source";
275
275
position = get_int obj "position";
276
+
filename = get_string_opt obj "filename";
276
277
}
277
278
| "type_at" ->
278
279
TypeAt {
···
280
281
env_id = get_string obj "env_id";
281
282
source = get_string obj "source";
282
283
position = get_int obj "position";
284
+
filename = get_string_opt obj "filename";
283
285
}
284
286
| "errors" ->
285
287
Errors {
286
288
cell_id = get_int obj "cell_id";
287
289
env_id = get_string obj "env_id";
288
290
source = get_string obj "source";
291
+
filename = get_string_opt obj "filename";
289
292
}
290
293
| "create_env" ->
291
294
CreateEnv { env_id = get_string obj "env_id" }
+19
-13
js_top_worker/lib/impl.ml
+19
-13
js_top_worker/lib/impl.ml
···
829
829
Code intelligence features powered by Merlin: completion, type info,
830
830
error diagnostics. *)
831
831
832
-
let config () =
832
+
let config ?filename () =
833
833
let path =
834
834
match !path with Some p -> p | None -> failwith "Path not set"
835
835
in
836
836
let initial = Merlin_kernel.Mconfig.initial in
837
-
{ initial with merlin = { initial.merlin with stdlib = Some path } }
837
+
let query = match filename with
838
+
| Some f -> { initial.query with filename = f }
839
+
| None -> initial.query
840
+
in
841
+
{ initial with
842
+
merlin = { initial.merlin with stdlib = Some path };
843
+
query }
838
844
839
-
let make_pipeline source = Merlin_kernel.Mpipeline.make (config ()) source
845
+
let make_pipeline ?filename source = Merlin_kernel.Mpipeline.make (config ?filename ()) source
840
846
841
-
let wdispatch source query =
842
-
let pipeline = make_pipeline source in
847
+
let wdispatch ?filename source query =
848
+
let pipeline = make_pipeline ?filename source in
843
849
Merlin_kernel.Mpipeline.with_pipeline pipeline @@ fun () ->
844
850
Query_commands.dispatch pipeline query
845
851
···
925
931
| None -> reconstructed_prefix
926
932
else reconstructed_prefix
927
933
928
-
let at_pos source position =
934
+
let at_pos ?filename source position =
929
935
let prefix = prefix_of_position source position in
930
936
let (`Offset to_) = Msource.get_offset source position in
931
937
let from =
···
937
943
let query =
938
944
Query_protocol.Complete_prefix (prefix, position, [], true, true)
939
945
in
940
-
Some (from, to_, wdispatch source query)
946
+
Some (from, to_, wdispatch ?filename source query)
941
947
end
942
948
943
-
let complete_prefix env_id id deps is_toplevel source position =
949
+
let complete_prefix ?filename env_id id deps is_toplevel source position =
944
950
let _env = resolve_env env_id in (* Reserved for future use *)
945
951
try
946
952
Logs.info (fun m -> m "completing for id: %s" (match id with Some x -> x | None -> "(none)"));
···
985
991
Logs.info (fun m -> m "complete after offset: %s" first_char)
986
992
| _ -> ());
987
993
988
-
match Completion.at_pos source position with
994
+
match Completion.at_pos ?filename source position with
989
995
| Some (from, to_, compl) ->
990
996
let entries =
991
997
List.map
···
1089
1095
Ocaml_utils.Warnings.loc_end = map_pos line1 loc.loc_end;
1090
1096
}
1091
1097
1092
-
let query_errors env_id id deps is_toplevel orig_source =
1098
+
let query_errors ?filename env_id id deps is_toplevel orig_source =
1093
1099
let execution_env = resolve_env env_id in
1094
1100
try
1095
1101
let deps =
···
1102
1108
Query_protocol.Errors { lexing = true; parsing = true; typing = true }
1103
1109
in
1104
1110
let errors =
1105
-
wdispatch source query
1111
+
wdispatch ?filename source query
1106
1112
|> StdLabels.List.filter_map
1107
1113
~f:(fun
1108
1114
(Ocaml_parsing.Location.{ kind; main = _; sub; source; _ } as
···
1145
1151
IdlM.ErrM.return_err
1146
1152
(Toplevel_api_gen.InternalError (Printexc.to_string e))
1147
1153
1148
-
let type_enclosing env_id _id deps is_toplevel orig_source position =
1154
+
let type_enclosing ?filename env_id _id deps is_toplevel orig_source position =
1149
1155
let execution_env = resolve_env env_id in
1150
1156
try
1151
1157
let deps =
···
1162
1168
in
1163
1169
let source = Merlin_kernel.Msource.make src in
1164
1170
let query = Query_protocol.Type_enclosing (None, position, None) in
1165
-
let enclosing = wdispatch source query in
1171
+
let enclosing = wdispatch ?filename source query in
1166
1172
let map_index_or_string = function
1167
1173
| `Index i -> Toplevel_api_gen.Index i
1168
1174
| `String s -> String s
+6
-6
js_top_worker/lib/worker.ml
+6
-6
js_top_worker/lib/worker.ml
···
234
234
| Error (Toplevel_api_gen.InternalError msg) ->
235
235
send_message (Msg.EvalError { cell_id; message = msg }))
236
236
237
-
| Msg.Complete { cell_id; env_id; source; position } ->
237
+
| Msg.Complete { cell_id; env_id; source; position; filename } ->
238
238
let pos = position_of_int position in
239
-
Rpc_lwt.T.get (M.complete_prefix env_id None [] false source pos) >|= fun result ->
239
+
Rpc_lwt.T.get (M.complete_prefix ?filename env_id None [] false source pos) >|= fun result ->
240
240
(match result with
241
241
| Ok completions ->
242
242
send_message (completions_of_result cell_id completions)
243
243
| Error (Toplevel_api_gen.InternalError msg) ->
244
244
send_message (Msg.EvalError { cell_id; message = msg }))
245
245
246
-
| Msg.TypeAt { cell_id; env_id; source; position } ->
246
+
| Msg.TypeAt { cell_id; env_id; source; position; filename } ->
247
247
let pos = position_of_int position in
248
-
Rpc_lwt.T.get (M.type_enclosing env_id None [] false source pos) >|= fun result ->
248
+
Rpc_lwt.T.get (M.type_enclosing ?filename env_id None [] false source pos) >|= fun result ->
249
249
(match result with
250
250
| Ok types ->
251
251
send_message (types_of_result cell_id types)
252
252
| Error (Toplevel_api_gen.InternalError msg) ->
253
253
send_message (Msg.EvalError { cell_id; message = msg }))
254
254
255
-
| Msg.Errors { cell_id; env_id; source } ->
256
-
Rpc_lwt.T.get (M.query_errors env_id None [] false source) >|= fun result ->
255
+
| Msg.Errors { cell_id; env_id; source; filename } ->
256
+
Rpc_lwt.T.get (M.query_errors ?filename env_id None [] false source) >|= fun result ->
257
257
(match result with
258
258
| Ok errors ->
259
259
send_message (errors_of_result cell_id errors)