this repo has no description
More work
+396
-156
+54
CLAUDE.md
+54
CLAUDE.md
···
1
+
# CLAUDE.md
2
+
3
+
This file provides guidance to Claude Code (claude.ai/code) when working with code in this repository.
4
+
5
+
## Project Overview
6
+
7
+
This is an OCaml toplevel (REPL) designed to run in a web worker. The project consists of multiple OPAM packages that work together to provide an OCaml interactive environment in the browser.
8
+
9
+
## Build Commands
10
+
11
+
```bash
12
+
# Build the entire project
13
+
dune build
14
+
15
+
# Run tests
16
+
dune runtest
17
+
18
+
# Build and watch for changes
19
+
dune build --watch
20
+
21
+
# Run a specific test
22
+
dune test test/cram
23
+
```
24
+
25
+
## Running the Example
26
+
27
+
The worker needs to be served by an HTTP server rather than loaded from the filesystem:
28
+
29
+
```bash
30
+
dune build
31
+
cd _build/default/example
32
+
python3 -m http.server 8000
33
+
# Then open http://localhost:8000/
34
+
```
35
+
36
+
## Architecture
37
+
38
+
The codebase is organized into several interconnected packages:
39
+
40
+
- **js_top_worker**: Core library implementing the OCaml toplevel functionality
41
+
- **js_top_worker-web**: Web-specific worker implementation with browser integration
42
+
- **js_top_worker-client**: Client library for communicating with the worker (Lwt-based)
43
+
- **js_top_worker-client_fut**: Alternative client library using Fut for concurrency
44
+
- **js_top_worker-rpc**: RPC definitions and communication layer
45
+
- **js_top_worker-unix**: Unix implementation for testing outside the browser
46
+
- **js_top_worker-bin**: Command-line tools including `jtw` for package management
47
+
48
+
Key directories:
49
+
- `lib/`: Core toplevel implementation with OCaml compiler integration
50
+
- `idl/`: RPC interface definitions using `ppx_deriving_rpc`
51
+
- `example/`: Example applications demonstrating worker usage
52
+
- `bin/`: Command-line tools, notably `jtw` for OPAM package handling
53
+
54
+
The system uses RPC (via `rpclib`) for communication between the client and worker, with support for both browser WebWorkers and Unix sockets for testing.
+8
-1
example/dune
+8
-1
example/dune
···
44
44
(package js_top_worker-unix)
45
45
(modules unix_worker)
46
46
(link_flags (-linkall))
47
-
(libraries js_top_worker logs logs.fmt rpclib.core rpclib.json findlib.top lwt.unix))
47
+
(libraries
48
+
js_top_worker
49
+
logs
50
+
logs.fmt
51
+
rpclib.core
52
+
rpclib.json
53
+
findlib.top
54
+
lwt.unix))
48
55
49
56
(executable
50
57
(name unix_client)
+8
-8
example/unix_worker.ml
+8
-8
example/unix_worker.ml
···
50
50
Sys.remove filename_out;
51
51
Sys.remove filename_err)
52
52
53
-
let (let*) = Lwt.bind
54
-
53
+
let ( let* ) = Lwt.bind
55
54
56
55
let binary_handler process s =
57
56
(* Read a 16 byte length encoded as a string *)
···
75
74
p_mkdir dir
76
75
77
76
let serve_requests rpcfn path =
78
-
let (let*) = Lwt.bind in
77
+
let ( let* ) = Lwt.bind in
79
78
(try Unix.unlink path with Unix.Unix_error (Unix.ENOENT, _, _) -> ());
80
79
mkdir_rec (Filename.dirname path) 0o0755;
81
80
let sock = Lwt_unix.socket Unix.PF_UNIX Unix.SOCK_STREAM 0 in
···
84
83
let rec loop () =
85
84
let* this_connection, _ = Lwt_unix.accept sock in
86
85
let* () =
87
-
Lwt.finalize (fun () ->
88
-
(* Here I am calling M.run to make sure that I am running the process,
86
+
Lwt.finalize
87
+
(fun () ->
88
+
(* Here I am calling M.run to make sure that I am running the process,
89
89
this is not much of a problem with IdM or ExnM, but in general you
90
90
should ensure that the computation is started by a runner. *)
91
-
binary_handler rpcfn this_connection)
92
-
(fun () -> Lwt_unix.close this_connection)
91
+
binary_handler rpcfn this_connection)
92
+
(fun () -> Lwt_unix.close this_connection)
93
93
in
94
94
loop ()
95
95
in
···
131
131
with exn ->
132
132
handle_findlib_error exn;
133
133
[]
134
-
134
+
135
135
let path = "/tmp"
136
136
end
137
137
+95
-93
lib/impl.ml
+95
-93
lib/impl.ml
···
235
235
with End_of_file -> ());
236
236
flush_all ()
237
237
238
-
let execute :
239
-
string ->
240
-
Toplevel_api_gen.exec_result =
238
+
let execute : string -> Toplevel_api_gen.exec_result =
241
239
let code_buff = Buffer.create 100 in
242
240
let res_buff = Buffer.create 100 in
243
241
let pp_code = Format.formatter_of_buffer code_buff in
···
304
302
let path =
305
303
match !path with Some p -> p | None -> failwith "Path not set"
306
304
in
307
-
let (let*) = Lwt.bind in
308
-
let* () = Lwt_list.iter_p
309
-
(fun name ->
310
-
let filename = filename_of_module name in
311
-
let* r = fetch (filename_of_module name) in
312
-
let () =
313
-
match r with
314
-
| Ok content -> (
315
-
let name = Filename.(concat path filename) in
316
-
try S.create_file ~name ~content with _ -> ())
317
-
| Error _ -> () in
318
-
Lwt.return ())
319
-
dcs.dcs_toplevel_modules
305
+
let ( let* ) = Lwt.bind in
306
+
let* () =
307
+
Lwt_list.iter_p
308
+
(fun name ->
309
+
let filename = filename_of_module name in
310
+
let* r = fetch (filename_of_module name) in
311
+
let () =
312
+
match r with
313
+
| Ok content -> (
314
+
let name = Filename.(concat path filename) in
315
+
try S.create_file ~name ~content with _ -> ())
316
+
| Error _ -> ()
317
+
in
318
+
Lwt.return ())
319
+
dcs.dcs_toplevel_modules
320
320
in
321
321
322
322
let new_load ~s ~old_loader ~allow_hidden ~unit_name =
···
352
352
let furl = "file://" in
353
353
let l = String.length furl in
354
354
let () =
355
-
if String.length dcs.dcs_url > l && String.sub dcs.dcs_url 0 l = furl then
356
-
let path = String.sub dcs.dcs_url l (String.length dcs.dcs_url - l) in
357
-
Topdirs.dir_directory path
358
-
else
359
-
let open Persistent_env.Persistent_signature in
360
-
let old_loader = !load in
361
-
load := new_load ~s:"comp" ~old_loader;
355
+
if String.length dcs.dcs_url > l && String.sub dcs.dcs_url 0 l = furl then
356
+
let path = String.sub dcs.dcs_url l (String.length dcs.dcs_url - l) in
357
+
Topdirs.dir_directory path
358
+
else
359
+
let open Persistent_env.Persistent_signature in
360
+
let old_loader = !load in
361
+
load := new_load ~s:"comp" ~old_loader;
362
362
363
-
let open Ocaml_typing.Persistent_env.Persistent_signature in
364
-
let old_loader = !load in
365
-
load := new_load ~s:"merl" ~old_loader in
363
+
let open Ocaml_typing.Persistent_env.Persistent_signature in
364
+
let old_loader = !load in
365
+
load := new_load ~s:"merl" ~old_loader
366
+
in
366
367
Lwt.return ()
367
368
368
369
let init (init_libs : Toplevel_api_gen.init_config) =
369
-
Lwt.catch (fun () ->
370
-
Logs.info (fun m -> m "init()");
371
-
path := Some S.path;
370
+
Lwt.catch
371
+
(fun () ->
372
+
Logs.info (fun m -> m "init()");
373
+
path := Some S.path;
372
374
373
-
findlib_v := Some (S.findlib_init "findlib_index");
374
-
let stdlib_dcs =
375
-
match init_libs.stdlib_dcs with
376
-
| Some dcs -> dcs
377
-
| None -> "lib/ocaml/dynamic_cmis.json"
378
-
in
379
-
let* () =
380
-
match S.get_stdlib_dcs stdlib_dcs with
381
-
| [ dcs ] -> add_dynamic_cmis dcs
382
-
| _ -> Lwt.return () in
383
-
Clflags.no_check_prims := true;
375
+
findlib_v := Some (S.findlib_init "findlib_index");
376
+
let stdlib_dcs =
377
+
match init_libs.stdlib_dcs with
378
+
| Some dcs -> dcs
379
+
| None -> "lib/ocaml/dynamic_cmis.json"
380
+
in
381
+
let* () =
382
+
match S.get_stdlib_dcs stdlib_dcs with
383
+
| [ dcs ] -> add_dynamic_cmis dcs
384
+
| _ -> Lwt.return ()
385
+
in
386
+
Clflags.no_check_prims := true;
384
387
385
-
requires := init_libs.findlib_requires;
386
-
functions := Some [];
387
-
execution_allowed := init_libs.execute;
388
+
requires := init_libs.findlib_requires;
389
+
functions := Some [];
390
+
execution_allowed := init_libs.execute;
388
391
389
-
(* Set up the toplevel environment *)
390
-
Logs.info (fun m -> m "init() finished");
392
+
(* Set up the toplevel environment *)
393
+
Logs.info (fun m -> m "init() finished");
391
394
392
-
Lwt.return (Ok ()))
393
-
(fun e ->
394
-
Lwt.return (Error
395
-
(Toplevel_api_gen.InternalError (Printexc.to_string e))))
395
+
Lwt.return (Ok ()))
396
+
(fun e ->
397
+
Lwt.return
398
+
(Error (Toplevel_api_gen.InternalError (Printexc.to_string e))))
396
399
397
400
let setup () =
398
-
Lwt.catch (fun () ->
399
-
Logs.info (fun m -> m "setup() ...");
401
+
Lwt.catch
402
+
(fun () ->
403
+
Logs.info (fun m -> m "setup() ...");
400
404
401
-
let o =
402
-
try
403
-
match !functions with
404
-
| Some l -> setup l ()
405
-
| None -> failwith "Error: toplevel has not been initialised"
406
-
with
407
-
| Persistent_env.Error e ->
408
-
Persistent_env.report_error Format.err_formatter e;
409
-
let err = Format.asprintf "%a" Persistent_env.report_error e in
410
-
failwith ("Error: " ^ err)
411
-
| Env.Error e ->
412
-
Env.report_error Format.err_formatter e;
413
-
let err = Format.asprintf "%a" Env.report_error e in
414
-
failwith ("Error: " ^ err)
415
-
in
405
+
let o =
406
+
try
407
+
match !functions with
408
+
| Some l -> setup l ()
409
+
| None -> failwith "Error: toplevel has not been initialised"
410
+
with
411
+
| Persistent_env.Error e ->
412
+
Persistent_env.report_error Format.err_formatter e;
413
+
let err = Format.asprintf "%a" Persistent_env.report_error e in
414
+
failwith ("Error: " ^ err)
415
+
| Env.Error e ->
416
+
Env.report_error Format.err_formatter e;
417
+
let err = Format.asprintf "%a" Env.report_error e in
418
+
failwith ("Error: " ^ err)
419
+
in
416
420
417
-
let dcs =
418
-
match !findlib_v with
419
-
| Some v -> S.require (not !execution_allowed) v !requires
420
-
| None -> []
421
-
in
422
-
let* () = Lwt_list.iter_p add_dynamic_cmis dcs in
421
+
let dcs =
422
+
match !findlib_v with
423
+
| Some v -> S.require (not !execution_allowed) v !requires
424
+
| None -> []
425
+
in
426
+
let* () = Lwt_list.iter_p add_dynamic_cmis dcs in
423
427
424
-
Logs.info (fun m -> m "setup() finished");
428
+
Logs.info (fun m -> m "setup() finished");
425
429
426
-
Lwt.return
427
-
(Ok Toplevel_api_gen.
428
-
{
429
-
stdout = string_opt o.stdout;
430
-
stderr = string_opt o.stderr;
431
-
sharp_ppf = None;
432
-
caml_ppf = None;
433
-
highlight = None;
434
-
mime_vals = [];
435
-
}))
436
-
(fun e ->
437
-
Lwt.return (Error
438
-
(Toplevel_api_gen.InternalError (Printexc.to_string e))))
430
+
Lwt.return
431
+
(Ok
432
+
Toplevel_api_gen.
433
+
{
434
+
stdout = string_opt o.stdout;
435
+
stderr = string_opt o.stderr;
436
+
sharp_ppf = None;
437
+
caml_ppf = None;
438
+
highlight = None;
439
+
mime_vals = [];
440
+
}))
441
+
(fun e ->
442
+
Lwt.return
443
+
(Error (Toplevel_api_gen.InternalError (Printexc.to_string e))))
439
444
440
445
let complete _phrase = failwith "Not implemented"
441
446
···
602
607
let mime_vals =
603
608
List.fold_left
604
609
(fun acc (phr, _junk, _output) ->
605
-
let new_output =
606
-
execute phr
607
-
in
610
+
let new_output = execute phr in
608
611
Printf.bprintf buf "# %s\n" phr;
609
612
let r =
610
613
Option.to_list new_output.stdout
···
839
842
let b = Sys.file_exists (prefix ^ ".cmi") in
840
843
failed_cells := StringSet.remove id !failed_cells;
841
844
Logs.info (fun m -> m "file_exists: %s = %b" (prefix ^ ".cmi") b));
842
-
Ocaml_typing.Cmi_cache.clear ();
845
+
Ocaml_typing.Cmi_cache.clear ()
843
846
with
844
847
| Env.Error e ->
845
848
Logs.err (fun m -> m "Env.Error: %a" Env.report_error e);
···
913
916
source;
914
917
})
915
918
in
916
-
(if List.length errors = 0
917
-
then add_cmi id deps src
918
-
else failed_cells := StringSet.add id !failed_cells);
919
+
if List.length errors = 0 then add_cmi id deps src
920
+
else failed_cells := StringSet.add id !failed_cells;
919
921
920
922
(* Logs.info (fun m -> m "Got to end"); *)
921
923
IdlM.ErrM.return errors
+14
-15
lib/jslib.ml
+14
-15
lib/jslib.ml
···
3
3
(fun s -> Js_of_ocaml.(Console.console##log (Js.string s)))
4
4
fmt
5
5
6
-
7
6
let map_url url =
8
7
let open Js_of_ocaml in
9
8
let global_rel_url =
10
-
let x : Js.js_string Js.t option = Js.Unsafe.js_expr "globalThis.__global_rel_url" |> Js.Optdef.to_option in
9
+
let x : Js.js_string Js.t option =
10
+
Js.Unsafe.js_expr "globalThis.__global_rel_url" |> Js.Optdef.to_option
11
+
in
11
12
Option.map Js.to_string x
12
13
in
13
-
match global_rel_url with
14
-
| Some rel -> Filename.concat rel url
15
-
| None -> url
14
+
match global_rel_url with Some rel -> Filename.concat rel url | None -> url
16
15
17
16
let sync_get url =
18
17
let open Js_of_ocaml in
···
32
31
(fun b -> Some (Typed_array.String.of_arrayBuffer b))
33
32
| _ -> None
34
33
35
-
36
34
let async_get url =
37
-
let (let*) = Lwt.bind in
35
+
let ( let* ) = Lwt.bind in
38
36
let open Js_of_ocaml in
39
37
Console.console##log (Js.string ("Fetching: " ^ url));
40
-
let* frame = Js_of_ocaml_lwt.XmlHttpRequest.perform_raw
41
-
~response_type:ArrayBuffer url in
38
+
let* frame =
39
+
Js_of_ocaml_lwt.XmlHttpRequest.perform_raw ~response_type:ArrayBuffer url
40
+
in
42
41
match frame.code with
43
42
| 200 ->
44
-
Lwt.return (Js.Opt.case
45
-
frame.content
46
-
(fun () ->
47
-
Error (`Msg "Failed to receive file"))
48
-
(fun b -> Ok (Typed_array.String.of_arrayBuffer b)))
43
+
Lwt.return
44
+
(Js.Opt.case frame.content
45
+
(fun () -> Error (`Msg "Failed to receive file"))
46
+
(fun b -> Ok (Typed_array.String.of_arrayBuffer b)))
49
47
| _ ->
50
-
Lwt.return (Error (`Msg (Printf.sprintf "Failed to fetch %s: %d" url frame.code)))
48
+
Lwt.return
49
+
(Error (`Msg (Printf.sprintf "Failed to fetch %s: %d" url frame.code)))
+5
lib/stubs.js
+5
lib/stubs.js
+1
-1
test/cram/simple.t/script.sh
+1
-1
test/cram/simple.t/script.sh
+1
-1
test/node/dune
+1
-1
test/node/dune
+34
-10
test/node/node_test.expected
+34
-10
test/node/node_test.expected
···
1
1
node_test.js: [INFO] init()
2
+
Initializing findlib
2
3
node_test.js: [INFO] sync_get: _opam/findlib_index
3
4
node_test.js: [INFO] sync_get: _opam/lib/ocaml/stdlib/META
4
5
node_test.js: [INFO] sync_get: _opam/lib/astring/META
5
6
Parsed uri: lib/ocaml/stdlib/META
6
7
Parsed uri: lib/astring/META
7
8
node_test.js: [INFO] sync_get: _opam/lib/ocaml/dynamic_cmis.json
8
-
node_test.js: [INFO] sync_get: _opam/lib/ocaml/camlinternalOO.cmi
9
-
node_test.js: [INFO] sync_get: _opam/lib/ocaml/stdlib.cmi
10
-
node_test.js: [INFO] sync_get: _opam/lib/ocaml/camlinternalFormat.cmi
11
-
node_test.js: [INFO] sync_get: _opam/lib/ocaml/std_exit.cmi
12
-
node_test.js: [INFO] sync_get: _opam/lib/ocaml/camlinternalMod.cmi
13
-
node_test.js: [INFO] sync_get: _opam/lib/ocaml/camlinternalFormatBasics.cmi
14
-
node_test.js: [INFO] sync_get: _opam/lib/ocaml/camlinternalLazy.cmi
9
+
node_test.js: [INFO] async_get: _opam/lib/ocaml/camlinternalOO.cmi
10
+
node_test.js: [INFO] async_get: _opam/lib/ocaml/stdlib.cmi
11
+
node_test.js: [INFO] async_get: _opam/lib/ocaml/camlinternalFormat.cmi
12
+
node_test.js: [INFO] async_get: _opam/lib/ocaml/std_exit.cmi
13
+
node_test.js: [INFO] async_get: _opam/lib/ocaml/camlinternalMod.cmi
14
+
node_test.js: [INFO] async_get: _opam/lib/ocaml/camlinternalFormatBasics.cmi
15
+
node_test.js: [INFO] async_get: _opam/lib/ocaml/camlinternalLazy.cmi
15
16
node_test.js: [INFO] init() finished
16
17
node_test.js: [INFO] setup() ...
17
18
node_test.js: [INFO] Fetching stdlib__Format.cmi
···
28
29
node_test.js: [INFO] setup output: OCaml version 5.2.0
29
30
Unknown directive enable.
30
31
Unknown directive disable.
31
-
node_test.js: [INFO] Number of errors: 1
32
32
node_test.js: [INFO] add_cmi
33
33
node_test.js: [INFO] prefix: /static/cmis/cell__c1
34
34
node_test.js: [INFO] About to type_implementation
35
35
node_test.js: [INFO] file_exists: /static/cmis/cell__c1.cmi = true
36
-
node_test.js: [INFO] Number of errors1: 1
37
-
node_test.js: [INFO] Number of errors2: 1
36
+
node_test.js: [INFO] Number of errors: 1 (should be 1)
37
+
node_test.js: [INFO] add_cmi
38
+
node_test.js: [INFO] prefix: /static/cmis/cell__c1
39
+
node_test.js: [INFO] About to type_implementation
40
+
node_test.js: [INFO] file_exists: /static/cmis/cell__c1.cmi = true
41
+
node_test.js: [INFO] add_cmi
42
+
node_test.js: [INFO] prefix: /static/cmis/cell__c2
43
+
node_test.js: [INFO] About to type_implementation
44
+
node_test.js: [INFO] file_exists: /static/cmis/cell__c2.cmi = true
45
+
node_test.js: [INFO] Number of errors1: 1 (should be 1)
46
+
node_test.js: [INFO] Number of errors2: 0 (should be 0)
47
+
node_test.js: [ERROR] xx Warning, ignoring toplevel block without a leading '# '.
48
+
49
+
node_test.js: [INFO] Fetching stdlib__List.cmi
50
+
51
+
node_test.js: [INFO] sync_get: _opam/lib/ocaml/stdlib__List.cmi
52
+
node_test.js: [INFO] Completions for 'List.leng': 1 entries
53
+
node_test.js: [INFO] - length (Value): 'a list -> int
54
+
node_test.js: [INFO] Completions for 'List.': 2 entries
55
+
node_test.js: [INFO] - List (Module):
56
+
node_test.js: [INFO] - ListLabels (Module):
57
+
node_test.js: [INFO] Completions for 'ma': 0 entries
58
+
node_test.js: [INFO] Completions for 'List.leng' (non-toplevel): 1 entries
59
+
node_test.js: [INFO] - length (Value): 'a list -> int
60
+
node_test.js: [INFO] Completions for 'List.leng' (Logical position): 1 entries
61
+
node_test.js: [INFO] - length (Value): 'a list -> int
38
62
node_test.js: [INFO] Success
+155
-15
test/node/node_test.ml
+155
-15
test/node/node_test.ml
···
37
37
let async_get f =
38
38
let f = Fpath.v ("_opam/" ^ f) in
39
39
Logs.info (fun m -> m "async_get: %a" Fpath.pp f);
40
-
Lwt.catch (fun () ->
41
-
let open Lwt.Infix in
42
-
Lwt_io.with_file ~mode:Lwt_io.input (Fpath.to_string f) Lwt_io.read
43
-
>>= fun content -> Lwt.return (Ok content))
44
-
(fun e ->
45
-
Logs.err (fun m ->
46
-
m "Error reading file %a: %s" Fpath.pp f (Printexc.to_string e));
47
-
Lwt.return (Error (`Msg (Printexc.to_string e))))
40
+
(* For Node.js, we use synchronous file reading wrapped in Lwt *)
41
+
try
42
+
let content =
43
+
In_channel.with_open_bin (Fpath.to_string f) In_channel.input_all
44
+
in
45
+
Lwt.return (Ok content)
46
+
with e ->
47
+
Logs.err (fun m ->
48
+
m "Error reading file %a: %s" Fpath.pp f (Printexc.to_string e));
49
+
Lwt.return (Error (`Msg (Printexc.to_string e)))
48
50
49
51
let create_file = Js_of_ocaml.Sys_js.create_file
50
52
···
61
63
let require b v = function
62
64
| [] -> []
63
65
| packages -> Js_top_worker_web.Findlibish.require sync_get b v packages
64
-
66
+
65
67
let path = "/static/cmis"
66
68
end
67
69
···
86
88
module Client = Js_top_worker_rpc.Toplevel_api_gen.Make (Impl.IdlM.GenClient ())
87
89
88
90
let _ =
91
+
Logs.info (fun m -> m "Starting server...");
89
92
let rpc = start_server () in
90
93
let ( let* ) = IdlM.ErrM.bind in
91
94
let init_config =
···
102
105
let* o1 =
103
106
query_errors rpc (Some "c2") [ "c1" ] false "type yyy = xxx;;\n"
104
107
in
105
-
Logs.info (fun m -> m "Number of errors: %d" (List.length o1));
108
+
Logs.info (fun m -> m "Number of errors: %d (should be 1)" (List.length o1));
106
109
let* _ = query_errors rpc (Some "c1") [] false "type xxx = int;;\n" in
107
110
let* o2 =
108
111
query_errors rpc (Some "c2") [ "c1" ] false "type yyy = xxx;;\n"
109
112
in
110
-
Logs.info (fun m -> m "Number of errors1: %d" (List.length o1));
111
-
Logs.info (fun m -> m "Number of errors2: %d" (List.length o2));
113
+
Logs.info (fun m ->
114
+
m "Number of errors1: %d (should be 1)" (List.length o1));
115
+
Logs.info (fun m ->
116
+
m "Number of errors2: %d (should be 0)" (List.length o2));
117
+
118
+
(* Test completion for List.leng *)
119
+
let* completions1 =
120
+
Client.complete_prefix rpc (Some "c_comp1") [] true "let _ = List.leng"
121
+
(Offset 16)
122
+
in
123
+
Logs.info (fun m ->
124
+
m "Completions for 'List.leng': %d entries"
125
+
(List.length completions1.entries));
126
+
List.iter
127
+
(fun entry ->
128
+
Logs.info (fun m ->
129
+
m " - %s (%s): %s" entry.name
130
+
(match entry.kind with
131
+
| Constructor -> "Constructor"
132
+
| Keyword -> "Keyword"
133
+
| Label -> "Label"
134
+
| MethodCall -> "MethodCall"
135
+
| Modtype -> "Modtype"
136
+
| Module -> "Module"
137
+
| Type -> "Type"
138
+
| Value -> "Value"
139
+
| Variant -> "Variant")
140
+
entry.desc))
141
+
completions1.entries;
142
+
143
+
(* Test completion for List. (should show all List module functions) *)
144
+
let* completions2 =
145
+
Client.complete_prefix rpc (Some "c_comp2") [] true "# let _ = List."
146
+
(Offset 12)
147
+
in
148
+
Logs.info (fun m ->
149
+
m "Completions for 'List.': %d entries"
150
+
(List.length completions2.entries));
151
+
List.iter
152
+
(fun entry ->
153
+
Logs.info (fun m ->
154
+
m " - %s (%s): %s" entry.name
155
+
(match entry.kind with
156
+
| Constructor -> "Constructor"
157
+
| Keyword -> "Keyword"
158
+
| Label -> "Label"
159
+
| MethodCall -> "MethodCall"
160
+
| Modtype -> "Modtype"
161
+
| Module -> "Module"
162
+
| Type -> "Type"
163
+
| Value -> "Value"
164
+
| Variant -> "Variant")
165
+
entry.desc))
166
+
completions2.entries;
167
+
168
+
(* Test completion for partial identifier *)
169
+
let* completions3 =
170
+
Client.complete_prefix rpc (Some "c_comp3") [] true "# let _ = ma"
171
+
(Offset 10)
172
+
in
173
+
Logs.info (fun m ->
174
+
m "Completions for 'ma': %d entries" (List.length completions3.entries));
175
+
List.iter
176
+
(fun entry ->
177
+
Logs.info (fun m ->
178
+
m " - %s (%s): %s" entry.name
179
+
(match entry.kind with
180
+
| Constructor -> "Constructor"
181
+
| Keyword -> "Keyword"
182
+
| Label -> "Label"
183
+
| MethodCall -> "MethodCall"
184
+
| Modtype -> "Modtype"
185
+
| Module -> "Module"
186
+
| Type -> "Type"
187
+
| Value -> "Value"
188
+
| Variant -> "Variant")
189
+
entry.desc))
190
+
completions3.entries;
191
+
192
+
(* Test completion in non-toplevel context *)
193
+
let* completions4 =
194
+
Client.complete_prefix rpc (Some "c_comp4") [] false "let _ = List.leng"
195
+
(Offset 16)
196
+
in
197
+
Logs.info (fun m ->
198
+
m "Completions for 'List.leng' (non-toplevel): %d entries"
199
+
(List.length completions4.entries));
200
+
List.iter
201
+
(fun entry ->
202
+
Logs.info (fun m ->
203
+
m " - %s (%s): %s" entry.name
204
+
(match entry.kind with
205
+
| Constructor -> "Constructor"
206
+
| Keyword -> "Keyword"
207
+
| Label -> "Label"
208
+
| MethodCall -> "MethodCall"
209
+
| Modtype -> "Modtype"
210
+
| Module -> "Module"
211
+
| Type -> "Type"
212
+
| Value -> "Value"
213
+
| Variant -> "Variant")
214
+
entry.desc))
215
+
completions4.entries;
216
+
217
+
(* Test completion using Logical position constructor *)
218
+
let* completions5 =
219
+
Client.complete_prefix rpc (Some "c_comp5") [] true
220
+
"# let _ = List.leng\n let foo=1.0;;"
221
+
(Logical (1, 16))
222
+
in
223
+
Logs.info (fun m ->
224
+
m "Completions for 'List.leng' (Logical position): %d entries"
225
+
(List.length completions5.entries));
226
+
List.iter
227
+
(fun entry ->
228
+
Logs.info (fun m ->
229
+
m " - %s (%s): %s" entry.name
230
+
(match entry.kind with
231
+
| Constructor -> "Constructor"
232
+
| Keyword -> "Keyword"
233
+
| Label -> "Label"
234
+
| MethodCall -> "MethodCall"
235
+
| Modtype -> "Modtype"
236
+
| Module -> "Module"
237
+
| Type -> "Type"
238
+
| Value -> "Value"
239
+
| Variant -> "Variant")
240
+
entry.desc))
241
+
completions5.entries;
242
+
112
243
(* let* o3 =
113
244
Client.exec_toplevel rpc
114
245
"# Stringext.of_list ['a';'b';'c'];;\n" in
115
246
Logs.info (fun m -> m "Exec toplevel output: %s" o3.script); *)
116
247
IdlM.ErrM.return ()
117
248
in
118
-
match x |> IdlM.T.get |> Lwt_main.run with
119
-
| Ok () -> Logs.info (fun m -> m "Success")
120
-
| Error (InternalError s) -> Logs.err (fun m -> m "Error: %s" s)
249
+
(* The operations are actually synchronous in this test context *)
250
+
let promise = x |> IdlM.T.get in
251
+
match Lwt.state promise with
252
+
| Lwt.Return (Ok ()) -> Logs.info (fun m -> m "Success")
253
+
| Lwt.Return (Error (InternalError s)) -> Logs.err (fun m -> m "Error: %s" s)
254
+
| Lwt.Fail e ->
255
+
Logs.err (fun m -> m "Unexpected failure: %s" (Printexc.to_string e))
256
+
| Lwt.Sleep ->
257
+
Logs.err (fun m ->
258
+
m
259
+
"Error: Promise is still pending (should not happen in sync \
260
+
context)")
+8
-1
test/unix/dune
+8
-1
test/unix/dune
···
5
5
(package js_top_worker-unix)
6
6
(modules unix_test)
7
7
(link_flags (-linkall))
8
-
(libraries js_top_worker logs logs.fmt rpclib.core rpclib.json findlib.top lwt.unix))
8
+
(libraries
9
+
js_top_worker
10
+
logs
11
+
logs.fmt
12
+
rpclib.core
13
+
rpclib.json
14
+
findlib.top
15
+
lwt.unix))
+13
-11
test/unix/unix_test.ml
+13
-11
test/unix/unix_test.ml
···
111
111
112
112
module Client = Js_top_worker_rpc.Toplevel_api_gen.Make (IdlM.GenClient ())
113
113
114
-
let c1, c2, c3, c4 = "c1", "c2", "c3", "c4"
115
-
let notebook = [
116
-
(c1,[],"typ xxxx = int;;\n");
117
-
(c2,[c1],"type yyy=xxx;;\n");
118
-
(c3,[c1;c2],"type xxx = int;;\n");
119
-
(c4,[c1;c2;c3],"type yyy = xxx;;\n");
120
-
]
114
+
let c1, c2, c3, c4 = ("c1", "c2", "c3", "c4")
115
+
116
+
let notebook =
117
+
[
118
+
(c1, [], "typ xxxx = int;;\n");
119
+
(c2, [ c1 ], "type yyy=xxx;;\n");
120
+
(c3, [ c1; c2 ], "type xxx = int;;\n");
121
+
(c4, [ c1; c2; c3 ], "type yyy = xxx;;\n");
122
+
]
121
123
122
124
let _ =
123
125
let rpc = start_server () in
···
131
133
let rec run notebook =
132
134
match notebook with
133
135
| (id, deps, cell) :: cells ->
134
-
let* errs = Client.query_errors rpc (Some id) deps false cell in
135
-
Printf.printf "Cell %s: %d errors\n%!" id (List.length errs);
136
-
run cells
136
+
let* errs = Client.query_errors rpc (Some id) deps false cell in
137
+
Printf.printf "Cell %s: %d errors\n%!" id (List.length errs);
138
+
run cells
137
139
| [] -> IdlM.ErrM.return ()
138
-
in
140
+
in
139
141
let* _ = Client.init rpc init in
140
142
let* _ = Client.setup rpc () in
141
143
let* _ = run notebook in