this repo has no description

Simplify transport to JSON-RPC and add interactive demo

- Remove CBOR transport, keep JSON-RPC only for browser compatibility
- Remove obsolete cbor and channel test infrastructure
- Add interactive demo (demo.html/demo.js) with README documentation
- Add Playwright browser tests for demo, features, and environment isolation
- Enhance jtw tool with --path and --deps options for library compilation
- Improve findlib path handling for dynamic CMI loading
- Update node tests with proper expected output files

Co-Authored-By: Claude Opus 4.5 <noreply@anthropic.com>

+3099 -635
+5 -3
.devcontainer/devcontainer.json
··· 1 1 { 2 2 "name": "Claude Code OCaml Sandbox", 3 - "image": "ghcr.io/avsm/claude-ocaml-devcontainer:main", 3 + "image": "ghcr.io/jonludlam/claude-ocaml-devcontainer:main", 4 4 "runArgs": [ 5 5 "--cap-add=NET_ADMIN", 6 - "--cap-add=NET_RAW" 6 + "--cap-add=NET_RAW", 7 + "--init", 8 + "--ipc=host", 9 + "--cap-add=SYS_ADMIN" 7 10 ], 8 11 "customizations": { 9 12 "vscode": { ··· 47 50 }, 48 51 "workspaceMount": "source=${localWorkspaceFolder},target=/workspace,type=bind,consistency=delegated", 49 52 "workspaceFolder": "/workspace", 50 - "postCreateCommand": "sudo /usr/local/bin/init-firewall.sh", 51 53 "waitFor": "postStartCommand" 52 54 }
+334 -51
bin/jtw.ml
··· 4 4 if Fpath.has_ext ".cmi" path then Fpath.filename path :: acc else acc) 5 5 [] dir 6 6 7 - let gen_cmis cmis = 7 + let gen_cmis ?path_prefix cmis = 8 8 let gen_one (dir, cmis) = 9 9 let all_cmis = 10 10 List.map (fun s -> String.sub s 0 (String.length s - 4)) cmis ··· 23 23 let prefixes = Util.StringSet.(of_list prefixes |> to_list) in 24 24 let findlib_dir = Ocamlfind.findlib_dir () |> Fpath.v in 25 25 let d = Fpath.relativize ~root:findlib_dir dir |> Option.get in 26 + (* Include path_prefix in dcs_url so it's correct relative to HTTP root *) 27 + let dcs_url_path = match path_prefix with 28 + | Some prefix -> Fpath.(v prefix / "lib" // d) 29 + | None -> Fpath.(v "lib" // d) 30 + in 26 31 let dcs = 27 32 { 28 - Js_top_worker_rpc.Toplevel_api_gen.dcs_url = 29 - Fpath.(v "lib" // d |> to_string); 33 + Js_top_worker_rpc.Toplevel_api_gen.dcs_url = Fpath.to_string dcs_url_path; 30 34 dcs_toplevel_modules = List.map String.capitalize_ascii non_hidden; 31 35 dcs_file_prefixes = prefixes; 32 36 } ··· 38 42 in 39 43 List.map gen_one cmis 40 44 41 - let opam verbose output_dir_str switch libraries no_worker = 45 + (** Read dependency paths from a file (one path per line) *) 46 + let read_deps_file path = 47 + match Bos.OS.File.read_lines (Fpath.v path) with 48 + | Ok lines -> List.filter (fun s -> String.length s > 0) lines 49 + | Error (`Msg m) -> 50 + Format.eprintf "Warning: Failed to read deps file %s: %s\n%!" path m; 51 + [] 52 + 53 + let opam verbose output_dir_str switch libraries no_worker path deps_file = 42 54 Opam.switch := switch; 43 - let libraries = 55 + (* When --path is specified, only compile the specified libraries (no deps) *) 56 + let libraries_with_deps, libraries_only = 44 57 match Ocamlfind.deps libraries with 45 - | Ok l -> Util.StringSet.of_list ("stdlib" :: l) 58 + | Ok l -> 59 + let all = Util.StringSet.of_list ("stdlib" :: l) in 60 + (* In --path mode, don't auto-add stdlib - only include requested libs *) 61 + let only = Util.StringSet.of_list libraries in 62 + (all, only) 46 63 | Error (`Msg m) -> 47 64 Format.eprintf "Failed to find libs: %s\n%!" m; 48 - (* Format.eprintf "Bad libs: %s\n%!" m; *) 49 - (* failwith ("Bad libs: " ^ m) *) 50 65 failwith ("Bad libs: " ^ m) 51 66 in 67 + (* In path mode, only compile the specified packages *) 68 + let libraries = if path <> None then libraries_only else libraries_with_deps in 69 + (* Read dependency paths from file if specified *) 70 + let dep_paths = match deps_file with 71 + | Some f -> read_deps_file f 72 + | None -> [] 73 + in 52 74 Eio_main.run @@ fun env -> 53 75 Eio.Switch.run @@ fun sw -> 54 76 if verbose then Logs.set_level (Some Logs.Debug) else Logs.set_level None; ··· 58 80 m "Libraries: %a" 59 81 (Fmt.list ~sep:Fmt.comma Fmt.string) 60 82 (Util.StringSet.elements libraries)); 61 - let output_dir = Fpath.v output_dir_str in 83 + (* output_dir is always from -o; --path is a subdirectory within it *) 84 + let base_output_dir = Fpath.v output_dir_str in 85 + let output_dir = 86 + match path with 87 + | Some p -> Fpath.(base_output_dir // v p) 88 + | None -> base_output_dir 89 + in 62 90 let meta_files = 63 91 List.map 64 92 (fun lib -> Ocamlfind.meta_file lib) ··· 80 108 [] 81 109 in 82 110 Format.eprintf "cmi_dirs: %a\n%!" (Fmt.list ~sep:Fmt.comma Fpath.pp) cmi_dirs; 111 + (* In --path mode, only include cmi dirs from specified libraries and their 112 + subpackages, not external dependencies *) 113 + let cmi_dirs_to_copy = 114 + if path <> None then 115 + let lib_dirs = 116 + List.filter_map 117 + (fun lib -> 118 + match Ocamlfind.get_dir lib with Ok x -> Some x | _ -> None) 119 + (Util.StringSet.to_list libraries) 120 + in 121 + (* Filter cmi_dirs to include directories that are equal to or subdirectories 122 + of lib_dirs. This includes subpackages like base.base_internalhash_types. 123 + We check that the relative path doesn't start with ".." *) 124 + List.filter 125 + (fun dir -> 126 + List.exists 127 + (fun lib_dir -> 128 + Fpath.equal dir lib_dir || 129 + match Fpath.relativize ~root:lib_dir dir with 130 + | Some rel -> 131 + let segs = Fpath.segs rel in 132 + (match segs with 133 + | ".." :: _ -> false (* Goes outside lib_dir *) 134 + | _ -> true) 135 + | None -> false) 136 + lib_dirs) 137 + cmi_dirs 138 + else 139 + cmi_dirs 140 + in 83 141 let cmis = 84 142 List.fold_left 85 143 (fun acc dir -> 86 144 match cmi_files dir with 87 145 | Ok files -> (dir, files) :: acc 88 146 | Error _ -> acc) 89 - [] cmi_dirs 147 + [] cmi_dirs_to_copy 90 148 in 91 149 let ( let* ) = Result.bind in 92 150 ··· 128 186 Util.cp meta_file dest) 129 187 meta_rels; 130 188 189 + (* Generate findlib_index as JSON with packages and deps fields *) 190 + let packages_json = 191 + List.map 192 + (fun (meta_file, d) -> 193 + let file = Fpath.filename meta_file in 194 + let rel_path = Fpath.(v "lib" // d / file) in 195 + `String (Fpath.to_string rel_path)) 196 + meta_rels 197 + in 198 + let deps_json = List.map (fun d -> `String d) dep_paths in 199 + let findlib_json = 200 + `Assoc [("packages", `List packages_json); ("deps", `List deps_json)] 201 + in 131 202 Out_channel.with_open_bin 132 203 Fpath.(output_dir / "findlib_index" |> to_string) 133 - (fun oc -> 134 - List.iter 135 - (fun (meta_file, d) -> 136 - let file = Fpath.filename meta_file in 137 - let path = Fpath.(v "lib" // d / file) in 138 - Printf.fprintf oc "%s\n" (Fpath.to_string path)) 139 - meta_rels); 204 + (fun oc -> Printf.fprintf oc "%s\n" (Yojson.Safe.to_string findlib_json)); 140 205 206 + (* Compile archives for each library AND its subpackages *) 141 207 Util.StringSet.iter 142 208 (fun lib -> 143 - let archives = Ocamlfind.archives lib in 144 - let dir = Ocamlfind.get_dir lib |> Result.get_ok in 145 - let archives = List.map (fun x -> Fpath.(dir / x)) archives in 146 - let d = Fpath.relativize ~root:findlib_dir dir |> Option.get in 147 - let dest = Fpath.(output_dir / "lib" // d) in 148 - let (_ : (bool, _) result) = Bos.OS.Dir.create dest in 149 - let compile_archive archive = 150 - let output = Fpath.(dest / (Fpath.filename archive ^ ".js")) in 151 - let js_runtime = Ocamlfind.jsoo_runtime lib in 152 - let js_files = 153 - List.map (fun f -> Fpath.(dir / f |> to_string)) js_runtime 154 - in 155 - let base_cmd = 156 - match switch with 157 - | None -> Bos.Cmd.(v "js_of_ocaml") 158 - | Some s -> 159 - Bos.Cmd.(v "opam" % "exec" % "--switch" % s % "--" % "js_of_ocaml") 160 - in 161 - let cmd = 162 - Bos.Cmd.( 163 - base_cmd % "compile" % "--toplevel" % "--include-runtime" 164 - % "--effects=cps") 165 - in 166 - let cmd = List.fold_left (fun c f -> Bos.Cmd.(c % f)) cmd js_files in 167 - let cmd = 168 - Bos.Cmd.(cmd % Fpath.to_string archive % "-o" % Fpath.to_string output) 169 - in 170 - ignore (Util.lines_of_process cmd) 171 - in 172 - List.iter compile_archive archives) 209 + (* Get subpackages (e.g., base.base_internalhash_types for base) *) 210 + let sub_libs = Ocamlfind.sub_libraries lib in 211 + let all_libs = Util.StringSet.add lib sub_libs in 212 + Util.StringSet.iter 213 + (fun sub_lib -> 214 + match Ocamlfind.get_dir sub_lib with 215 + | Error _ -> () 216 + | Ok dir -> 217 + let archives = Ocamlfind.archives sub_lib in 218 + let archives = List.map (fun x -> Fpath.(dir / x)) archives in 219 + let d = Fpath.relativize ~root:findlib_dir dir |> Option.get in 220 + let dest = Fpath.(output_dir / "lib" // d) in 221 + let (_ : (bool, _) result) = Bos.OS.Dir.create dest in 222 + let compile_archive archive = 223 + let output = Fpath.(dest / (Fpath.filename archive ^ ".js")) in 224 + let js_runtime = Ocamlfind.jsoo_runtime sub_lib in 225 + let js_files = 226 + List.map (fun f -> Fpath.(dir / f |> to_string)) js_runtime 227 + in 228 + let base_cmd = 229 + match switch with 230 + | None -> Bos.Cmd.(v "js_of_ocaml") 231 + | Some s -> 232 + Bos.Cmd.(v "opam" % "exec" % "--switch" % s % "--" % "js_of_ocaml") 233 + in 234 + let cmd = 235 + Bos.Cmd.( 236 + base_cmd % "compile" % "--toplevel" % "--include-runtime" 237 + % "--effects=disabled") 238 + in 239 + let cmd = List.fold_left (fun c f -> Bos.Cmd.(c % f)) cmd js_files in 240 + let cmd = 241 + Bos.Cmd.(cmd % Fpath.to_string archive % "-o" % Fpath.to_string output) 242 + in 243 + ignore (Util.lines_of_process cmd) 244 + in 245 + List.iter compile_archive archives) 246 + all_libs) 173 247 libraries; 174 248 175 249 (* Format.eprintf "@[<hov 2>dir: %a [%a]@]\n%!" Fpath.pp dir (Fmt.list ~sep:Fmt.sp Fmt.string) files) cmis; *) 176 250 Ok () 177 251 in 178 - let init_cmis = gen_cmis cmis in 252 + let init_cmis = gen_cmis ?path_prefix:path cmis in 179 253 List.iter 180 254 (fun (dir, dcs) -> 181 255 let findlib_dir = Ocamlfind.findlib_dir () |> Fpath.v in ··· 200 274 201 275 `Ok () 202 276 277 + (** Generate a single package's universe directory. 278 + Returns the relative path for use in the root index. *) 279 + let generate_package_universe ~switch ~output_dir ~findlib_dir ~pkg ~pkg_deps = 280 + (* Use package name as directory path *) 281 + let pkg_path = pkg in 282 + let pkg_output_dir = Fpath.(output_dir / pkg_path) in 283 + let _ = Bos.OS.Dir.create ~path:true pkg_output_dir in 284 + 285 + (* Get the package's directory and copy cmi files *) 286 + let pkg_dir = match Ocamlfind.get_dir pkg with 287 + | Ok d -> d 288 + | Error _ -> failwith ("Cannot find package: " ^ pkg) 289 + in 290 + 291 + (* Also include subpackages (directories under pkg_dir) *) 292 + let all_pkg_dirs = 293 + let sub_libs = Ocamlfind.sub_libraries pkg in 294 + Util.StringSet.fold (fun sub acc -> 295 + match Ocamlfind.get_dir sub with 296 + | Ok d -> d :: acc 297 + | Error _ -> acc) 298 + sub_libs [pkg_dir] 299 + |> List.sort_uniq Fpath.compare 300 + in 301 + 302 + (* Copy cmi files *) 303 + List.iter (fun dir -> 304 + match cmi_files dir with 305 + | Ok files -> 306 + let d = Fpath.relativize ~root:findlib_dir dir |> Option.get in 307 + List.iter (fun f -> 308 + let dest_dir = Fpath.(pkg_output_dir / "lib" // d) in 309 + let dest = Fpath.(dest_dir / f) in 310 + let _ = Bos.OS.Dir.create ~path:true dest_dir in 311 + match Bos.OS.File.exists dest with 312 + | Ok true -> () 313 + | Ok false -> Util.cp Fpath.(dir / f) dest 314 + | Error _ -> ()) 315 + files 316 + | Error _ -> ()) 317 + all_pkg_dirs; 318 + 319 + (* Copy META file *) 320 + let meta_file = Fpath.v (Ocamlfind.meta_file pkg) in 321 + let meta_rel = Fpath.relativize ~root:findlib_dir meta_file |> Option.get |> Fpath.parent in 322 + let meta_dest = Fpath.(pkg_output_dir / "lib" // meta_rel) in 323 + let _ = Bos.OS.Dir.create ~path:true meta_dest in 324 + Util.cp meta_file meta_dest; 325 + 326 + (* Compile archives for main package and all subpackages *) 327 + let sub_libs = Ocamlfind.sub_libraries pkg in 328 + let all_libs = Util.StringSet.add pkg sub_libs in 329 + Util.StringSet.iter (fun lib -> 330 + match Ocamlfind.get_dir lib with 331 + | Error _ -> () 332 + | Ok lib_dir -> 333 + let archives = Ocamlfind.archives lib in 334 + let archives = List.map (fun x -> Fpath.(lib_dir / x)) archives in 335 + let d = Fpath.relativize ~root:findlib_dir lib_dir |> Option.get in 336 + let dest = Fpath.(pkg_output_dir / "lib" // d) in 337 + let _ = Bos.OS.Dir.create ~path:true dest in 338 + List.iter (fun archive -> 339 + let output = Fpath.(dest / (Fpath.filename archive ^ ".js")) in 340 + let js_runtime = Ocamlfind.jsoo_runtime lib in 341 + let js_files = List.map (fun f -> Fpath.(lib_dir / f |> to_string)) js_runtime in 342 + let base_cmd = match switch with 343 + | None -> Bos.Cmd.(v "js_of_ocaml") 344 + | Some s -> Bos.Cmd.(v "opam" % "exec" % "--switch" % s % "--" % "js_of_ocaml") 345 + in 346 + let cmd = Bos.Cmd.(base_cmd % "compile" % "--toplevel" % "--include-runtime" % "--effects=disabled") in 347 + let cmd = List.fold_left (fun c f -> Bos.Cmd.(c % f)) cmd js_files in 348 + let cmd = Bos.Cmd.(cmd % Fpath.to_string archive % "-o" % Fpath.to_string output) in 349 + ignore (Util.lines_of_process cmd)) 350 + archives) 351 + all_libs; 352 + 353 + (* Generate dynamic_cmis.json for each directory *) 354 + List.iter (fun dir -> 355 + match cmi_files dir with 356 + | Ok files -> 357 + let all_cmis = List.map (fun s -> String.sub s 0 (String.length s - 4)) files in 358 + let hidden, non_hidden = List.partition (fun x -> Astring.String.is_infix ~affix:"__" x) all_cmis in 359 + let prefixes = List.filter_map (fun x -> 360 + match Astring.String.cuts ~sep:"__" x with 361 + | x :: _ -> Some (x ^ "__") 362 + | _ -> None) hidden in 363 + let prefixes = Util.StringSet.(of_list prefixes |> to_list) in 364 + let d = Fpath.relativize ~root:findlib_dir dir |> Option.get in 365 + (* Include pkg_path in dcs_url so it's correct relative to the HTTP root *) 366 + let dcs = { 367 + Js_top_worker_rpc.Toplevel_api_gen.dcs_url = Fpath.(v pkg_path / "lib" // d |> to_string); 368 + dcs_toplevel_modules = List.map String.capitalize_ascii non_hidden; 369 + dcs_file_prefixes = prefixes; 370 + } in 371 + let dcs_json = Jsonrpc.to_string (Rpcmarshal.marshal Js_top_worker_rpc.Toplevel_api_gen.typ_of_dynamic_cmis dcs) in 372 + let dcs_dir = Fpath.(pkg_output_dir / "lib" // d) in 373 + let _ = Bos.OS.Dir.create ~path:true dcs_dir in 374 + let oc = open_out Fpath.(dcs_dir / "dynamic_cmis.json" |> to_string) in 375 + Printf.fprintf oc "%s" dcs_json; 376 + close_out oc 377 + | Error _ -> ()) 378 + all_pkg_dirs; 379 + 380 + (* Generate findlib_index with deps *) 381 + let packages_json = [`String Fpath.(v "lib" // meta_rel / "META" |> to_string)] in 382 + let deps_json = List.map (fun d -> `String d) pkg_deps in 383 + let findlib_json = `Assoc [("packages", `List packages_json); ("deps", `List deps_json)] in 384 + Out_channel.with_open_bin Fpath.(pkg_output_dir / "findlib_index" |> to_string) 385 + (fun oc -> Printf.fprintf oc "%s\n" (Yojson.Safe.to_string findlib_json)); 386 + 387 + pkg_path 388 + 389 + let opam_all verbose output_dir_str switch libraries no_worker = 390 + Opam.switch := switch; 391 + 392 + (* Get all packages and their dependencies *) 393 + let all_packages = match Ocamlfind.deps libraries with 394 + | Ok l -> "stdlib" :: l 395 + | Error (`Msg m) -> failwith ("Failed to find libs: " ^ m) 396 + in 397 + 398 + (* Remove duplicates and sort *) 399 + let all_packages = Util.StringSet.(of_list all_packages |> to_list) in 400 + 401 + Format.eprintf "Generating universes for %d packages\n%!" (List.length all_packages); 402 + 403 + Eio_main.run @@ fun env -> 404 + Eio.Switch.run @@ fun sw -> 405 + if verbose then Logs.set_level (Some Logs.Debug) else Logs.set_level None; 406 + Logs.set_reporter (Logs_fmt.reporter ()); 407 + let () = Worker_pool.start_workers env sw 16 in 408 + 409 + let output_dir = Fpath.v output_dir_str in 410 + let _ = Bos.OS.Dir.create ~path:true output_dir in 411 + let findlib_dir = Ocamlfind.findlib_dir () |> Fpath.v in 412 + 413 + (* Build dependency map: package -> list of direct dependency paths *) 414 + let dep_map = Hashtbl.create 64 in 415 + List.iter (fun pkg -> 416 + let deps = match Ocamlfind.deps [pkg] with 417 + | Ok l -> List.filter (fun d -> d <> pkg) l (* Remove self from deps *) 418 + | Error _ -> [] 419 + in 420 + Hashtbl.add dep_map pkg deps) 421 + all_packages; 422 + 423 + (* Generate each package *) 424 + let pkg_paths = List.map (fun pkg -> 425 + Format.eprintf "Generating %s...\n%!" pkg; 426 + let pkg_deps = Hashtbl.find dep_map pkg in 427 + (* Deps are package names, which are also the paths in our simple scheme *) 428 + let dep_paths = pkg_deps in 429 + generate_package_universe ~switch ~output_dir ~findlib_dir ~pkg ~pkg_deps:dep_paths) 430 + all_packages 431 + in 432 + 433 + (* Generate root findlib_index *) 434 + let root_index = `Assoc [ 435 + ("packages", `List []); 436 + ("deps", `List (List.map (fun p -> `String p) pkg_paths)) 437 + ] in 438 + Out_channel.with_open_bin Fpath.(output_dir / "findlib_index" |> to_string) 439 + (fun oc -> Printf.fprintf oc "%s\n" (Yojson.Safe.to_string root_index)); 440 + 441 + Format.eprintf "Generated root findlib_index with %d packages\n%!" (List.length pkg_paths); 442 + 443 + (* Generate worker.js if requested *) 444 + let () = if no_worker then () else Mk_backend.mk switch output_dir in 445 + 446 + `Ok () 447 + 203 448 open Cmdliner 204 449 205 450 let opam_cmd = ··· 207 452 let output_dir = 208 453 let doc = 209 454 "Output directory in which to put all outputs. This should be the root \ 210 - directory of the HTTP server" 455 + directory of the HTTP server. Ignored when --path is specified." 211 456 in 212 457 Arg.(value & opt string "html" & info [ "o"; "output" ] ~doc) 213 458 in ··· 222 467 let doc = "Opam switch to use" in 223 468 Arg.(value & opt (some string) None & info [ "switch" ] ~doc) 224 469 in 470 + let path = 471 + let doc = 472 + "Full output path for this package (e.g., universes/abc123/base/v0.17.1/). \ 473 + When specified, only the named packages are compiled (not dependencies)." 474 + in 475 + Arg.(value & opt (some string) None & info [ "path" ] ~doc) 476 + in 477 + let deps_file = 478 + let doc = 479 + "File containing dependency paths, one per line. Each path should be \ 480 + relative to the HTTP root (e.g., universes/xyz789/sexplib0/v0.17.0/)." 481 + in 482 + Arg.(value & opt (some string) None & info [ "deps-file" ] ~doc) 483 + in 225 484 let info = Cmd.info "opam" ~doc:"Generate opam files" in 226 485 Cmd.v info 227 - Term.(ret (const opam $ verbose $ output_dir $ switch $ libraries $ no_worker)) 486 + Term.(ret (const opam $ verbose $ output_dir $ switch $ libraries $ no_worker $ path $ deps_file)) 487 + 488 + let opam_all_cmd = 489 + let libraries = Arg.(value & pos_all string [] & info [] ~docv:"LIB") in 490 + let output_dir = 491 + let doc = 492 + "Output directory for all universes. Each package gets its own subdirectory." 493 + in 494 + Arg.(value & opt string "html" & info [ "o"; "output" ] ~doc) 495 + in 496 + let verbose = 497 + let doc = "Enable verbose logging" in 498 + Arg.(value & flag & info [ "v"; "verbose" ] ~doc) 499 + in 500 + let no_worker = 501 + let doc = "Do not create worker.js" in 502 + Arg.(value & flag & info [ "no-worker" ] ~doc) 503 + in 504 + let switch = 505 + let doc = "Opam switch to use" in 506 + Arg.(value & opt (some string) None & info [ "switch" ] ~doc) 507 + in 508 + let info = Cmd.info "opam-all" ~doc:"Generate universes for all packages and their dependencies" in 509 + Cmd.v info 510 + Term.(ret (const opam_all $ verbose $ output_dir $ switch $ libraries $ no_worker)) 228 511 229 512 let main_cmd = 230 513 let doc = "An odoc notebook tool" in 231 514 let info = Cmd.info "odoc-notebook" ~version:"%%VERSION%%" ~doc in 232 515 let default = Term.(ret (const (`Help (`Pager, None)))) in 233 - Cmd.group info ~default [ opam_cmd ] 516 + Cmd.group info ~default [ opam_cmd; opam_all_cmd ] 234 517 235 518 let () = exit (Cmd.eval main_cmd)
+196
example/README.md
··· 1 + # js_top_worker Demo 2 + 3 + This directory contains a comprehensive demo showcasing all features of js_top_worker - an OCaml toplevel that runs in a browser WebWorker. 4 + 5 + ## Features Demonstrated 6 + 7 + - **Basic Execution**: Run OCaml code and see results 8 + - **Multiple Environments**: Create isolated execution contexts 9 + - **MIME Output**: Rich output (HTML, SVG, images) via `Mime_printer` 10 + - **Autocomplete**: Code completion suggestions 11 + - **Type Information**: Hover-style type queries 12 + - **Error Reporting**: Static analysis and error detection 13 + - **Directives**: `#show`, `#install_printer`, `#help`, etc. 14 + - **Custom Printers**: Install custom value formatters 15 + - **Library Loading**: Dynamic `#require` for findlib packages 16 + - **Toplevel Scripts**: Execute multi-phrase scripts 17 + 18 + ## Prerequisites 19 + 20 + You need: 21 + - OCaml 5.2+ with opam 22 + - The following opam packages installed: 23 + - js_of_ocaml, js_of_ocaml-ppx 24 + - dune (3.0+) 25 + - All js_top_worker dependencies 26 + 27 + ## Quick Start 28 + 29 + ### 1. Build the Project 30 + 31 + From the repository root: 32 + 33 + ```bash 34 + # Install dependencies (if not already done) 35 + opam install . --deps-only 36 + 37 + # Build everything 38 + dune build 39 + ``` 40 + 41 + ### 2. Prepare the Example Directory 42 + 43 + The build generates the `_opam` directory with compiled libraries: 44 + 45 + ```bash 46 + # This is done automatically by dune, but you can also run manually: 47 + dune build @example/default 48 + ``` 49 + 50 + This creates `_build/default/example/_opam/` containing: 51 + - `worker.js` - The WebWorker toplevel 52 + - `lib/` - Compiled CMI files and JavaScript-compiled CMA files 53 + - `findlib_index` - Index of available packages 54 + 55 + ### 3. Start the Web Server 56 + 57 + ```bash 58 + cd _build/default/example 59 + python3 server.py 8000 60 + ``` 61 + 62 + Or use any HTTP server with CORS support. The `server.py` script adds necessary headers. 63 + 64 + ### 4. Open the Demo 65 + 66 + Navigate to: **http://localhost:8000/demo.html** 67 + 68 + ## File Structure 69 + 70 + ``` 71 + example/ 72 + ├── demo.html # Main demo page (feature showcase) 73 + ├── demo.js # JavaScript client for the demo 74 + ├── worker.ml # WebWorker entry point (1 line!) 75 + ├── server.py # Development server with CORS 76 + ├── dune # Build configuration 77 + ├── _opam/ # Generated: compiled packages 78 + │ ├── worker.js # The compiled WebWorker 79 + │ ├── lib/ # CMI files and .cma.js files 80 + │ └── findlib_index # Package index 81 + └── *.html, *.ml # Other example files 82 + ``` 83 + 84 + ## Adding More Libraries 85 + 86 + To add additional OCaml libraries to the demo, edit the `dune` file: 87 + 88 + ```dune 89 + (rule 90 + (targets 91 + (dir _opam)) 92 + (action 93 + (run jtw opam -o _opam str stringext core YOUR_LIBRARY))) 94 + ``` 95 + 96 + Then rebuild: 97 + 98 + ```bash 99 + dune build @example/default 100 + ``` 101 + 102 + The `jtw opam` command: 103 + 1. Finds all transitive dependencies 104 + 2. Copies CMI files for type information 105 + 3. Compiles CMA files to JavaScript with `js_of_ocaml` 106 + 4. Generates the findlib index and dynamic_cmis.json files 107 + 108 + ## How It Works 109 + 110 + ### Architecture 111 + 112 + ``` 113 + ┌─────────────────┐ postMessage/JSON-RPC ┌─────────────────┐ 114 + │ Browser Tab │ ◄──────────────────────────► │ WebWorker │ 115 + │ (demo.js) │ │ (worker.js) │ 116 + │ │ │ │ 117 + │ - UI rendering │ │ - OCaml toplevel│ 118 + │ - RPC client │ │ - Merlin engine │ 119 + │ - MIME display │ │ - #require │ 120 + └─────────────────┘ └─────────────────┘ 121 + ``` 122 + 123 + ### RPC Methods 124 + 125 + | Method | Description | 126 + |--------|-------------| 127 + | `init` | Initialize toplevel with config | 128 + | `setup` | Setup an environment (start toplevel) | 129 + | `exec` | Execute a phrase | 130 + | `exec_toplevel` | Execute a toplevel script | 131 + | `create_env` | Create isolated environment | 132 + | `destroy_env` | Destroy an environment | 133 + | `list_envs` | List all environments | 134 + | `complete_prefix` | Get autocomplete suggestions | 135 + | `type_enclosing` | Get type at position | 136 + | `query_errors` | Get errors/warnings for code | 137 + 138 + ### MIME Output 139 + 140 + User code can produce rich output using the `Mime_printer` module: 141 + 142 + ```ocaml 143 + (* SVG output *) 144 + Mime_printer.push "image/svg" "<svg>...</svg>";; 145 + 146 + (* HTML output *) 147 + Mime_printer.push "text/html" "<table>...</table>";; 148 + 149 + (* Base64-encoded image *) 150 + Mime_printer.push ~encoding:Base64 "image/png" "iVBORw0KGgo...";; 151 + ``` 152 + 153 + The demo page renders these appropriately in the UI. 154 + 155 + ## Troubleshooting 156 + 157 + ### "Worker error" on startup 158 + 159 + - Check browser console for details 160 + - Ensure `_opam/worker.js` exists 161 + - Verify the server is running with CORS headers 162 + 163 + ### "Failed to fetch" errors 164 + 165 + - The worker loads files via HTTP; check network tab 166 + - Ensure `lib/ocaml/` directory has CMI files 167 + - Check `findlib_index` file exists 168 + 169 + ### Library not found with #require 170 + 171 + - Add the library to the `jtw opam` command in dune 172 + - Rebuild with `dune build @example/default` 173 + - Check `_opam/lib/PACKAGE/META` exists 174 + 175 + ### Autocomplete/type info not working 176 + 177 + - Merlin needs CMI files; ensure they're in `_opam/lib/` 178 + - The `dynamic_cmis.json` file must be present for each library 179 + 180 + ## Development 181 + 182 + To modify the worker libraries: 183 + 184 + 1. Edit files in `lib/` (core implementation) 185 + 2. Edit files in `lib-web/` (browser-specific code) 186 + 3. Rebuild: `dune build` 187 + 4. Refresh the browser (worker is cached, may need hard refresh) 188 + 189 + The worker entry point is minimal: 190 + 191 + ```ocaml 192 + (* worker.ml *) 193 + let _ = Js_top_worker_web.Worker.run () 194 + ``` 195 + 196 + All the complexity is in the `js_top_worker-web` library.
+539
example/demo.html
··· 1 + <!DOCTYPE html> 2 + <html lang="en"> 3 + <head> 4 + <meta charset="UTF-8"> 5 + <meta name="viewport" content="width=device-width, initial-scale=1.0"> 6 + <title>js_top_worker Feature Demo</title> 7 + <style> 8 + :root { 9 + --bg-primary: #1e1e2e; 10 + --bg-secondary: #313244; 11 + --bg-tertiary: #45475a; 12 + --text-primary: #cdd6f4; 13 + --text-secondary: #a6adc8; 14 + --accent: #89b4fa; 15 + --accent-hover: #b4befe; 16 + --success: #a6e3a1; 17 + --error: #f38ba8; 18 + --warning: #fab387; 19 + --border: #585b70; 20 + } 21 + 22 + * { 23 + box-sizing: border-box; 24 + margin: 0; 25 + padding: 0; 26 + } 27 + 28 + body { 29 + font-family: 'SF Mono', 'Consolas', 'Monaco', monospace; 30 + background: var(--bg-primary); 31 + color: var(--text-primary); 32 + line-height: 1.6; 33 + min-height: 100vh; 34 + } 35 + 36 + .container { 37 + max-width: 1400px; 38 + margin: 0 auto; 39 + padding: 20px; 40 + } 41 + 42 + header { 43 + text-align: center; 44 + padding: 30px 0; 45 + border-bottom: 1px solid var(--border); 46 + margin-bottom: 30px; 47 + } 48 + 49 + h1 { 50 + font-size: 2rem; 51 + color: var(--accent); 52 + margin-bottom: 10px; 53 + } 54 + 55 + .subtitle { 56 + color: var(--text-secondary); 57 + font-size: 0.9rem; 58 + } 59 + 60 + .status-bar { 61 + display: flex; 62 + align-items: center; 63 + gap: 15px; 64 + padding: 10px 15px; 65 + background: var(--bg-secondary); 66 + border-radius: 8px; 67 + margin-bottom: 20px; 68 + } 69 + 70 + .status-indicator { 71 + width: 10px; 72 + height: 10px; 73 + border-radius: 50%; 74 + background: var(--warning); 75 + } 76 + 77 + .status-indicator.ready { background: var(--success); } 78 + .status-indicator.error { background: var(--error); } 79 + 80 + .status-text { 81 + font-size: 0.85rem; 82 + color: var(--text-secondary); 83 + } 84 + 85 + .demo-grid { 86 + display: grid; 87 + grid-template-columns: repeat(auto-fit, minmax(400px, 1fr)); 88 + gap: 20px; 89 + } 90 + 91 + .demo-card { 92 + background: var(--bg-secondary); 93 + border-radius: 12px; 94 + overflow: hidden; 95 + border: 1px solid var(--border); 96 + } 97 + 98 + .card-header { 99 + padding: 15px 20px; 100 + background: var(--bg-tertiary); 101 + border-bottom: 1px solid var(--border); 102 + display: flex; 103 + justify-content: space-between; 104 + align-items: center; 105 + } 106 + 107 + .card-title { 108 + font-size: 1rem; 109 + color: var(--accent); 110 + } 111 + 112 + .card-badge { 113 + font-size: 0.7rem; 114 + padding: 3px 8px; 115 + border-radius: 4px; 116 + background: var(--bg-primary); 117 + color: var(--text-secondary); 118 + } 119 + 120 + .card-body { 121 + padding: 20px; 122 + } 123 + 124 + .code-input { 125 + width: 100%; 126 + min-height: 100px; 127 + padding: 12px; 128 + background: var(--bg-primary); 129 + border: 1px solid var(--border); 130 + border-radius: 8px; 131 + color: var(--text-primary); 132 + font-family: inherit; 133 + font-size: 0.9rem; 134 + resize: vertical; 135 + margin-bottom: 10px; 136 + } 137 + 138 + .code-input:focus { 139 + outline: none; 140 + border-color: var(--accent); 141 + } 142 + 143 + .btn-row { 144 + display: flex; 145 + gap: 10px; 146 + margin-bottom: 15px; 147 + } 148 + 149 + .btn { 150 + padding: 8px 16px; 151 + border: none; 152 + border-radius: 6px; 153 + cursor: pointer; 154 + font-family: inherit; 155 + font-size: 0.85rem; 156 + transition: all 0.2s; 157 + } 158 + 159 + .btn-primary { 160 + background: var(--accent); 161 + color: var(--bg-primary); 162 + } 163 + 164 + .btn-primary:hover { 165 + background: var(--accent-hover); 166 + } 167 + 168 + .btn-secondary { 169 + background: var(--bg-tertiary); 170 + color: var(--text-primary); 171 + } 172 + 173 + .btn-secondary:hover { 174 + background: var(--border); 175 + } 176 + 177 + .output-area { 178 + background: var(--bg-primary); 179 + border: 1px solid var(--border); 180 + border-radius: 8px; 181 + padding: 12px; 182 + min-height: 80px; 183 + max-height: 300px; 184 + overflow-y: auto; 185 + font-size: 0.85rem; 186 + } 187 + 188 + .output-line { 189 + margin-bottom: 5px; 190 + } 191 + 192 + .output-line.stdout { color: var(--text-primary); } 193 + .output-line.stderr { color: var(--error); } 194 + .output-line.result { color: var(--success); } 195 + .output-line.info { color: var(--text-secondary); font-style: italic; } 196 + 197 + .mime-output { 198 + background: white; 199 + border-radius: 6px; 200 + padding: 10px; 201 + margin-top: 10px; 202 + } 203 + 204 + .completion-list { 205 + background: var(--bg-primary); 206 + border: 1px solid var(--border); 207 + border-radius: 6px; 208 + max-height: 200px; 209 + overflow-y: auto; 210 + } 211 + 212 + .completion-item { 213 + padding: 8px 12px; 214 + border-bottom: 1px solid var(--border); 215 + display: flex; 216 + justify-content: space-between; 217 + align-items: center; 218 + } 219 + 220 + .completion-item:last-child { 221 + border-bottom: none; 222 + } 223 + 224 + .completion-name { 225 + color: var(--accent); 226 + } 227 + 228 + .completion-kind { 229 + font-size: 0.75rem; 230 + color: var(--text-secondary); 231 + background: var(--bg-tertiary); 232 + padding: 2px 6px; 233 + border-radius: 3px; 234 + } 235 + 236 + .type-info { 237 + padding: 10px; 238 + background: var(--bg-primary); 239 + border: 1px solid var(--border); 240 + border-radius: 6px; 241 + color: var(--success); 242 + } 243 + 244 + .error-list { 245 + background: var(--bg-primary); 246 + border: 1px solid var(--border); 247 + border-radius: 6px; 248 + padding: 10px; 249 + } 250 + 251 + .error-item { 252 + padding: 8px; 253 + margin-bottom: 8px; 254 + border-left: 3px solid var(--error); 255 + background: rgba(243, 139, 168, 0.1); 256 + } 257 + 258 + .error-item.warning { 259 + border-left-color: var(--warning); 260 + background: rgba(250, 179, 135, 0.1); 261 + } 262 + 263 + .env-selector { 264 + display: flex; 265 + gap: 10px; 266 + margin-bottom: 15px; 267 + flex-wrap: wrap; 268 + } 269 + 270 + .env-btn { 271 + padding: 6px 12px; 272 + border: 1px solid var(--border); 273 + background: var(--bg-primary); 274 + color: var(--text-secondary); 275 + border-radius: 4px; 276 + cursor: pointer; 277 + font-family: inherit; 278 + font-size: 0.8rem; 279 + } 280 + 281 + .env-btn.active { 282 + border-color: var(--accent); 283 + color: var(--accent); 284 + background: rgba(137, 180, 250, 0.1); 285 + } 286 + 287 + .log-panel { 288 + position: fixed; 289 + bottom: 0; 290 + left: 0; 291 + right: 0; 292 + background: var(--bg-secondary); 293 + border-top: 1px solid var(--border); 294 + max-height: 200px; 295 + overflow-y: auto; 296 + padding: 10px 20px; 297 + font-size: 0.8rem; 298 + } 299 + 300 + .log-entry { 301 + color: var(--text-secondary); 302 + margin-bottom: 3px; 303 + } 304 + 305 + .log-entry.error { color: var(--error); } 306 + .log-entry.success { color: var(--success); } 307 + 308 + .full-width { 309 + grid-column: 1 / -1; 310 + } 311 + 312 + .hidden { display: none; } 313 + 314 + pre { 315 + white-space: pre-wrap; 316 + word-wrap: break-word; 317 + } 318 + </style> 319 + </head> 320 + <body> 321 + <div class="container"> 322 + <header> 323 + <h1>js_top_worker Feature Demo</h1> 324 + <p class="subtitle">OCaml Toplevel in the Browser via WebWorker</p> 325 + </header> 326 + 327 + <div class="status-bar"> 328 + <div class="status-indicator" id="status-indicator"></div> 329 + <span class="status-text" id="status-text">Initializing...</span> 330 + </div> 331 + 332 + <div class="demo-grid"> 333 + <!-- Basic Execution --> 334 + <div class="demo-card"> 335 + <div class="card-header"> 336 + <span class="card-title">Basic Execution</span> 337 + <span class="card-badge">exec</span> 338 + </div> 339 + <div class="card-body"> 340 + <textarea class="code-input" id="exec-input">let greet name = Printf.sprintf "Hello, %s!" name;; 341 + greet "OCaml";;</textarea> 342 + <div class="btn-row"> 343 + <button class="btn btn-primary" onclick="runExec()">Execute</button> 344 + <button class="btn btn-secondary" onclick="clearOutput('exec-output')">Clear</button> 345 + </div> 346 + <div class="output-area" id="exec-output"></div> 347 + </div> 348 + </div> 349 + 350 + <!-- Multiple Environments --> 351 + <div class="demo-card"> 352 + <div class="card-header"> 353 + <span class="card-title">Multiple Environments</span> 354 + <span class="card-badge">isolation</span> 355 + </div> 356 + <div class="card-body"> 357 + <div class="env-selector" id="env-selector"> 358 + <button class="env-btn active" data-env="">default</button> 359 + </div> 360 + <div class="btn-row"> 361 + <button class="btn btn-secondary" onclick="createEnv()">+ New Env</button> 362 + <button class="btn btn-secondary" onclick="listEnvs()">List Envs</button> 363 + </div> 364 + <textarea class="code-input" id="env-input">let env_value = 42;;</textarea> 365 + <div class="btn-row"> 366 + <button class="btn btn-primary" onclick="runInEnv()">Execute in Selected Env</button> 367 + </div> 368 + <div class="output-area" id="env-output"></div> 369 + </div> 370 + </div> 371 + 372 + <!-- MIME Output --> 373 + <div class="demo-card"> 374 + <div class="card-header"> 375 + <span class="card-title">MIME Output</span> 376 + <span class="card-badge">rich output</span> 377 + </div> 378 + <div class="card-body"> 379 + <textarea class="code-input" id="mime-input">(* SVG output *) 380 + let svg = {|<svg width="100" height="100"> 381 + <circle cx="50" cy="50" r="40" fill="#89b4fa"/> 382 + <text x="50" y="55" text-anchor="middle" fill="white">OCaml</text> 383 + </svg>|};; 384 + Mime_printer.push "image/svg" svg;;</textarea> 385 + <div class="btn-row"> 386 + <button class="btn btn-primary" onclick="runMime()">Execute</button> 387 + <button class="btn btn-secondary" onclick="loadMimeExamples()">Examples</button> 388 + </div> 389 + <div class="output-area" id="mime-output"></div> 390 + <div class="mime-output hidden" id="mime-rendered"></div> 391 + </div> 392 + </div> 393 + 394 + <!-- Autocomplete --> 395 + <div class="demo-card"> 396 + <div class="card-header"> 397 + <span class="card-title">Autocomplete</span> 398 + <span class="card-badge">complete_prefix</span> 399 + </div> 400 + <div class="card-body"> 401 + <textarea class="code-input" id="complete-input">List.ma</textarea> 402 + <p style="font-size: 0.8rem; color: var(--text-secondary); margin-bottom: 10px;"> 403 + Enter partial code and click Complete to see suggestions 404 + </p> 405 + <div class="btn-row"> 406 + <button class="btn btn-primary" onclick="runComplete()">Complete</button> 407 + </div> 408 + <div class="completion-list" id="complete-output"></div> 409 + </div> 410 + </div> 411 + 412 + <!-- Type Information --> 413 + <div class="demo-card"> 414 + <div class="card-header"> 415 + <span class="card-title">Type Information</span> 416 + <span class="card-badge">type_enclosing</span> 417 + </div> 418 + <div class="card-body"> 419 + <textarea class="code-input" id="type-input">let f x = List.map (fun y -> y + 1) x</textarea> 420 + <p style="font-size: 0.8rem; color: var(--text-secondary); margin-bottom: 10px;"> 421 + Position (0-indexed): <input type="number" id="type-pos" value="8" style="width: 50px; background: var(--bg-primary); border: 1px solid var(--border); color: var(--text-primary); padding: 4px;"> 422 + </p> 423 + <div class="btn-row"> 424 + <button class="btn btn-primary" onclick="runTypeEnclosing()">Get Type</button> 425 + </div> 426 + <div class="type-info" id="type-output">Click "Get Type" to see type information</div> 427 + </div> 428 + </div> 429 + 430 + <!-- Error Reporting --> 431 + <div class="demo-card"> 432 + <div class="card-header"> 433 + <span class="card-title">Error Reporting</span> 434 + <span class="card-badge">query_errors</span> 435 + </div> 436 + <div class="card-body"> 437 + <textarea class="code-input" id="errors-input">let x : string = 42 438 + let unused = "hello" 439 + let y = unknown_function ()</textarea> 440 + <div class="btn-row"> 441 + <button class="btn btn-primary" onclick="runQueryErrors()">Check Errors</button> 442 + </div> 443 + <div class="error-list" id="errors-output">Click "Check Errors" to analyze code</div> 444 + </div> 445 + </div> 446 + 447 + <!-- Directives --> 448 + <div class="demo-card full-width"> 449 + <div class="card-header"> 450 + <span class="card-title">Directives</span> 451 + <span class="card-badge">#show, #install_printer, etc.</span> 452 + </div> 453 + <div class="card-body"> 454 + <div class="btn-row" style="flex-wrap: wrap;"> 455 + <button class="btn btn-secondary" onclick="runDirective('#show List;;')">show List</button> 456 + <button class="btn btn-secondary" onclick="runDirective('#show_type option;;')">show_type option</button> 457 + <button class="btn btn-secondary" onclick="runDirective('#help;;')">help</button> 458 + <button class="btn btn-secondary" onclick="runDirective('#print_depth 5;;')">print_depth 5</button> 459 + <button class="btn btn-secondary" onclick="runDirective('#warnings \"+a\";;')">warnings +a</button> 460 + </div> 461 + <textarea class="code-input" id="directive-input">#show List.map;;</textarea> 462 + <div class="btn-row"> 463 + <button class="btn btn-primary" onclick="runDirective()">Run Directive</button> 464 + </div> 465 + <div class="output-area" id="directive-output"></div> 466 + </div> 467 + </div> 468 + 469 + <!-- Custom Printers --> 470 + <div class="demo-card"> 471 + <div class="card-header"> 472 + <span class="card-title">Custom Printers</span> 473 + <span class="card-badge">#install_printer</span> 474 + </div> 475 + <div class="card-body"> 476 + <textarea class="code-input" id="printer-input">type color = Red | Green | Blue;; 477 + 478 + let pp_color fmt c = 479 + Format.fprintf fmt "[COLOR:%s]" 480 + (match c with Red -> "red" | Green -> "green" | Blue -> "blue");; 481 + 482 + #install_printer pp_color;; 483 + 484 + [Red; Green; Blue];;</textarea> 485 + <div class="btn-row"> 486 + <button class="btn btn-primary" onclick="runPrinter()">Execute</button> 487 + </div> 488 + <div class="output-area" id="printer-output"></div> 489 + </div> 490 + </div> 491 + 492 + <!-- Library Loading --> 493 + <div class="demo-card"> 494 + <div class="card-header"> 495 + <span class="card-title">Library Loading</span> 496 + <span class="card-badge">#require</span> 497 + </div> 498 + <div class="card-body"> 499 + <p style="font-size: 0.8rem; color: var(--text-secondary); margin-bottom: 10px;"> 500 + Libraries must be prepared with <code>jtw opam</code> first. 501 + </p> 502 + <textarea class="code-input" id="require-input">#require "str";; 503 + Str.split (Str.regexp ",") "a,b,c";;</textarea> 504 + <div class="btn-row"> 505 + <button class="btn btn-primary" onclick="runRequire()">Execute</button> 506 + </div> 507 + <div class="output-area" id="require-output"></div> 508 + </div> 509 + </div> 510 + 511 + <!-- Toplevel Script --> 512 + <div class="demo-card full-width"> 513 + <div class="card-header"> 514 + <span class="card-title">Toplevel Script Execution</span> 515 + <span class="card-badge">exec_toplevel</span> 516 + </div> 517 + <div class="card-body"> 518 + <p style="font-size: 0.8rem; color: var(--text-secondary); margin-bottom: 10px;"> 519 + Toplevel scripts use "# " prefix for input lines. Output is indented. 520 + </p> 521 + <textarea class="code-input" id="toplevel-input" style="min-height: 150px;"># let square x = x * x;; 522 + # let numbers = [1; 2; 3; 4; 5];; 523 + # List.map square numbers;;</textarea> 524 + <div class="btn-row"> 525 + <button class="btn btn-primary" onclick="runToplevel()">Execute Script</button> 526 + </div> 527 + <div class="output-area" id="toplevel-output" style="min-height: 150px;"></div> 528 + </div> 529 + </div> 530 + </div> 531 + </div> 532 + 533 + <div class="log-panel" id="log-panel"> 534 + <div id="log-entries"></div> 535 + </div> 536 + 537 + <script src="demo.js"></script> 538 + </body> 539 + </html>
+551
example/demo.js
··· 1 + /** 2 + * js_top_worker Feature Demo 3 + * 4 + * This JavaScript file demonstrates all features of js_top_worker: 5 + * - Basic execution 6 + * - Multiple isolated environments 7 + * - MIME output (HTML, SVG, images) 8 + * - Autocomplete 9 + * - Type information 10 + * - Error reporting 11 + * - Directives 12 + * - Library loading 13 + */ 14 + 15 + // ============================================================================ 16 + // Worker Communication Setup 17 + // ============================================================================ 18 + 19 + let worker = null; 20 + let rpcId = 1; 21 + const pendingCalls = new Map(); 22 + let currentEnv = ""; 23 + let envCount = 0; 24 + 25 + function getWorkerURL(baseUrl) { 26 + // Convert relative URL to absolute - importScripts in blob workers needs absolute URLs 27 + const absoluteBase = new URL(baseUrl, window.location.href).href; 28 + const content = `globalThis.__global_rel_url="${absoluteBase}"\nimportScripts("${absoluteBase}/worker.js");`; 29 + return URL.createObjectURL(new Blob([content], { type: "text/javascript" })); 30 + } 31 + 32 + function log(message, type = "info") { 33 + const entries = document.getElementById("log-entries"); 34 + const entry = document.createElement("div"); 35 + entry.className = `log-entry ${type}`; 36 + entry.textContent = `[${new Date().toLocaleTimeString()}] ${message}`; 37 + entries.appendChild(entry); 38 + entries.parentElement.scrollTop = entries.parentElement.scrollHeight; 39 + console.log(`[${type}] ${message}`); 40 + } 41 + 42 + function setStatus(status, text) { 43 + const indicator = document.getElementById("status-indicator"); 44 + const statusText = document.getElementById("status-text"); 45 + indicator.className = `status-indicator ${status}`; 46 + statusText.textContent = text; 47 + } 48 + 49 + // RPC call wrapper 50 + function rpc(method, params) { 51 + return new Promise((resolve, reject) => { 52 + const id = rpcId++; 53 + const message = JSON.stringify({ id, method, params }); 54 + 55 + pendingCalls.set(id, { resolve, reject }); 56 + worker.postMessage(message); 57 + 58 + log(`RPC: ${method}(${JSON.stringify(params).substring(0, 100)}...)`, "info"); 59 + }); 60 + } 61 + 62 + // Handle incoming messages from worker 63 + function onWorkerMessage(e) { 64 + try { 65 + const response = JSON.parse(e.data); 66 + if (response.id && pendingCalls.has(response.id)) { 67 + const { resolve, reject } = pendingCalls.get(response.id); 68 + pendingCalls.delete(response.id); 69 + 70 + if (response.error) { 71 + log(`RPC Error: ${JSON.stringify(response.error)}`, "error"); 72 + reject(response.error); 73 + } else { 74 + resolve(response.result); 75 + } 76 + } 77 + } catch (err) { 78 + log(`Parse error: ${err.message}`, "error"); 79 + } 80 + } 81 + 82 + // ============================================================================ 83 + // Initialization 84 + // ============================================================================ 85 + 86 + async function initWorker() { 87 + try { 88 + setStatus("", "Loading worker..."); 89 + 90 + // Create worker from the _opam directory 91 + const workerUrl = getWorkerURL("_opam"); 92 + worker = new Worker(workerUrl); 93 + worker.onmessage = onWorkerMessage; 94 + worker.onerror = (e) => { 95 + log(`Worker error: ${e.message}`, "error"); 96 + setStatus("error", "Worker error"); 97 + }; 98 + 99 + setStatus("", "Initializing toplevel..."); 100 + 101 + // Initialize the toplevel - named params are in first element of array 102 + // Include mime_printer for MIME output support 103 + await rpc("init", [ 104 + { init_libs: { stdlib_dcs: "lib/ocaml/dynamic_cmis.json", findlib_requires: ["mime_printer"], execute: true } } 105 + ]); 106 + 107 + log("Toplevel initialized", "success"); 108 + 109 + // Setup default environment 110 + setStatus("", "Setting up default environment..."); 111 + const setupResult = await rpc("setup", [{ env_id: "" }]); 112 + log("Default environment ready", "success"); 113 + 114 + setStatus("ready", "Ready"); 115 + 116 + // Show setup blurb 117 + if (setupResult && setupResult.caml_ppf) { 118 + log(`OCaml toplevel: ${setupResult.caml_ppf.substring(0, 100)}...`, "info"); 119 + } 120 + 121 + } catch (err) { 122 + log(`Initialization failed: ${err.message || JSON.stringify(err)}`, "error"); 123 + setStatus("error", "Initialization failed"); 124 + } 125 + } 126 + 127 + // ============================================================================ 128 + // Output Helpers 129 + // ============================================================================ 130 + 131 + function formatOutput(result) { 132 + let html = ""; 133 + 134 + if (result.stdout) { 135 + html += `<div class="output-line stdout"><pre>${escapeHtml(result.stdout)}</pre></div>`; 136 + } 137 + if (result.stderr) { 138 + html += `<div class="output-line stderr"><pre>${escapeHtml(result.stderr)}</pre></div>`; 139 + } 140 + if (result.sharp_ppf) { 141 + html += `<div class="output-line info"><pre>${escapeHtml(result.sharp_ppf)}</pre></div>`; 142 + } 143 + if (result.caml_ppf) { 144 + html += `<div class="output-line result"><pre>${escapeHtml(result.caml_ppf)}</pre></div>`; 145 + } 146 + if (result.highlight) { 147 + const h = result.highlight; 148 + html += `<div class="output-line info">Highlight: (${h.line1}:${h.col1}) to (${h.line2}:${h.col2})</div>`; 149 + } 150 + 151 + return html || '<div class="output-line info">No output</div>'; 152 + } 153 + 154 + function escapeHtml(str) { 155 + return str 156 + .replace(/&/g, "&amp;") 157 + .replace(/</g, "&lt;") 158 + .replace(/>/g, "&gt;") 159 + .replace(/"/g, "&quot;") 160 + .replace(/'/g, "&#039;"); 161 + } 162 + 163 + function clearOutput(elementId) { 164 + document.getElementById(elementId).innerHTML = ""; 165 + } 166 + 167 + // ============================================================================ 168 + // Feature: Basic Execution 169 + // ============================================================================ 170 + 171 + async function runExec() { 172 + const input = document.getElementById("exec-input").value; 173 + const output = document.getElementById("exec-output"); 174 + 175 + try { 176 + output.innerHTML = '<div class="output-line info">Executing...</div>'; 177 + const result = await rpc("exec", [{ env_id: "" }, input]); 178 + output.innerHTML = formatOutput(result); 179 + } catch (err) { 180 + output.innerHTML = `<div class="output-line stderr">Error: ${escapeHtml(JSON.stringify(err))}</div>`; 181 + } 182 + } 183 + 184 + // ============================================================================ 185 + // Feature: Multiple Environments 186 + // ============================================================================ 187 + 188 + function updateEnvSelector() { 189 + const selector = document.getElementById("env-selector"); 190 + const buttons = selector.querySelectorAll(".env-btn"); 191 + buttons.forEach(btn => { 192 + btn.classList.toggle("active", btn.dataset.env === currentEnv); 193 + }); 194 + } 195 + 196 + async function createEnv() { 197 + const envId = `env${++envCount}`; 198 + 199 + try { 200 + await rpc("create_env", [{ env_id: envId }]); 201 + await rpc("setup", [{ env_id: envId }]); 202 + 203 + const selector = document.getElementById("env-selector"); 204 + const btn = document.createElement("button"); 205 + btn.className = "env-btn"; 206 + btn.dataset.env = envId; 207 + btn.textContent = envId; 208 + btn.onclick = () => selectEnv(envId); 209 + selector.appendChild(btn); 210 + 211 + log(`Created environment: ${envId}`, "success"); 212 + selectEnv(envId); 213 + } catch (err) { 214 + log(`Failed to create environment: ${err.message || JSON.stringify(err)}`, "error"); 215 + } 216 + } 217 + 218 + function selectEnv(envId) { 219 + currentEnv = envId; 220 + updateEnvSelector(); 221 + log(`Selected environment: ${envId || "default"}`, "info"); 222 + } 223 + 224 + async function listEnvs() { 225 + try { 226 + const envs = await rpc("list_envs", []); 227 + const output = document.getElementById("env-output"); 228 + output.innerHTML = `<div class="output-line result">Environments: ${envs.join(", ")}</div>`; 229 + } catch (err) { 230 + log(`Failed to list environments: ${err.message || JSON.stringify(err)}`, "error"); 231 + } 232 + } 233 + 234 + async function runInEnv() { 235 + const input = document.getElementById("env-input").value; 236 + const output = document.getElementById("env-output"); 237 + 238 + try { 239 + output.innerHTML = `<div class="output-line info">Executing in "${currentEnv || "default"}"...</div>`; 240 + const result = await rpc("exec", [{ env_id: currentEnv }, input]); 241 + output.innerHTML = formatOutput(result); 242 + } catch (err) { 243 + output.innerHTML = `<div class="output-line stderr">Error: ${escapeHtml(JSON.stringify(err))}</div>`; 244 + } 245 + } 246 + 247 + // Make selectEnv available for onclick 248 + document.addEventListener("DOMContentLoaded", () => { 249 + document.querySelector('.env-btn[data-env=""]').onclick = () => selectEnv(""); 250 + }); 251 + 252 + // ============================================================================ 253 + // Feature: MIME Output 254 + // ============================================================================ 255 + 256 + async function runMime() { 257 + const input = document.getElementById("mime-input").value; 258 + const output = document.getElementById("mime-output"); 259 + const rendered = document.getElementById("mime-rendered"); 260 + 261 + try { 262 + output.innerHTML = '<div class="output-line info">Executing...</div>'; 263 + rendered.classList.add("hidden"); 264 + 265 + const result = await rpc("exec", [{ env_id: "" }, input]); 266 + output.innerHTML = formatOutput(result); 267 + 268 + // Render MIME values 269 + if (result.mime_vals && result.mime_vals.length > 0) { 270 + rendered.classList.remove("hidden"); 271 + rendered.innerHTML = ""; 272 + 273 + for (const mime of result.mime_vals) { 274 + const div = document.createElement("div"); 275 + div.style.marginBottom = "10px"; 276 + 277 + if (mime.mime_type.startsWith("image/svg")) { 278 + div.innerHTML = mime.data; 279 + } else if (mime.mime_type.startsWith("image/") && mime.encoding === "Base64") { 280 + div.innerHTML = `<img src="data:${mime.mime_type};base64,${mime.data}" />`; 281 + } else if (mime.mime_type === "text/html") { 282 + div.innerHTML = mime.data; 283 + } else { 284 + div.innerHTML = `<pre>${escapeHtml(mime.data)}</pre>`; 285 + } 286 + 287 + const label = document.createElement("div"); 288 + label.style.fontSize = "0.75rem"; 289 + label.style.color = "#666"; 290 + label.textContent = `MIME: ${mime.mime_type}`; 291 + div.appendChild(label); 292 + 293 + rendered.appendChild(div); 294 + } 295 + } 296 + } catch (err) { 297 + output.innerHTML = `<div class="output-line stderr">Error: ${escapeHtml(JSON.stringify(err))}</div>`; 298 + } 299 + } 300 + 301 + function loadMimeExamples() { 302 + const examples = [ 303 + { 304 + name: "SVG Circle", 305 + code: `let svg = {|<svg width="100" height="100"> 306 + <circle cx="50" cy="50" r="40" fill="#89b4fa"/> 307 + <text x="50" y="55" text-anchor="middle" fill="white">OCaml</text> 308 + </svg>|};; 309 + Mime_printer.push "image/svg" svg;;` 310 + }, 311 + { 312 + name: "HTML Table", 313 + code: `let html = {|<table style="border-collapse: collapse;"> 314 + <tr><th style="border: 1px solid #ccc; padding: 8px;">Name</th><th style="border: 1px solid #ccc; padding: 8px;">Value</th></tr> 315 + <tr><td style="border: 1px solid #ccc; padding: 8px;">x</td><td style="border: 1px solid #ccc; padding: 8px;">42</td></tr> 316 + <tr><td style="border: 1px solid #ccc; padding: 8px;">y</td><td style="border: 1px solid #ccc; padding: 8px;">3.14</td></tr> 317 + </table>|};; 318 + Mime_printer.push "text/html" html;;` 319 + }, 320 + { 321 + name: "SVG Bar Chart", 322 + code: `let bars = [20; 45; 30; 60; 35];; 323 + let bar_svg = 324 + let bar i h = 325 + Printf.sprintf {|<rect x="%d" y="%d" width="30" height="%d" fill="#89b4fa"/>|} (i * 40 + 10) (100 - h) h 326 + in 327 + Printf.sprintf {|<svg width="220" height="110">%s</svg>|} 328 + (String.concat "" (List.mapi bar bars));; 329 + Mime_printer.push "image/svg" bar_svg;;` 330 + } 331 + ]; 332 + 333 + const idx = Math.floor(Math.random() * examples.length); 334 + document.getElementById("mime-input").value = examples[idx].code; 335 + log(`Loaded example: ${examples[idx].name}`, "info"); 336 + } 337 + 338 + // ============================================================================ 339 + // Feature: Autocomplete 340 + // ============================================================================ 341 + 342 + async function runComplete() { 343 + const input = document.getElementById("complete-input").value; 344 + const output = document.getElementById("complete-output"); 345 + 346 + try { 347 + output.innerHTML = '<div class="completion-item">Loading...</div>'; 348 + 349 + // Position at end of input - variants encoded as arrays in rpclib 350 + const pos = ["Offset", input.length]; 351 + 352 + const result = await rpc("complete_prefix", [{ env_id: "", is_toplevel: true }, [], [], input, pos]); 353 + 354 + if (result.entries && result.entries.length > 0) { 355 + output.innerHTML = result.entries.map(entry => ` 356 + <div class="completion-item"> 357 + <span class="completion-name">${escapeHtml(entry.name)}</span> 358 + <span class="completion-kind">${escapeHtml(entry.kind)}</span> 359 + </div> 360 + `).join(""); 361 + } else { 362 + output.innerHTML = '<div class="completion-item">No completions found</div>'; 363 + } 364 + } catch (err) { 365 + output.innerHTML = `<div class="completion-item">Error: ${escapeHtml(JSON.stringify(err))}</div>`; 366 + } 367 + } 368 + 369 + // ============================================================================ 370 + // Feature: Type Information 371 + // ============================================================================ 372 + 373 + async function runTypeEnclosing() { 374 + const input = document.getElementById("type-input").value; 375 + const pos = parseInt(document.getElementById("type-pos").value) || 0; 376 + const output = document.getElementById("type-output"); 377 + 378 + try { 379 + output.textContent = "Loading..."; 380 + 381 + const position = ["Offset", pos]; 382 + const result = await rpc("type_enclosing", [{ env_id: "", is_toplevel: true }, [], [], input, position]); 383 + 384 + if (result && result.length > 0) { 385 + output.innerHTML = result.map(([loc, typeStr, tailPos]) => { 386 + const typeText = typeof typeStr === "object" && typeStr.String 387 + ? typeStr.String 388 + : (typeof typeStr === "object" && typeStr.Index !== undefined 389 + ? `(index ${typeStr.Index})` 390 + : JSON.stringify(typeStr)); 391 + return `<div style="margin-bottom: 5px;">${escapeHtml(typeText)}</div>`; 392 + }).join(""); 393 + } else { 394 + output.textContent = "No type information at this position"; 395 + } 396 + } catch (err) { 397 + output.textContent = `Error: ${JSON.stringify(err)}`; 398 + } 399 + } 400 + 401 + // ============================================================================ 402 + // Feature: Error Reporting 403 + // ============================================================================ 404 + 405 + async function runQueryErrors() { 406 + const input = document.getElementById("errors-input").value; 407 + const output = document.getElementById("errors-output"); 408 + 409 + try { 410 + output.innerHTML = '<div>Analyzing...</div>'; 411 + 412 + // Named params: env_id, is_toplevel. Positional: id, dependencies, source 413 + const result = await rpc("query_errors", [{ env_id: "", is_toplevel: true }, [], [], input]); 414 + 415 + if (result && result.length > 0) { 416 + output.innerHTML = result.map(err => { 417 + const isWarning = err.kind && (err.kind.Report_warning || err.kind.Report_alert); 418 + return ` 419 + <div class="error-item ${isWarning ? 'warning' : ''}"> 420 + <strong>Line ${err.loc.loc_start.pos_lnum}:</strong> ${escapeHtml(err.main)} 421 + ${err.sub && err.sub.length > 0 ? `<br><small>${err.sub.map(escapeHtml).join("<br>")}</small>` : ""} 422 + </div> 423 + `; 424 + }).join(""); 425 + } else { 426 + output.innerHTML = '<div style="color: var(--success);">No errors found!</div>'; 427 + } 428 + } catch (err) { 429 + output.innerHTML = `<div class="error-item">Analysis error: ${escapeHtml(JSON.stringify(err))}</div>`; 430 + } 431 + } 432 + 433 + // ============================================================================ 434 + // Feature: Directives 435 + // ============================================================================ 436 + 437 + async function runDirective(directive) { 438 + const input = directive || document.getElementById("directive-input").value; 439 + const output = document.getElementById("directive-output"); 440 + 441 + if (directive) { 442 + document.getElementById("directive-input").value = directive; 443 + } 444 + 445 + try { 446 + output.innerHTML = '<div class="output-line info">Executing...</div>'; 447 + const result = await rpc("exec", [{ env_id: "" }, input]); 448 + output.innerHTML = formatOutput(result); 449 + } catch (err) { 450 + output.innerHTML = `<div class="output-line stderr">Error: ${escapeHtml(JSON.stringify(err))}</div>`; 451 + } 452 + } 453 + 454 + // ============================================================================ 455 + // Feature: Custom Printers 456 + // ============================================================================ 457 + 458 + async function runPrinter() { 459 + const input = document.getElementById("printer-input").value; 460 + const output = document.getElementById("printer-output"); 461 + 462 + try { 463 + output.innerHTML = '<div class="output-line info">Executing...</div>'; 464 + 465 + // Execute each phrase separately 466 + const phrases = input.split(";;").filter(p => p.trim()).map(p => p.trim() + ";;"); 467 + let allOutput = ""; 468 + 469 + for (const phrase of phrases) { 470 + const result = await rpc("exec", [{ env_id: "" }, phrase]); 471 + allOutput += formatOutput(result); 472 + } 473 + 474 + output.innerHTML = allOutput; 475 + } catch (err) { 476 + output.innerHTML = `<div class="output-line stderr">Error: ${escapeHtml(JSON.stringify(err))}</div>`; 477 + } 478 + } 479 + 480 + // ============================================================================ 481 + // Feature: Library Loading 482 + // ============================================================================ 483 + 484 + async function runRequire() { 485 + const input = document.getElementById("require-input").value; 486 + const output = document.getElementById("require-output"); 487 + 488 + try { 489 + output.innerHTML = '<div class="output-line info">Executing (loading libraries may take a moment)...</div>'; 490 + 491 + // Execute each phrase separately 492 + const phrases = input.split(";;").filter(p => p.trim()).map(p => p.trim() + ";;"); 493 + let allOutput = ""; 494 + 495 + for (const phrase of phrases) { 496 + const result = await rpc("exec", [{ env_id: "" }, phrase]); 497 + allOutput += formatOutput(result); 498 + } 499 + 500 + output.innerHTML = allOutput; 501 + } catch (err) { 502 + output.innerHTML = `<div class="output-line stderr">Error: ${escapeHtml(JSON.stringify(err))}</div>`; 503 + } 504 + } 505 + 506 + // ============================================================================ 507 + // Feature: Toplevel Script 508 + // ============================================================================ 509 + 510 + async function runToplevel() { 511 + const input = document.getElementById("toplevel-input").value; 512 + const output = document.getElementById("toplevel-output"); 513 + 514 + try { 515 + output.innerHTML = '<div class="output-line info">Executing script...</div>'; 516 + const result = await rpc("exec_toplevel", [{ env_id: "" }, input]); 517 + 518 + if (result.script) { 519 + output.innerHTML = `<div class="output-line result"><pre>${escapeHtml(result.script)}</pre></div>`; 520 + } else { 521 + output.innerHTML = formatOutput(result); 522 + } 523 + 524 + // Handle MIME output from toplevel 525 + if (result.mime_vals && result.mime_vals.length > 0) { 526 + const mimeDiv = document.createElement("div"); 527 + mimeDiv.className = "mime-output"; 528 + mimeDiv.style.marginTop = "10px"; 529 + 530 + for (const mime of result.mime_vals) { 531 + if (mime.mime_type.startsWith("image/svg")) { 532 + mimeDiv.innerHTML += mime.data; 533 + } else if (mime.mime_type === "text/html") { 534 + mimeDiv.innerHTML += mime.data; 535 + } 536 + } 537 + 538 + if (mimeDiv.innerHTML) { 539 + output.appendChild(mimeDiv); 540 + } 541 + } 542 + } catch (err) { 543 + output.innerHTML = `<div class="output-line stderr">Error: ${escapeHtml(JSON.stringify(err))}</div>`; 544 + } 545 + } 546 + 547 + // ============================================================================ 548 + // Initialize on page load 549 + // ============================================================================ 550 + 551 + document.addEventListener("DOMContentLoaded", initWorker);
+8 -2
example/dune
··· 32 32 33 33 (executable 34 34 (name worker) 35 - (modes byte) 35 + (modes byte js) 36 36 (modules worker) 37 37 (link_flags (-linkall)) 38 + (js_of_ocaml 39 + (javascript_files ../lib/stubs.js) 40 + (flags --effects=disabled --toplevel +toplevel.js +dynlink.js)) 38 41 (libraries js_top_worker-web logs.browser mime_printer tyxml)) 39 42 40 43 (executable ··· 65 68 (targets 66 69 (dir _opam)) 67 70 (action 68 - (run jtw opam -o _opam stringext core))) 71 + (run jtw opam -o _opam str stringext mime_printer))) 69 72 70 73 (alias 71 74 (name default) 72 75 (deps 73 76 index.html 77 + demo.html 78 + demo.js 79 + README.md 74 80 example.bc.js 75 81 example2.bc.js 76 82 example3.bc.js
+1
example/example.ml
··· 14 14 { 15 15 stdlib_dcs = None; 16 16 findlib_requires = [ "stringext" ]; 17 + findlib_index = None; 17 18 execute = true; 18 19 } 19 20 in
+1 -1
example/example2.ml
··· 11 11 let* () = 12 12 W.init rpc 13 13 Toplevel_api_gen. 14 - { stdlib_dcs = None; findlib_requires = []; execute = true } 14 + { stdlib_dcs = None; findlib_requires = []; findlib_index = None; execute = true } 15 15 in 16 16 Lwt.return (Ok rpc) 17 17
+1 -1
example/example3.ml
··· 11 11 let* () = 12 12 W.init rpc 13 13 Toplevel_api_gen. 14 - { stdlib_dcs = None; findlib_requires = []; execute = true } 14 + { stdlib_dcs = None; findlib_requires = []; findlib_index = None; execute = true } 15 15 in 16 16 Lwt.return (Ok rpc) 17 17
+1 -1
example/example4.ml
··· 11 11 let* () = 12 12 W.init rpc 13 13 Toplevel_api_gen. 14 - { stdlib_dcs = None; findlib_requires = []; execute = true } 14 + { stdlib_dcs = None; findlib_requires = []; findlib_index = None; execute = true } 15 15 in 16 16 Lwt.return (Ok rpc) 17 17
+2 -2
example/unix_client.ml
··· 11 11 Unix.connect s sockaddr; 12 12 let ic = Unix.in_channel_of_descr s in 13 13 let oc = Unix.out_channel_of_descr s in 14 - let msg_buf = Transport.Cbor.string_of_call call in 14 + let msg_buf = Transport.Json.string_of_call call in 15 15 let len = Printf.sprintf "%016d" (String.length msg_buf) in 16 16 output_string oc len; 17 17 output_string oc msg_buf; ··· 22 22 let msg_buf = Bytes.make len '\000' in 23 23 really_input ic msg_buf 0 len; 24 24 let (response : Rpc.response) = 25 - Transport.Cbor.response_of_string (Bytes.unsafe_to_string msg_buf) 25 + Transport.Json.response_of_string (Bytes.unsafe_to_string msg_buf) 26 26 in 27 27 response 28 28 (*
+2 -3
example/unix_worker.ml
··· 171 171 Server.list_envs (IdlM.T.lift list_envs); 172 172 Server.setup (IdlM.T.lift setup); 173 173 Server.exec execute; 174 - Server.typecheck typecheck_phrase; 175 174 Server.complete_prefix complete_prefix; 176 175 Server.query_errors query_errors; 177 176 Server.type_enclosing type_enclosing; ··· 179 178 let rpc_fn = IdlM.server Server.implementation in 180 179 let process x = 181 180 let open Lwt in 182 - let _, call = Js_top_worker_rpc.Transport.Cbor.id_and_call_of_string (Bytes.unsafe_to_string x) in 181 + let _, call = Js_top_worker_rpc.Transport.Json.id_and_call_of_string (Bytes.unsafe_to_string x) in 183 182 rpc_fn call >>= fun response -> 184 - Js_top_worker_rpc.Transport.Cbor.string_of_response ~id:(Rpc.Int 0L) response |> return 183 + Js_top_worker_rpc.Transport.Json.string_of_response ~id:(Rpc.Int 0L) response |> return 185 184 in 186 185 serve_requests process Js_top_worker_rpc.Toplevel_api_gen.sockpath 187 186
+2 -2
idl/dune
··· 1 1 (library 2 2 (name js_top_worker_rpc) 3 3 (public_name js_top_worker-rpc) 4 - (modules toplevel_api_gen rpc_cbor transport channel) 5 - (libraries rresult mime_printer merlin-lib.query_protocol rpclib rpclib.json cbort)) 4 + (modules toplevel_api_gen transport) 5 + (libraries rresult mime_printer merlin-lib.query_protocol rpclib rpclib.json)) 6 6 7 7 (library 8 8 (name js_top_worker_client)
+2 -9
idl/js_top_worker_client.ml
··· 36 36 Js_of_ocaml.Console.console##log msg; 37 37 let msg = Js_of_ocaml.Js.to_string msg in 38 38 (* log (Printf.sprintf "Client received: %s" msg); *) 39 - Lwt_mvar.put mv (Ok (Transport.Cbor.response_of_string msg))) 39 + Lwt_mvar.put mv (Ok (Transport.Json.response_of_string msg))) 40 40 41 41 let rpc : context -> Rpc.call -> Rpc.response Lwt.t = 42 42 fun context call -> 43 43 let open Lwt in 44 - let jv = Transport.Cbor.string_of_call call |> Js_of_ocaml.Js.string in 44 + let jv = Transport.Json.string_of_call call |> Js_of_ocaml.Js.string in 45 45 (* log (Printf.sprintf "Client sending: %s" jv); *) 46 46 let mv = Lwt_mvar.create_empty () in 47 47 let outstanding_execution = ··· 99 99 string -> 100 100 (Toplevel_api_gen.exec_result, Toplevel_api_gen.err) result Lwt.t 101 101 102 - val typecheck : 103 - rpc -> 104 - string -> 105 - string -> 106 - (Toplevel_api_gen.exec_result, Toplevel_api_gen.err) result Lwt.t 107 - 108 102 val exec : 109 103 rpc -> 110 104 string -> ··· 135 129 let destroy_env rpc env_id = Wraw.destroy_env rpc env_id |> Rpc_lwt.T.get 136 130 let list_envs rpc = Wraw.list_envs rpc () |> Rpc_lwt.T.get 137 131 let setup rpc env_id = Wraw.setup rpc env_id |> Rpc_lwt.T.get 138 - let typecheck rpc env_id phrase = Wraw.typecheck rpc env_id phrase |> Rpc_lwt.T.get 139 132 let exec rpc env_id phrase = Wraw.exec rpc env_id phrase |> Rpc_lwt.T.get 140 133 let exec_toplevel rpc env_id script = Wraw.exec_toplevel rpc env_id script |> Rpc_lwt.T.get 141 134
-4
idl/js_top_worker_client.mli
··· 52 52 uses the default environment. Return value is the initial blurb printed 53 53 when starting a toplevel. Note that the toplevel must be initialised first. *) 54 54 55 - val typecheck : rpc -> string -> string -> (exec_result, err) result Lwt.t 56 - (** Typecheck a phrase using the toplevel. If [env_id] is empty string, uses the 57 - default environment. The toplevel must have been initialised first. *) 58 - 59 55 val exec : rpc -> string -> string -> (exec_result, err) result Lwt.t 60 56 (** Execute a phrase using the toplevel. If [env_id] is empty string, uses the 61 57 default environment. The toplevel must have been initialised first. *)
+2 -3
idl/js_top_worker_client_fut.ml
··· 32 32 (* Js_of_ocaml.Console.console##log msg; *) 33 33 let msg = Js_of_ocaml.Js.to_string msg in 34 34 (* log (Printf.sprintf "Client received: %s" msg); *) 35 - mv (Ok (Transport.Cbor.response_of_string msg)) 35 + mv (Ok (Transport.Json.response_of_string msg)) 36 36 37 37 let rpc : context -> Rpc.call -> Rpc.response Fut.t = 38 38 fun context call -> 39 39 let open Fut.Syntax in 40 - let jv = Transport.Cbor.string_of_call call |> Js_of_ocaml.Js.string in 40 + let jv = Transport.Json.string_of_call call |> Js_of_ocaml.Js.string in 41 41 (* log (Printf.sprintf "Client sending: %s" jv); *) 42 42 let v, mv = Fut.create () in 43 43 let outstanding_execution = ··· 82 82 let destroy_env rpc env_id = Wraw.destroy_env rpc env_id |> Rpc_fut.T.get 83 83 let list_envs rpc = Wraw.list_envs rpc () |> Rpc_fut.T.get 84 84 let setup rpc env_id = Wraw.setup rpc env_id |> Rpc_fut.T.get 85 - let typecheck rpc env_id phrase = Wraw.typecheck rpc env_id phrase |> Rpc_fut.T.get 86 85 let exec rpc env_id phrase = Wraw.exec rpc env_id phrase |> Rpc_fut.T.get 87 86 88 87 let query_errors rpc env_id id deps is_toplevel doc =
+2 -10
idl/toplevel_api.ml
··· 186 186 type init_config = { 187 187 findlib_requires : string list; (** Findlib packages to require *) 188 188 stdlib_dcs : string option; (** URL to the dynamic cmis for the OCaml standard library *) 189 + findlib_index : string option; (** URL to the findlib_index file. Defaults to "findlib_index" *) 189 190 execute : bool (** Whether this session should support execution or not. *) 190 191 } [@@deriving rpcty] 191 192 type err = InternalError of string [@@deriving rpcty] ··· 225 226 226 227 let implementation = implement description 227 228 let unit_p = Param.mk Types.unit 228 - let phrase_p = Param.mk Types.string 229 + let phrase_p = Param.mk ~name:"string" ~description:["The OCaml phrase to execute"] Types.string 229 230 let id_p = Param.mk opt_id 230 231 let env_id_p = Param.mk ~name:"env_id" ~description:["Environment ID (empty string for default)"] env_id 231 232 let env_id_list_p = Param.mk env_id_list 232 233 let dependencies_p = Param.mk dependencies 233 - let typecheck_result_p = Param.mk exec_result 234 234 let exec_result_p = Param.mk exec_result 235 235 236 236 let source_p = Param.mk source ··· 295 295 "default environment."; 296 296 ] 297 297 (env_id_p @-> returning exec_result_p err) 298 - 299 - let typecheck = 300 - declare "typecheck" 301 - [ 302 - "Typecheck a phrase without actually executing it."; 303 - "If env_id is None, uses the default environment."; 304 - ] 305 - (env_id_p @-> phrase_p @-> returning typecheck_result_p err) 306 298 307 299 let exec = 308 300 declare "exec"
+40 -19
idl/toplevel_api_gen.ml
··· 1974 1974 findlib_requires: string list [@ocaml.doc " Findlib packages to require "]; 1975 1975 stdlib_dcs: string option 1976 1976 [@ocaml.doc " URL to the dynamic cmis for the OCaml standard library "]; 1977 + findlib_index: string option 1978 + [@ocaml.doc 1979 + " URL to the findlib_index file. Defaults to \"findlib_index\" "]; 1977 1980 execute: bool 1978 1981 [@ocaml.doc " Whether this session should support execution or not. "]} 1979 1982 [@@deriving rpcty] ··· 2002 2005 Rpc.Types.fversion = None; 2003 2006 Rpc.Types.fget = (fun _r -> _r.stdlib_dcs); 2004 2007 Rpc.Types.fset = (fun v _s -> { _s with stdlib_dcs = v }) 2008 + } 2009 + and init_config_findlib_index : (_, init_config) Rpc.Types.field = 2010 + { 2011 + Rpc.Types.fname = "findlib_index"; 2012 + Rpc.Types.field = 2013 + (Rpc.Types.Option (let open Rpc.Types in Basic String)); 2014 + Rpc.Types.fdefault = None; 2015 + Rpc.Types.fdescription = 2016 + ["URL to the findlib_index file. Defaults to \"findlib_index\""]; 2017 + Rpc.Types.fversion = None; 2018 + Rpc.Types.fget = (fun _r -> _r.findlib_index); 2019 + Rpc.Types.fset = (fun v _s -> { _s with findlib_index = v }) 2005 2020 } 2006 2021 and init_config_execute : (_, init_config) Rpc.Types.field = 2007 2022 { ··· 2020 2035 Rpc.Types.fields = 2021 2036 [Rpc.Types.BoxedField init_config_findlib_requires; 2022 2037 Rpc.Types.BoxedField init_config_stdlib_dcs; 2038 + Rpc.Types.BoxedField init_config_findlib_index; 2023 2039 Rpc.Types.BoxedField init_config_execute]; 2024 2040 Rpc.Types.sname = "init_config"; 2025 2041 Rpc.Types.version = None; ··· 2030 2046 (let open Rpc.Types in Basic Bool)) 2031 2047 >>= 2032 2048 (fun init_config_execute -> 2033 - (getter.Rpc.Types.field_get "stdlib_dcs" 2049 + (getter.Rpc.Types.field_get "findlib_index" 2034 2050 (Rpc.Types.Option 2035 2051 (let open Rpc.Types in Basic String))) 2036 2052 >>= 2037 - (fun init_config_stdlib_dcs -> 2038 - (getter.Rpc.Types.field_get "findlib_requires" 2039 - (Rpc.Types.List 2053 + (fun init_config_findlib_index -> 2054 + (getter.Rpc.Types.field_get "stdlib_dcs" 2055 + (Rpc.Types.Option 2040 2056 (let open Rpc.Types in Basic String))) 2041 2057 >>= 2042 - (fun init_config_findlib_requires -> 2043 - return 2044 - { 2045 - findlib_requires = 2046 - init_config_findlib_requires; 2047 - stdlib_dcs = init_config_stdlib_dcs; 2048 - execute = init_config_execute 2049 - })))) 2058 + (fun init_config_stdlib_dcs -> 2059 + (getter.Rpc.Types.field_get 2060 + "findlib_requires" 2061 + (Rpc.Types.List 2062 + (let open Rpc.Types in Basic String))) 2063 + >>= 2064 + (fun init_config_findlib_requires -> 2065 + return 2066 + { 2067 + findlib_requires = 2068 + init_config_findlib_requires; 2069 + stdlib_dcs = init_config_stdlib_dcs; 2070 + findlib_index = 2071 + init_config_findlib_index; 2072 + execute = init_config_execute 2073 + }))))) 2050 2074 } : init_config Rpc.Types.structure) 2051 2075 and init_config = 2052 2076 { ··· 2056 2080 } 2057 2081 let _ = init_config_findlib_requires 2058 2082 and _ = init_config_stdlib_dcs 2083 + and _ = init_config_findlib_index 2059 2084 and _ = init_config_execute 2060 2085 and _ = typ_of_init_config 2061 2086 and _ = init_config ··· 2189 2214 } 2190 2215 let implementation = implement description 2191 2216 let unit_p = Param.mk Types.unit 2192 - let phrase_p = Param.mk Types.string 2217 + let phrase_p = 2218 + Param.mk ~name:"string" ~description:["The OCaml phrase to execute"] 2219 + Types.string 2193 2220 let id_p = Param.mk opt_id 2194 2221 let env_id_p = 2195 2222 Param.mk ~name:"env_id" 2196 2223 ~description:["Environment ID (empty string for default)"] env_id 2197 2224 let env_id_list_p = Param.mk env_id_list 2198 2225 let dependencies_p = Param.mk dependencies 2199 - let typecheck_result_p = Param.mk exec_result 2200 2226 let exec_result_p = Param.mk exec_result 2201 2227 let source_p = Param.mk source 2202 2228 let position_p = Param.mk msource_position ··· 2238 2264 "initial blurb printed when starting a toplevel. Note that the"; 2239 2265 "toplevel must be initialised first. If env_id is None, uses the"; 2240 2266 "default environment."] (env_id_p @-> (returning exec_result_p err)) 2241 - let typecheck = 2242 - declare "typecheck" 2243 - ["Typecheck a phrase without actually executing it."; 2244 - "If env_id is None, uses the default environment."] 2245 - (env_id_p @-> (phrase_p @-> (returning typecheck_result_p err))) 2246 2267 let exec = 2247 2268 declare "exec" 2248 2269 ["Execute a phrase using the toplevel. The toplevel must have been";
+3 -46
idl/transport.ml
··· 1 1 (** Transport abstraction for RPC encoding. 2 2 3 - This module provides a common interface for encoding/decoding RPC messages, 4 - allowing switching between JSON and CBOR transports. *) 3 + This module provides a common interface for encoding/decoding RPC messages. 4 + Uses JSON-RPC for browser compatibility. *) 5 5 6 6 module type S = sig 7 7 (** Encode a call (ID is auto-generated) *) ··· 17 17 val response_of_string : string -> Rpc.response 18 18 end 19 19 20 - (* Counter for generating unique request IDs *) 21 - let cbor_id_counter = ref 0L 22 - 23 - let new_cbor_id () = 24 - cbor_id_counter := Int64.add 1L !cbor_id_counter; 25 - !cbor_id_counter 26 - 27 - (** JSON-RPC transport (existing protocol) *) 20 + (** JSON-RPC transport *) 28 21 module Json : S = struct 29 22 let string_of_call call = 30 23 Jsonrpc.string_of_call call ··· 39 32 let response_of_string s = 40 33 Jsonrpc.response_of_string s 41 34 end 42 - 43 - (** CBOR transport (compact binary protocol) *) 44 - module Cbor : S = struct 45 - let string_of_call call = 46 - let id = Rpc.Int (new_cbor_id ()) in 47 - Rpc_cbor.string_of_call ~id call 48 - 49 - let id_and_call_of_string = Rpc_cbor.id_and_call_of_string 50 - let string_of_response = Rpc_cbor.string_of_response 51 - let response_of_string = Rpc_cbor.response_of_string 52 - end 53 - 54 - (** Auto-detecting transport that decodes based on message format *) 55 - module Auto : S = struct 56 - (* CBOR messages start with specific byte patterns based on major type. 57 - JSON messages typically start with '{' (0x7B). 58 - Since CBOR uses major types 0-7 in the high 3 bits, the first byte 59 - for a CBOR map (what we encode) would be 0xA0-0xBF (major type 5). 60 - JSON '{' is 0x7B which is different from any CBOR map prefix. *) 61 - 62 - let is_json s = 63 - String.length s > 0 && s.[0] = '{' 64 - 65 - let string_of_call call = 66 - let id = Rpc.Int (new_cbor_id ()) in 67 - Rpc_cbor.string_of_call ~id call 68 - 69 - let id_and_call_of_string = Rpc_cbor.id_and_call_of_string 70 - let string_of_response = Rpc_cbor.string_of_response 71 - 72 - let response_of_string s = 73 - if is_json s then 74 - Json.response_of_string s 75 - else 76 - Rpc_cbor.response_of_string s 77 - end
+3 -12
idl/transport.mli
··· 1 1 (** Transport abstraction for RPC encoding. 2 2 3 - This module provides a common interface for encoding/decoding RPC messages, 4 - allowing switching between JSON and CBOR transports. *) 3 + This module provides a common interface for encoding/decoding RPC messages. 4 + Uses JSON-RPC for browser compatibility. *) 5 5 6 6 (** Transport signature defining the encoding/decoding interface. *) 7 7 module type S = sig ··· 20 20 @raise Failure if decoding fails. *) 21 21 end 22 22 23 - (** JSON-RPC transport (existing protocol). 23 + (** JSON-RPC transport. 24 24 Uses the standard JSON-RPC 2.0 encoding from [rpclib.json]. *) 25 25 module Json : S 26 - 27 - (** CBOR transport (compact binary protocol). 28 - Uses {!Rpc_cbor} for type-safe binary encoding. *) 29 - module Cbor : S 30 - 31 - (** Auto-detecting transport. 32 - Uses CBOR for encoding but can decode either JSON or CBOR responses. 33 - Useful for gradual migration or mixed-protocol environments. *) 34 - module Auto : S
+2 -3
lib/dune
··· 18 18 merlin-lib.query_protocol 19 19 merlin-lib.query_commands 20 20 merlin-lib.ocaml_parsing 21 - findlib 22 - findlib.top 23 - ppxlib) 21 + ppxlib 22 + ppx_deriving.api) 24 23 (js_of_ocaml 25 24 (javascript_files stubs.js)) 26 25 (preprocess
+84 -7
lib/environment.ml
··· 1 - (** Multiple isolated execution environments. *) 1 + (** Multiple isolated execution environments. 2 + 3 + This module provides isolated execution environments for the OCaml toplevel. 4 + Each environment maintains both: 5 + - The typing environment (Env.t) which tracks type bindings 6 + - Runtime values (via Toploop.getvalue/setvalue) which store actual values 7 + 8 + When switching between environments, both are saved and restored to ensure 9 + complete isolation of definitions. *) 2 10 3 11 module StringSet = Set.Make (String) 12 + module StringMap = Map.Make (String) 13 + 14 + (* Debug logging - uses the Logs module which is configured in the worker *) 15 + let log_debug msg = Logs.info (fun m -> m "%s" msg) 4 16 5 17 type id = string 18 + 19 + (** Runtime values are stored as a map from binding name to Obj.t. 20 + We use Obj.t because Toploop.getvalue/setvalue work with Obj.t. *) 21 + type runtime_values = Obj.t StringMap.t 6 22 7 23 type t = { 8 24 id : id; 9 25 mutable toplevel_env : Env.t option; 26 + mutable runtime_values : runtime_values; 10 27 mutable is_setup : bool; 11 28 failed_cells : StringSet.t ref; 12 29 } ··· 20 37 let env = { 21 38 id; 22 39 toplevel_env = None; 40 + runtime_values = StringMap.empty; 23 41 is_setup = false; 24 42 failed_cells = ref StringSet.empty; 25 43 } in ··· 39 57 40 58 let id env = env.id 41 59 60 + (** Get the toplevel name for a binding identifier. 61 + This is used to look up runtime values via Toploop.getvalue. *) 62 + let toplevel_name ident = Translmod.toplevel_name ident 63 + 64 + (** Restore runtime values from the stored map. 65 + This sets the values in the bytecode global table. *) 66 + let restore_runtime_values env_id values = 67 + let count = StringMap.cardinal values in 68 + if count > 0 then 69 + log_debug (Printf.sprintf "[ENV] Restoring %d runtime values for env %s" count env_id); 70 + StringMap.iter (fun name value -> 71 + try 72 + log_debug (Printf.sprintf "[ENV] setvalue %s" name); 73 + Toploop.setvalue name value 74 + with e -> 75 + log_debug (Printf.sprintf "[ENV] setvalue %s failed: %s" name (Printexc.to_string e)) 76 + ) values 77 + 78 + (** Capture runtime values for the given identifiers. 79 + Returns an updated map with the new values. *) 80 + let capture_runtime_values env_id base_map idents = 81 + if idents <> [] then 82 + log_debug (Printf.sprintf "[ENV] Capturing %d new bindings for env %s" (List.length idents) env_id); 83 + List.fold_left (fun map ident -> 84 + let name = toplevel_name ident in 85 + try 86 + let value = Toploop.getvalue name in 87 + log_debug (Printf.sprintf "[ENV] captured %s" name); 88 + StringMap.add name value map 89 + with e -> 90 + log_debug (Printf.sprintf "[ENV] could not capture %s: %s" name (Printexc.to_string e)); 91 + map 92 + ) base_map idents 93 + 42 94 let with_env env f = 95 + log_debug (Printf.sprintf "[ENV] with_env called for %s (has_saved_env=%b, runtime_values_count=%d)" 96 + env.id (Option.is_some env.toplevel_env) (StringMap.cardinal env.runtime_values)); 97 + 43 98 (* Save current toplevel environment *) 44 - let saved = !Toploop.toplevel_env in 45 - (* Restore this environment's state if we have one *) 99 + let saved_typing_env = !Toploop.toplevel_env in 100 + let saved_typing_env_before = 101 + match env.toplevel_env with 102 + | Some e -> e 103 + | None -> saved_typing_env 104 + in 105 + 106 + (* Restore this environment's typing environment if we have one *) 46 107 (match env.toplevel_env with 47 108 | Some e -> Toploop.toplevel_env := e 48 109 | None -> ()); 110 + 111 + (* Restore this environment's runtime values *) 112 + restore_runtime_values env.id env.runtime_values; 113 + 49 114 (* Run the function *) 50 115 let result = 51 116 try f () 52 117 with exn -> 53 - (* Save the environment state before re-raising *) 118 + (* Capture new bindings before re-raising *) 119 + let new_idents = Env.diff saved_typing_env_before !Toploop.toplevel_env in 120 + let updated_values = capture_runtime_values env.id env.runtime_values new_idents in 121 + env.runtime_values <- updated_values; 54 122 env.toplevel_env <- Some !Toploop.toplevel_env; 55 - Toploop.toplevel_env := saved; 123 + Toploop.toplevel_env := saved_typing_env; 56 124 raise exn 57 125 in 126 + 127 + (* Capture new bindings that were added during execution *) 128 + let new_idents = Env.diff saved_typing_env_before !Toploop.toplevel_env in 129 + log_debug (Printf.sprintf "[ENV] Env.diff found %d new idents for %s" (List.length new_idents) env.id); 130 + let updated_values = capture_runtime_values env.id env.runtime_values new_idents in 131 + 58 132 (* Save the updated environment state *) 133 + env.runtime_values <- updated_values; 59 134 env.toplevel_env <- Some !Toploop.toplevel_env; 60 - (* Restore the previous environment *) 61 - Toploop.toplevel_env := saved; 135 + 136 + (* Restore the previous typing environment *) 137 + Toploop.toplevel_env := saved_typing_env; 138 + 62 139 result 63 140 64 141 let is_setup env = env.is_setup
+108 -37
lib/findlibish.ml
··· 46 46 try 47 47 Jslib.log "Reading library: %s" library_name; 48 48 let pkg_defs = pkg_expr.Fl_metascanner.pkg_defs in 49 + (* Try to find archive with various predicates. 50 + PPX packages often only define archive(ppx_driver,byte), so we need to 51 + check multiple predicate combinations to find the right archive. *) 49 52 let archive_filename = 50 - try Some (Fl_metascanner.lookup "archive" [ "byte" ] pkg_defs) 53 + (* First try with ppx_driver,byte - this catches PPX libraries like ppx_deriving.show *) 54 + try Some (Fl_metascanner.lookup "archive" [ "ppx_driver"; "byte" ] pkg_defs) 51 55 with _ -> ( 52 - try Some (Fl_metascanner.lookup "archive" [ "native" ] pkg_defs) 53 - with _ -> None) 56 + (* Then try plain byte *) 57 + try Some (Fl_metascanner.lookup "archive" [ "byte" ] pkg_defs) 58 + with _ -> ( 59 + (* Then try native as fallback *) 60 + try Some (Fl_metascanner.lookup "archive" [ "native" ] pkg_defs) 61 + with _ -> None)) 54 62 in 55 63 64 + (* Use -ppx_driver predicate for toplevel use - this ensures PPX packages 65 + pull in their runtime dependencies (e.g., ppx_deriving.show requires 66 + ppx_deriving.runtime when not using ppx_driver) *) 67 + let predicates = ["-ppx_driver"] in 56 68 let deps_str = 57 - try Fl_metascanner.lookup "requires" [] pkg_defs with _ -> "" in 69 + try Fl_metascanner.lookup "requires" predicates pkg_defs with _ -> "" in 58 70 let deps = Astring.String.fields ~empty:false deps_str in 59 71 let subdir = 60 72 List.find_opt (fun d -> d.Fl_metascanner.def_var = "directory") pkg_defs ··· 113 125 114 126 let (let*) = Lwt.bind 115 127 116 - let init (async_get : string -> (string, [>`Msg of string]) result Lwt.t) findlib_index : t Lwt.t = 117 - Jslib.log "Initializing findlib"; 118 - let* findlib_txt = async_get findlib_index in 119 - let findlib_metas = 120 - match findlib_txt with 121 - | Error (`Msg m) -> 122 - Jslib.log "Error fetching findlib index: %s" m; 123 - [] 124 - | Ok txt -> Astring.String.fields ~empty:false txt 125 - in 126 - let* metas = 127 - Lwt_list.map_p 128 - (fun x -> 129 - let* res = async_get x in 130 - match res with 131 - | Error (`Msg m) -> 132 - Jslib.log "Error fetching findlib meta %s: %s" x m; 133 - Lwt.return_none 134 - | Ok meta -> Lwt.return_some (x, meta)) 135 - findlib_metas 136 - in 137 - let metas = List.filter_map Fun.id metas in 138 - List.filter_map 139 - (fun (x, meta) -> 140 - match Angstrom.parse_string ~consume:All Uri.Parser.uri_reference x with 128 + (** Parse a findlib_index file (JSON or legacy text format) and return 129 + the list of package paths and dependency universe paths *) 130 + let parse_findlib_index content = 131 + (* Try JSON format first *) 132 + try 133 + let json = Yojson.Safe.from_string content in 134 + let open Yojson.Safe.Util in 135 + let packages = json |> member "packages" |> to_list |> List.map to_string in 136 + let deps = json |> member "deps" |> to_list |> List.map to_string in 137 + (packages, deps) 138 + with _ -> 139 + (* Fall back to legacy whitespace-separated format *) 140 + let packages = Astring.String.fields ~empty:false content in 141 + (packages, []) 142 + 143 + (** Load a single META file and parse it into a library *) 144 + let load_meta async_get meta_path = 145 + let* res = async_get meta_path in 146 + match res with 147 + | Error (`Msg m) -> 148 + Jslib.log "Error fetching findlib meta %s: %s" meta_path m; 149 + Lwt.return_none 150 + | Ok meta_content -> 151 + match Angstrom.parse_string ~consume:All Uri.Parser.uri_reference meta_path with 141 152 | Ok uri -> ( 142 153 Jslib.log "Parsed uri: %s" (Uri.path uri); 143 154 let path = Uri.path uri in ··· 147 158 Fpath.parent file |> Fpath.basename 148 159 else Fpath.get_ext file 149 160 in 150 - 151 - let lexing = Lexing.from_string meta in 161 + let lexing = Lexing.from_string meta_content in 152 162 try 153 163 let meta = Fl_metascanner.parse_lexing lexing in 154 164 let libraries = 155 165 read_libraries_from_pkg_defs ~library_name:base_library_name 156 166 ~dir:None uri meta 157 167 in 158 - Result.to_option libraries 168 + Lwt.return (Result.to_option libraries) 159 169 with _ -> 160 170 Jslib.log "Failed to parse meta: %s" (Uri.path uri); 161 - None) 171 + Lwt.return_none) 162 172 | Error m -> 163 173 Jslib.log "Failed to parse uri: %s" m; 164 - None) 165 - metas 166 - |> flatten_libs |> Lwt.return 174 + Lwt.return_none 175 + 176 + (** Resolve a relative path against a base URL's directory *) 177 + let resolve_url_relative ~base relative = 178 + match Angstrom.parse_string ~consume:All Uri.Parser.uri_reference base with 179 + | Ok base_uri -> 180 + let base_path = Uri.path base_uri in 181 + let base_dir = Fpath.(v base_path |> parent |> to_string) in 182 + let resolved = Filename.concat base_dir relative in 183 + Uri.with_path base_uri resolved |> Uri.to_string 184 + | Error _ -> relative 185 + 186 + (** Resolve a path from the URL root (for dependency universes) *) 187 + let resolve_url_from_root ~base path = 188 + match Angstrom.parse_string ~consume:All Uri.Parser.uri_reference base with 189 + | Ok base_uri -> 190 + let resolved = "/" ^ path in 191 + Uri.with_path base_uri resolved |> Uri.to_string 192 + | Error _ -> path 193 + 194 + let init (async_get : string -> (string, [>`Msg of string]) result Lwt.t) findlib_index : t Lwt.t = 195 + Jslib.log "Initializing findlib"; 196 + (* Track visited universes to avoid infinite loops *) 197 + let visited = Hashtbl.create 16 in 198 + let rec load_universe index_url = 199 + if Hashtbl.mem visited index_url then 200 + Lwt.return [] 201 + else begin 202 + Hashtbl.add visited index_url (); 203 + let* findlib_txt = async_get index_url in 204 + match findlib_txt with 205 + | Error (`Msg m) -> 206 + Jslib.log "Error fetching findlib index %s: %s" index_url m; 207 + Lwt.return [] 208 + | Ok content -> 209 + let packages, deps = parse_findlib_index content in 210 + Jslib.log "Loaded universe %s: %d packages, %d deps" index_url 211 + (List.length packages) (List.length deps); 212 + (* Resolve package paths relative to the index URL's directory *) 213 + let resolved_packages = 214 + List.map (fun p -> resolve_url_relative ~base:index_url p) packages 215 + in 216 + (* Load META files from this universe *) 217 + let* local_libs = 218 + Lwt_list.filter_map_p (load_meta async_get) resolved_packages 219 + in 220 + (* Recursively load dependency universes from root paths *) 221 + let dep_index_urls = 222 + List.map (fun dep -> 223 + resolve_url_from_root ~base:index_url (Filename.concat dep "findlib_index")) 224 + deps 225 + in 226 + let* dep_libs = Lwt_list.map_p load_universe dep_index_urls in 227 + Lwt.return (local_libs @ List.flatten dep_libs) 228 + end 229 + in 230 + let* all_libs = load_universe findlib_index in 231 + Lwt.return (flatten_libs all_libs) 167 232 168 233 let require ~import_scripts sync_get cmi_only v packages = 169 234 let rec require dcss package : ··· 187 252 let dep_dcs = List.fold_left require dcss lib.deps in 188 253 let path = Fpath.(v (Uri.path lib.meta_uri) |> parent) in 189 254 let dir = 190 - match lib.dir with None -> path | Some d -> Fpath.(path // v d) 255 + match lib.dir with 256 + | None -> path 257 + | Some "+" -> Fpath.parent path (* "+" means parent dir in findlib *) 258 + | Some d when String.length d > 0 && d.[0] = '^' -> 259 + (* "^" prefix means relative to stdlib dir - treat as parent *) 260 + Fpath.parent path 261 + | Some d -> Fpath.(path // v d) 191 262 in 192 263 let dcs = Fpath.(dir / dcs_filename |> to_string) in 193 264 let uri = Uri.with_path lib.meta_uri dcs in
+147 -94
lib/impl.ml
··· 87 87 88 88 (** {2 PPX Preprocessing} 89 89 90 - Handles PPX rewriter registration and application. Supports both: 90 + Handles PPX rewriter registration and application. Supports: 91 91 - Old-style [Ast_mapper] PPXs (e.g., [Ppx_js.mapper] for js_of_ocaml) 92 + - [ppx_deriving]-based PPXs (registered via [Ppx_deriving.register]) 92 93 - Modern [ppxlib]-based PPXs (registered via [Ppxlib.Driver]) 93 94 94 95 The [Ppx_js.mapper] is registered by default to support js_of_ocaml 95 - syntax extensions. *) 96 + syntax extensions. Other PPXs can be dynamically loaded via [#require]. *) 96 97 97 98 module JsooTopPpx = struct 98 99 open Js_of_ocaml_compiler.Stdlib ··· 117 118 let mapper = ppx_rewriter [] in 118 119 mapper.signature mapper sg) 119 120 120 - (** Apply all PPX transformations: old-style first, then ppxlib. 121 + (** Apply ppx_deriving transformations using its mapper class. 122 + This handles [@@deriving] attributes for dynamically loaded derivers. *) 123 + let apply_ppx_deriving_structure str = 124 + let mapper = new Ppx_deriving.mapper in 125 + mapper#structure str 126 + 127 + let apply_ppx_deriving_signature sg = 128 + let mapper = new Ppx_deriving.mapper in 129 + mapper#signature sg 130 + 131 + (** Apply all PPX transformations in order: 132 + 1. Old-style Ast_mapper (e.g., Ppx_js) 133 + 2. ppx_deriving derivers 134 + 3. ppxlib-based PPXs 121 135 Handles AST version conversion between compiler's Parsetree and ppxlib's internal AST. *) 122 136 let preprocess_structure str = 123 137 str 124 138 |> apply_ast_mapper_rewriters_structure 125 139 |> Ppxlib_ast.Selected_ast.of_ocaml Structure 140 + |> apply_ppx_deriving_structure 126 141 |> Ppxlib.Driver.map_structure 127 142 |> Ppxlib_ast.Selected_ast.to_ocaml Structure 128 143 ··· 130 145 sg 131 146 |> apply_ast_mapper_rewriters_signature 132 147 |> Ppxlib_ast.Selected_ast.of_ocaml Signature 148 + |> apply_ppx_deriving_signature 133 149 |> Ppxlib.Driver.map_signature 134 150 |> Ppxlib_ast.Selected_ast.to_ocaml Signature 135 151 ··· 175 191 let requires : string list ref = ref [] 176 192 let path : string option ref = ref None 177 193 let findlib_v : S.findlib_t Lwt.t option ref = ref None 194 + let findlib_resolved : S.findlib_t option ref = ref None 178 195 let execution_allowed = ref true 179 196 180 197 (** {3 Environment Management} ··· 215 232 if not res then Format.eprintf "error while evaluating %s@." s) 216 233 () 217 234 235 + (** {3 Custom Require Directive} 236 + 237 + Replaces the standard findlib #require with one that loads JavaScript 238 + archives via importScripts. This is necessary because in js_of_ocaml, 239 + we can't use Topdirs.dir_load to load .cma files - we need to load 240 + .cma.js files via importScripts instead. *) 241 + 242 + let add_dynamic_cmis_sync dcs = 243 + (* Synchronous version for #require directive. 244 + Fetches and installs toplevel CMIs synchronously. *) 245 + let furl = "file://" in 246 + let l = String.length furl in 247 + if String.length dcs.Toplevel_api_gen.dcs_url > l 248 + && String.sub dcs.dcs_url 0 l = furl 249 + then begin 250 + let path = String.sub dcs.dcs_url l (String.length dcs.dcs_url - l) in 251 + Topdirs.dir_directory path 252 + end 253 + else begin 254 + (* Web URL - fetch CMIs synchronously *) 255 + let fetch_sync filename = 256 + let url = Filename.concat dcs.Toplevel_api_gen.dcs_url filename in 257 + S.sync_get url 258 + in 259 + let path = 260 + match !path with Some p -> p | None -> failwith "Path not set" 261 + in 262 + let to_cmi_filename name = 263 + Printf.sprintf "%s.cmi" (String.uncapitalize_ascii name) 264 + in 265 + Logs.info (fun m -> m "Adding toplevel modules for dynamic cmis from %s" dcs.dcs_url); 266 + Logs.info (fun m -> m " toplevel modules: %s" 267 + (String.concat ", " dcs.dcs_toplevel_modules)); 268 + (* Fetch and create toplevel module CMIs *) 269 + List.iter 270 + (fun name -> 271 + let filename = to_cmi_filename name in 272 + match fetch_sync filename with 273 + | Some content -> 274 + let fs_name = Filename.(concat path filename) in 275 + (try S.create_file ~name:fs_name ~content with _ -> ()) 276 + | None -> ()) 277 + dcs.dcs_toplevel_modules; 278 + (* Install on-demand loader for prefixed modules *) 279 + if dcs.dcs_file_prefixes <> [] then begin 280 + let open Persistent_env.Persistent_signature in 281 + let old_loader = !load in 282 + load := fun ~allow_hidden ~unit_name -> 283 + let filename = to_cmi_filename unit_name in 284 + let fs_name = Filename.(concat path filename) in 285 + if (not (Sys.file_exists fs_name)) 286 + && List.exists 287 + (fun prefix -> String.starts_with ~prefix filename) 288 + dcs.dcs_file_prefixes 289 + then begin 290 + Logs.info (fun m -> m "Fetching %s\n%!" filename); 291 + match fetch_sync filename with 292 + | Some content -> 293 + (try S.create_file ~name:fs_name ~content with _ -> ()) 294 + | None -> () 295 + end; 296 + old_loader ~allow_hidden ~unit_name 297 + end 298 + end 299 + 300 + let register_require_directive () = 301 + let require_handler pkg = 302 + Logs.info (fun m -> m "Custom #require: loading %s" pkg); 303 + match !findlib_resolved with 304 + | None -> 305 + Format.eprintf "Error: findlib not initialized@." 306 + | Some v -> 307 + let cmi_only = not !execution_allowed in 308 + let dcs_list = S.require cmi_only v [pkg] in 309 + List.iter add_dynamic_cmis_sync dcs_list; 310 + Logs.info (fun m -> m "Custom #require: %s loaded" pkg) 311 + in 312 + (* Replace the standard findlib #require directive with our custom one. 313 + We use add_directive which will override the existing one. *) 314 + let info = { Toploop.section = "Findlib"; doc = "Load a package (js_top_worker)" } in 315 + Toploop.add_directive "require" (Toploop.Directive_string require_handler) info 316 + 218 317 let setup functions () = 219 318 let stdout_buff = Buffer.create 100 in 220 319 let stderr_buff = Buffer.create 100 in ··· 276 375 Some loc 277 376 | _ -> None 278 377 279 - (** {3 Phrase Execution} *) 378 + (** {3 Phrase Execution} 280 379 281 - let execute printval ?pp_code ?highlight_location pp_answer s = 282 - let s = 283 - let l = String.length s in 284 - if String.sub s (l - 2) 2 = ";;" then s else s ^ ";;" 285 - in 286 - let lb = Lexing.from_function (refill_lexbuf s (ref 0) pp_code) in 287 - (try 288 - while true do 289 - try 290 - let phr = !Toploop.parse_toplevel_phrase lb in 291 - let phr = JsooTopPpx.preprocess_phrase phr in 292 - ignore (Toploop.execute_phrase printval pp_answer phr : bool) 293 - with 294 - | End_of_file -> raise End_of_file 295 - | x -> 296 - (match highlight_location with 297 - | None -> () 298 - | Some f -> ( match loc x with None -> () | Some loc -> f loc)); 299 - Errors.report_error Format.err_formatter x 300 - done 301 - with End_of_file -> ()); 302 - flush_all () 380 + Executes OCaml phrases in an environment, capturing all output. 381 + Handles parsing, PPX preprocessing, and execution with error reporting. *) 303 382 304 383 let execute_in_env env phrase = 305 384 let code_buff = Buffer.create 100 in ··· 307 386 let pp_code = Format.formatter_of_buffer code_buff in 308 387 let pp_result = Format.formatter_of_buffer res_buff in 309 388 let highlighted = ref None in 310 - let highlight_location loc = 389 + let set_highlight loc = 311 390 let _file1, line1, col1 = Location.get_pos_info loc.Location.loc_start in 312 391 let _file2, line2, col2 = Location.get_pos_info loc.Location.loc_end in 313 392 highlighted := Some Toplevel_api_gen.{ line1; col1; line2; col2 } ··· 316 395 Buffer.clear res_buff; 317 396 Buffer.clear stderr_buff; 318 397 Buffer.clear stdout_buff; 398 + let phrase = 399 + let l = String.length phrase in 400 + if l >= 2 && String.sub phrase (l - 2) 2 = ";;" then phrase 401 + else phrase ^ ";;" 402 + in 319 403 let o, () = 320 404 Environment.with_env env (fun () -> 321 405 S.capture 322 - (fun () -> execute true ~pp_code ~highlight_location pp_result phrase) 406 + (fun () -> 407 + let lb = Lexing.from_function (refill_lexbuf phrase (ref 0) (Some pp_code)) in 408 + (try 409 + while true do 410 + try 411 + let phr = !Toploop.parse_toplevel_phrase lb in 412 + let phr = JsooTopPpx.preprocess_phrase phr in 413 + ignore (Toploop.execute_phrase true pp_result phr : bool) 414 + with 415 + | End_of_file -> raise End_of_file 416 + | x -> 417 + (match loc x with Some l -> set_highlight l | None -> ()); 418 + Errors.report_error Format.err_formatter x 419 + done 420 + with End_of_file -> ()); 421 + flush_all ()) 323 422 ()) 324 423 in 325 424 let mime_vals = Mime_printer.get () in ··· 412 511 Logs.info (fun m -> m "Fetching %s\n%!" filename); 413 512 match fetch_sync filename with 414 513 | Some x -> 415 - S.create_file ~name:fs_name ~content:x; 514 + (try S.create_file ~name:fs_name ~content:x with _ -> ()); 416 515 (* At this point we need to tell merlin that the dir contents 417 516 have changed *) 418 517 if s = "merl" then reset_dirs () else reset_dirs_comp () ··· 450 549 Logs.info (fun m -> m "init()"); 451 550 path := Some S.path; 452 551 453 - findlib_v := Some (S.findlib_init "findlib_index"); 552 + let findlib_path = Option.value ~default:"findlib_index" init_libs.findlib_index in 553 + findlib_v := Some (S.findlib_init findlib_path); 454 554 455 555 let stdlib_dcs = 456 556 match init_libs.stdlib_dcs with ··· 517 617 match !findlib_v with 518 618 | Some v -> 519 619 let* v = v in 620 + (* Store the resolved findlib value for use by #require directive *) 621 + findlib_resolved := Some v; 622 + (* Register our custom #require directive that uses findlibish *) 623 + register_require_directive (); 520 624 Lwt.return (S.require (not !execution_allowed) v !requires) 521 625 | None -> Lwt.return [] 522 626 in ··· 541 645 Lwt.return 542 646 (Error (Toplevel_api_gen.InternalError (Printexc.to_string e)))) 543 647 544 - let typecheck_phrase env_id phr = 545 - let env = resolve_env env_id in 546 - let res_buff = Buffer.create 100 in 547 - let pp_result = Format.formatter_of_buffer res_buff in 548 - let highlighted = ref None in 549 - let highlight_location loc = 550 - let _file1, line1, col1 = Location.get_pos_info loc.Location.loc_start in 551 - let _file2, line2, col2 = Location.get_pos_info loc.Location.loc_end in 552 - highlighted := Some Toplevel_api_gen.{ line1; col1; line2; col2 } 553 - in 554 - Buffer.clear res_buff; 555 - Buffer.clear stderr_buff; 556 - Buffer.clear stdout_buff; 557 - Environment.with_env env (fun () -> 558 - try 559 - let lb = Lexing.from_function (refill_lexbuf phr (ref 0) None) in 560 - let phr = !Toploop.parse_toplevel_phrase lb in 561 - let phr = JsooTopPpx.preprocess_phrase phr in 562 - match phr with 563 - | Parsetree.Ptop_def sstr -> 564 - let oldenv = !Toploop.toplevel_env in 565 - Typecore.reset_delayed_checks (); 566 - let str, sg, sn, _, newenv = 567 - Typemod.type_toplevel_phrase oldenv sstr 568 - in 569 - let sg' = Typemod.Signature_names.simplify newenv sn sg in 570 - ignore (Includemod.signatures ~mark:true oldenv sg sg'); 571 - Typecore.force_delayed_checks (); 572 - Printtyped.implementation pp_result str; 573 - Format.pp_print_flush pp_result (); 574 - Warnings.check_fatal (); 575 - flush_all (); 576 - IdlM.ErrM.return 577 - Toplevel_api_gen. 578 - { 579 - stdout = buff_opt stdout_buff; 580 - stderr = buff_opt stderr_buff; 581 - sharp_ppf = None; 582 - caml_ppf = buff_opt res_buff; 583 - highlight = !highlighted; 584 - mime_vals = []; 585 - } 586 - | _ -> failwith "Typechecking" 587 - with x -> 588 - (match loc x with None -> () | Some loc -> highlight_location loc); 589 - Errors.report_error Format.err_formatter x; 590 - IdlM.ErrM.return 591 - Toplevel_api_gen. 592 - { 593 - stdout = buff_opt stdout_buff; 594 - stderr = buff_opt stderr_buff; 595 - sharp_ppf = None; 596 - caml_ppf = buff_opt res_buff; 597 - highlight = !highlighted; 598 - mime_vals = []; 599 - }) 600 - 601 648 let handle_toplevel env stripped = 602 649 if String.length stripped < 2 || stripped.[0] <> '#' || stripped.[1] <> ' ' 603 650 then ( ··· 645 692 (Toplevel_api_gen.InternalError (Printexc.to_string e)) 646 693 647 694 let execute env_id (phrase : string) = 695 + Logs.info (fun m -> m "execute() for env_id=%s" env_id); 648 696 let env = resolve_env env_id in 649 697 let result = execute_in_env env phrase in 698 + Logs.info (fun m -> m "execute() done for env_id=%s" env_id); 650 699 IdlM.ErrM.return result 651 700 652 701 (** {3 Merlin Integration} ··· 880 929 () 881 930 882 931 let map_pos line1 pos = 932 + (* Only subtract line number when there's actually a prepended line *) 933 + let line_offset = if line1 = "" then 0 else 1 in 883 934 Lexing. 884 935 { 885 936 pos with 886 937 pos_bol = pos.pos_bol - String.length line1; 887 - pos_lnum = pos.pos_lnum - 1; 938 + pos_lnum = pos.pos_lnum - line_offset; 888 939 pos_cnum = pos.pos_cnum - String.length line1; 889 940 } 890 941 ··· 901 952 let deps = 902 953 List.filter (fun dep -> not (Environment.is_cell_failed execution_env dep)) deps 903 954 in 904 - (* Logs.info (fun m -> m "About to mangle toplevel"); *) 905 955 let line1, src = mangle_toplevel is_toplevel orig_source deps in 906 - let id = Option.get id in 907 - let source = Merlin_kernel.Msource.make (line1 ^ src) in 956 + let full_source = line1 ^ src in 957 + let source = Merlin_kernel.Msource.make full_source in 908 958 let query = 909 959 Query_protocol.Errors { lexing = true; parsing = true; typing = true } 910 960 in ··· 922 972 let loc = 923 973 map_loc line1 (Ocaml_parsing.Location.loc_of_report error) 924 974 in 925 - 926 975 let main = 927 976 Format.asprintf "@[%a@]" Ocaml_parsing.Location.print_main 928 977 error ··· 939 988 source; 940 989 }) 941 990 in 942 - if List.length errors = 0 then add_cmi execution_env id deps src 943 - else Environment.add_failed_cell execution_env id; 991 + (* Only track cell CMIs when id is provided (notebook mode) *) 992 + (match id with 993 + | Some cell_id -> 994 + if List.length errors = 0 then add_cmi execution_env cell_id deps src 995 + else Environment.add_failed_cell execution_env cell_id 996 + | None -> ()); 944 997 945 998 (* Logs.info (fun m -> m "Got to end"); *) 946 999 IdlM.ErrM.return errors
+16 -1
lib/jslib.ml
··· 11 11 in 12 12 Option.map Js.to_string x 13 13 in 14 - match global_rel_url with Some rel -> Filename.concat rel url | None -> url 14 + match global_rel_url with 15 + | Some rel -> 16 + (* If url starts with /, it's relative to server root - just use the scheme/host *) 17 + if String.length url > 0 && url.[0] = '/' then 18 + (* Extract scheme://host from rel and append url *) 19 + match String.index_opt rel ':' with 20 + | Some colon_idx -> 21 + let after_scheme = colon_idx + 3 in (* skip "://" *) 22 + (match String.index_from_opt rel after_scheme '/' with 23 + | Some slash_idx -> String.sub rel 0 slash_idx ^ url 24 + | None -> rel ^ url) 25 + | None -> url 26 + else 27 + Filename.concat rel url 28 + | None -> url 15 29 16 30 let sync_get url = 17 31 let open Js_of_ocaml in ··· 34 48 let async_get url = 35 49 let ( let* ) = Lwt.bind in 36 50 let open Js_of_ocaml in 51 + let url = map_url url in 37 52 Console.console##log (Js.string ("Fetching: " ^ url)); 38 53 let* frame = 39 54 Js_of_ocaml_lwt.XmlHttpRequest.perform_raw ~response_type:ArrayBuffer url
+15 -8
lib/worker.ml
··· 9 9 thread" keeping the page responsive. *) 10 10 11 11 let server process e = 12 - (* Jslib.log "Worker received: %s" e; *) 13 - let id, call = Transport.Cbor.id_and_call_of_string e in 12 + let id, call = Transport.Json.id_and_call_of_string e in 14 13 Lwt.bind (process call) (fun response -> 15 - let rtxt = Transport.Cbor.string_of_response ~id response in 16 - (* Jslib.log "Worker sending CBOR response"; *) 14 + let rtxt = Transport.Json.string_of_response ~id response in 17 15 Js_of_ocaml.Worker.post_message (Js_of_ocaml.Js.string rtxt); 18 16 Lwt.return ()) 19 17 ··· 53 51 54 52 let sync_get = Jslib.sync_get 55 53 let async_get = Jslib.async_get 56 - let create_file = Js_of_ocaml.Sys_js.create_file 54 + 55 + (* Idempotent create_file that ignores "file already exists" errors. 56 + This is needed because multiple .cma.js files compiled with --toplevel 57 + may embed the same CMI files, and when loaded via import_scripts they 58 + all try to register those CMIs. *) 59 + let create_file ~name ~content = 60 + try Js_of_ocaml.Sys_js.create_file ~name ~content 61 + with Sys_error _ -> () 57 62 58 63 let get_stdlib_dcs uri = 59 64 Findlibish.fetch_dynamic_cmis sync_get uri |> Result.to_list 60 65 61 - let import_scripts = Js_of_ocaml.Worker.import_scripts 66 + let import_scripts urls = 67 + (* Map relative URLs to absolute using the global base URL *) 68 + let absolute_urls = List.map Jslib.map_url urls in 69 + Js_of_ocaml.Worker.import_scripts absolute_urls 62 70 let findlib_init = Findlibish.init async_get 63 71 64 72 let require b v = function ··· 96 104 Server.list_envs (Impl.IdlM.T.lift list_envs); 97 105 Server.setup (Impl.IdlM.T.lift setup); 98 106 Server.exec execute; 99 - Server.typecheck typecheck_phrase; 100 107 Server.complete_prefix complete_prefix; 101 108 Server.query_errors query_errors; 102 109 Server.type_enclosing type_enclosing; ··· 105 112 Js_of_ocaml.Worker.set_onmessage (fun x -> 106 113 let s = Js_of_ocaml.Js.to_string x in 107 114 Jslib.log "Worker received: %s" s; 108 - ignore (server rpc_fn s)); 115 + Lwt.async (fun () -> server rpc_fn s)); 109 116 Console.console##log (Js.string "All finished") 110 117 with e -> 111 118 Console.console##log (Js.string ("Exception: " ^ Printexc.to_string e))
+1 -14
test/browser/client_test.ml
··· 45 45 let* () = 46 46 W.init rpc 47 47 Toplevel_api_gen. 48 - { stdlib_dcs = None; findlib_requires = []; execute = true } 48 + { stdlib_dcs = None; findlib_requires = []; findlib_index = None; execute = true } 49 49 in 50 50 add_result "init" true "Initialized successfully"; 51 51 let* _o = W.setup rpc "" in ··· 75 75 (Printf.sprintf "stdout=%s" (Option.value ~default:"(none)" o.stdout)); 76 76 Lwt.return (Ok ()) 77 77 78 - let test_typecheck rpc = 79 - let ( let* ) = Lwt_result.bind in 80 - (* Valid code should typecheck *) 81 - let* o1 = W.typecheck rpc "" "let f x = x + 1;;" in 82 - let valid_ok = Option.is_none o1.stderr in 83 - add_result "typecheck_valid" valid_ok "Valid code typechecks"; 84 - (* Invalid code should produce error *) 85 - let* o2 = W.typecheck rpc "" "let f x = x + \"string\";;" in 86 - let invalid_has_error = Option.is_some o2.stderr || Option.is_some o2.highlight in 87 - add_result "typecheck_invalid" invalid_has_error "Invalid code produces error"; 88 - Lwt.return (Ok ()) 89 - 90 78 let test_query_errors rpc = 91 79 let ( let* ) = Lwt_result.bind in 92 80 (* Test that query_errors RPC call works - result depends on context *) ··· 107 95 let* () = test_init_and_setup rpc in 108 96 let* () = test_exec rpc in 109 97 let* () = test_exec_with_output rpc in 110 - let* () = test_typecheck rpc in 111 98 let* () = test_query_errors rpc in 112 99 Lwt.return (Ok ()) 113 100 in
-23
test/browser/dune
··· 1 - ; Test worker - minimal worker for browser tests 2 - (executable 3 - (name test_worker) 4 - (modes js) 5 - (modules test_worker) 6 - (link_flags (-linkall)) 7 - (preprocess (pps js_of_ocaml-ppx)) 8 - (js_of_ocaml 9 - (flags (:standard --toplevel)) 10 - (javascript_files ../../lib/stubs.js)) 11 - (libraries js_top_worker-web zarith_stubs_js)) 12 - 13 - ; Test client - exercises js_top_worker_client 14 - (executable 15 - (name client_test) 16 - (modes js) 17 - (modules client_test) 18 - (preprocess (pps js_of_ocaml-ppx)) 19 - (libraries js_top_worker_client js_of_ocaml lwt astring)) 20 - 21 - (alias 22 - (name default) 23 - (deps client_test.bc.js test_worker.bc.js test.html))
+323
test/browser/test_demo.js
··· 1 + /** 2 + * Playwright test for js_top_worker demo page 3 + * Run with: node test/browser/test_demo.js 4 + */ 5 + 6 + const { chromium } = require('playwright'); 7 + 8 + async function runTests() { 9 + console.log('Launching browser...'); 10 + const browser = await chromium.launch({ 11 + headless: true, 12 + args: ['--no-sandbox', '--disable-setuid-sandbox'] 13 + }); 14 + 15 + const context = await browser.newContext(); 16 + const page = await context.newPage(); 17 + 18 + // Collect console messages 19 + const consoleMessages = []; 20 + page.on('console', msg => { 21 + consoleMessages.push({ type: msg.type(), text: msg.text() }); 22 + console.log(`[browser ${msg.type()}] ${msg.text()}`); 23 + }); 24 + 25 + // Collect page errors 26 + const pageErrors = []; 27 + page.on('pageerror', err => { 28 + pageErrors.push(err.message); 29 + console.log(`[page error] ${err.message}`); 30 + }); 31 + 32 + console.log('Navigating to demo page...'); 33 + await page.goto('http://localhost:8000/demo.html', { timeout: 30000 }); 34 + 35 + // Wait for initialization 36 + console.log('Waiting for toplevel to initialize...'); 37 + try { 38 + await page.waitForFunction( 39 + () => document.getElementById('status-indicator')?.classList.contains('ready'), 40 + { timeout: 60000 } 41 + ); 42 + console.log('✓ Toplevel initialized successfully'); 43 + } catch (e) { 44 + const status = await page.$eval('#status-text', el => el.textContent); 45 + console.log(`✗ Initialization failed. Status: ${status}`); 46 + 47 + // Print relevant console messages 48 + const errors = consoleMessages.filter(m => m.type === 'error' || m.text.includes('error')); 49 + if (errors.length > 0) { 50 + console.log('Console errors:'); 51 + errors.slice(0, 10).forEach(m => console.log(` [${m.type}] ${m.text}`)); 52 + } 53 + 54 + await browser.close(); 55 + process.exit(1); 56 + } 57 + 58 + const results = { 59 + passed: [], 60 + failed: [] 61 + }; 62 + 63 + // Test 1: Basic Execution 64 + console.log('\nTesting Basic Execution...'); 65 + try { 66 + await page.click('button:has-text("Execute"):near(#exec-input)'); 67 + await page.waitForFunction( 68 + () => !document.getElementById('exec-output')?.textContent.includes('Executing...'), 69 + { timeout: 10000 } 70 + ); 71 + const execOutput = await page.$eval('#exec-output', el => el.textContent); 72 + if (execOutput.includes('Hello, OCaml!')) { 73 + console.log('✓ Basic Execution works'); 74 + results.passed.push('Basic Execution'); 75 + } else { 76 + console.log(`✗ Basic Execution failed. Output: ${execOutput}`); 77 + results.failed.push({ name: 'Basic Execution', error: execOutput }); 78 + } 79 + } catch (e) { 80 + console.log(`✗ Basic Execution error: ${e.message}`); 81 + results.failed.push({ name: 'Basic Execution', error: e.message }); 82 + } 83 + 84 + // Test 2: Multiple Environments 85 + console.log('\nTesting Multiple Environments...'); 86 + try { 87 + await page.click('button:has-text("+ New Env")'); 88 + await page.waitForTimeout(1000); 89 + 90 + const envButtons = await page.$$eval('#env-selector .env-btn', btns => btns.map(b => b.textContent)); 91 + if (envButtons.length > 1) { 92 + console.log('✓ Environment creation works'); 93 + results.passed.push('Multiple Environments'); 94 + } else { 95 + console.log(`✗ Environment creation failed. Buttons: ${envButtons.join(', ')}`); 96 + results.failed.push({ name: 'Multiple Environments', error: 'No new env button appeared' }); 97 + } 98 + } catch (e) { 99 + console.log(`✗ Multiple Environments error: ${e.message}`); 100 + results.failed.push({ name: 'Multiple Environments', error: e.message }); 101 + } 102 + 103 + // Test 3: MIME Output 104 + console.log('\nTesting MIME Output...'); 105 + try { 106 + await page.click('button:has-text("Execute"):near(#mime-input)'); 107 + await page.waitForFunction( 108 + () => !document.getElementById('mime-output')?.textContent.includes('Executing...'), 109 + { timeout: 10000 } 110 + ); 111 + 112 + // Check if rendered MIME content is visible 113 + const mimeRendered = await page.$('#mime-rendered'); 114 + const isHidden = await mimeRendered?.evaluate(el => el.classList.contains('hidden')); 115 + const mimeOutput = await page.$eval('#mime-output', el => el.textContent); 116 + 117 + if (!isHidden) { 118 + const svgContent = await mimeRendered?.evaluate(el => el.innerHTML); 119 + if (svgContent?.includes('svg') || svgContent?.includes('circle')) { 120 + console.log('✓ MIME Output works (SVG rendered)'); 121 + results.passed.push('MIME Output'); 122 + } else { 123 + console.log(`✗ MIME Output - SVG not rendered. Content: ${svgContent?.substring(0, 100)}`); 124 + results.failed.push({ name: 'MIME Output', error: 'SVG not rendered' }); 125 + } 126 + } else { 127 + console.log(`✗ MIME Output - rendered area hidden. Output: ${mimeOutput}`); 128 + results.failed.push({ name: 'MIME Output', error: mimeOutput }); 129 + } 130 + } catch (e) { 131 + console.log(`✗ MIME Output error: ${e.message}`); 132 + results.failed.push({ name: 'MIME Output', error: e.message }); 133 + } 134 + 135 + // Test 4: Autocomplete 136 + console.log('\nTesting Autocomplete...'); 137 + try { 138 + await page.click('button:has-text("Complete")'); 139 + await page.waitForFunction( 140 + () => !document.getElementById('complete-output')?.textContent.includes('Loading...'), 141 + { timeout: 10000 } 142 + ); 143 + 144 + const completions = await page.$eval('#complete-output', el => el.textContent); 145 + if (completions.includes('map') || completions.includes('mapi')) { 146 + console.log('✓ Autocomplete works'); 147 + results.passed.push('Autocomplete'); 148 + } else { 149 + console.log(`✗ Autocomplete failed. Output: ${completions}`); 150 + results.failed.push({ name: 'Autocomplete', error: completions }); 151 + } 152 + } catch (e) { 153 + console.log(`✗ Autocomplete error: ${e.message}`); 154 + results.failed.push({ name: 'Autocomplete', error: e.message }); 155 + } 156 + 157 + // Test 5: Type Information 158 + console.log('\nTesting Type Information...'); 159 + try { 160 + await page.click('button:has-text("Get Type")'); 161 + await page.waitForFunction( 162 + () => !document.getElementById('type-output')?.textContent.includes('Loading...'), 163 + { timeout: 10000 } 164 + ); 165 + 166 + const typeOutput = await page.$eval('#type-output', el => el.textContent); 167 + if (typeOutput.includes('int') || typeOutput.includes('list') || typeOutput.includes('->')) { 168 + console.log('✓ Type Information works'); 169 + results.passed.push('Type Information'); 170 + } else { 171 + console.log(`✗ Type Information failed. Output: ${typeOutput}`); 172 + results.failed.push({ name: 'Type Information', error: typeOutput }); 173 + } 174 + } catch (e) { 175 + console.log(`✗ Type Information error: ${e.message}`); 176 + results.failed.push({ name: 'Type Information', error: e.message }); 177 + } 178 + 179 + // Test 6: Error Reporting 180 + console.log('\nTesting Error Reporting...'); 181 + try { 182 + await page.click('button:has-text("Check Errors")'); 183 + await page.waitForFunction( 184 + () => !document.getElementById('errors-output')?.textContent.includes('Analyzing...'), 185 + { timeout: 10000 } 186 + ); 187 + 188 + const errorsOutput = await page.$eval('#errors-output', el => el.textContent); 189 + // Should find type error or unknown identifier 190 + if (errorsOutput.includes('Line') || errorsOutput.includes('error') || errorsOutput.includes('Error')) { 191 + console.log('✓ Error Reporting works'); 192 + results.passed.push('Error Reporting'); 193 + } else { 194 + console.log(`✗ Error Reporting failed. Output: ${errorsOutput}`); 195 + results.failed.push({ name: 'Error Reporting', error: errorsOutput }); 196 + } 197 + } catch (e) { 198 + console.log(`✗ Error Reporting error: ${e.message}`); 199 + results.failed.push({ name: 'Error Reporting', error: e.message }); 200 + } 201 + 202 + // Test 7: Directives - #show List 203 + console.log('\nTesting Directives...'); 204 + try { 205 + await page.click('button:has-text("show List")'); 206 + await page.waitForFunction( 207 + () => !document.getElementById('directive-output')?.textContent.includes('Executing...'), 208 + { timeout: 10000 } 209 + ); 210 + 211 + const directiveOutput = await page.$eval('#directive-output', el => el.textContent); 212 + if (directiveOutput.includes('module') || directiveOutput.includes('List') || directiveOutput.includes('val')) { 213 + console.log('✓ Directives work'); 214 + results.passed.push('Directives'); 215 + } else { 216 + console.log(`✗ Directives failed. Output: ${directiveOutput}`); 217 + results.failed.push({ name: 'Directives', error: directiveOutput }); 218 + } 219 + } catch (e) { 220 + console.log(`✗ Directives error: ${e.message}`); 221 + results.failed.push({ name: 'Directives', error: e.message }); 222 + } 223 + 224 + // Test 8: Custom Printers 225 + console.log('\nTesting Custom Printers...'); 226 + try { 227 + await page.click('button:has-text("Execute"):near(#printer-input)'); 228 + await page.waitForFunction( 229 + () => !document.getElementById('printer-output')?.textContent.includes('Executing...'), 230 + { timeout: 15000 } 231 + ); 232 + 233 + const printerOutput = await page.$eval('#printer-output', el => el.textContent); 234 + if (printerOutput.includes('[COLOR:') || printerOutput.includes('pp_color')) { 235 + console.log('✓ Custom Printers work'); 236 + results.passed.push('Custom Printers'); 237 + } else { 238 + console.log(`✗ Custom Printers failed. Output: ${printerOutput.substring(0, 200)}`); 239 + results.failed.push({ name: 'Custom Printers', error: printerOutput.substring(0, 200) }); 240 + } 241 + } catch (e) { 242 + console.log(`✗ Custom Printers error: ${e.message}`); 243 + results.failed.push({ name: 'Custom Printers', error: e.message }); 244 + } 245 + 246 + // Test 9: Library Loading (#require) 247 + console.log('\nTesting Library Loading...'); 248 + try { 249 + await page.click('button:has-text("Execute"):near(#require-input)'); 250 + await page.waitForFunction( 251 + () => !document.getElementById('require-output')?.textContent.includes('Executing'), 252 + { timeout: 30000 } 253 + ); 254 + 255 + const requireOutput = await page.$eval('#require-output', el => el.textContent); 256 + // Str.split should return a list 257 + if (requireOutput.includes('["a"; "b"; "c"]') || requireOutput.includes('string list')) { 258 + console.log('✓ Library Loading works'); 259 + results.passed.push('Library Loading'); 260 + } else if (requireOutput.includes('Error') || requireOutput.includes('not found')) { 261 + console.log(`✗ Library Loading failed (library not available). Output: ${requireOutput}`); 262 + results.failed.push({ name: 'Library Loading', error: requireOutput }); 263 + } else { 264 + console.log(`? Library Loading unclear. Output: ${requireOutput}`); 265 + results.failed.push({ name: 'Library Loading', error: requireOutput }); 266 + } 267 + } catch (e) { 268 + console.log(`✗ Library Loading error: ${e.message}`); 269 + results.failed.push({ name: 'Library Loading', error: e.message }); 270 + } 271 + 272 + // Test 10: Toplevel Script Execution 273 + console.log('\nTesting Toplevel Script Execution...'); 274 + try { 275 + await page.click('button:has-text("Execute Script")'); 276 + await page.waitForFunction( 277 + () => !document.getElementById('toplevel-output')?.textContent.includes('Executing script...'), 278 + { timeout: 15000 } 279 + ); 280 + 281 + const toplevelOutput = await page.$eval('#toplevel-output', el => el.textContent); 282 + // Should show the squared numbers [1; 4; 9; 16; 25] 283 + if (toplevelOutput.includes('[1; 4; 9; 16; 25]') || toplevelOutput.includes('square')) { 284 + console.log('✓ Toplevel Script Execution works'); 285 + results.passed.push('Toplevel Script Execution'); 286 + } else { 287 + console.log(`✗ Toplevel Script Execution failed. Output: ${toplevelOutput.substring(0, 200)}`); 288 + results.failed.push({ name: 'Toplevel Script Execution', error: toplevelOutput.substring(0, 200) }); 289 + } 290 + } catch (e) { 291 + console.log(`✗ Toplevel Script Execution error: ${e.message}`); 292 + results.failed.push({ name: 'Toplevel Script Execution', error: e.message }); 293 + } 294 + 295 + // Summary 296 + console.log('\n' + '='.repeat(50)); 297 + console.log('SUMMARY'); 298 + console.log('='.repeat(50)); 299 + console.log(`Passed: ${results.passed.length}`); 300 + console.log(`Failed: ${results.failed.length}`); 301 + 302 + if (results.failed.length > 0) { 303 + console.log('\nFailed tests:'); 304 + results.failed.forEach(f => { 305 + console.log(` - ${f.name}: ${f.error.substring(0, 100)}`); 306 + }); 307 + } 308 + 309 + // Print any page errors 310 + if (pageErrors.length > 0) { 311 + console.log('\nPage errors encountered:'); 312 + pageErrors.forEach(e => console.log(` ${e}`)); 313 + } 314 + 315 + await browser.close(); 316 + 317 + process.exit(results.failed.length > 0 ? 1 : 0); 318 + } 319 + 320 + runTests().catch(e => { 321 + console.error('Test runner error:', e); 322 + process.exit(1); 323 + });
+99
test/browser/test_env_isolation.js
··· 1 + /** 2 + * Test environment isolation in js_top_worker 3 + */ 4 + 5 + const { chromium } = require('playwright'); 6 + 7 + async function testEnvIsolation() { 8 + console.log('Launching browser...'); 9 + const browser = await chromium.launch({ 10 + headless: true, 11 + args: ['--no-sandbox', '--disable-setuid-sandbox'] 12 + }); 13 + 14 + const page = await browser.newPage(); 15 + page.on('console', msg => console.log(`[browser ${msg.type()}] ${msg.text()}`)); 16 + 17 + console.log('Navigating to demo page...'); 18 + await page.goto('http://localhost:8000/demo.html', { timeout: 30000 }); 19 + 20 + // Wait for initialization 21 + console.log('Waiting for toplevel to initialize...'); 22 + await page.waitForFunction( 23 + () => document.getElementById('status-indicator')?.classList.contains('ready'), 24 + { timeout: 60000 } 25 + ); 26 + console.log('✓ Toplevel initialized'); 27 + 28 + // Test environment isolation 29 + console.log('\n=== Testing Environment Isolation ===\n'); 30 + 31 + // Step 1: Set env_value = 100 in default environment 32 + console.log('Step 1: Setting env_value = 100 in default environment...'); 33 + await page.fill('#env-input', 'let env_value = 100;;'); 34 + await page.click('button:has-text("Execute in Selected Env")'); 35 + await page.waitForTimeout(2000); 36 + 37 + let output = await page.$eval('#env-output', el => el.textContent); 38 + console.log(` Output: ${output}`); 39 + 40 + // Step 2: Create a new environment 41 + console.log('\nStep 2: Creating env1...'); 42 + await page.click('button:has-text("+ New Env")'); 43 + await page.waitForTimeout(2000); 44 + 45 + // Step 3: Set env_value = 200 in env1 46 + console.log('Step 3: Setting env_value = 200 in env1...'); 47 + await page.fill('#env-input', 'let env_value = 200;;'); 48 + await page.click('button:has-text("Execute in Selected Env")'); 49 + await page.waitForTimeout(2000); 50 + 51 + output = await page.$eval('#env-output', el => el.textContent); 52 + console.log(` Output: ${output}`); 53 + 54 + // Step 4: Check env_value in env1 (should be 200) 55 + console.log('\nStep 4: Checking env_value in env1 (should be 200)...'); 56 + await page.fill('#env-input', 'env_value;;'); 57 + await page.click('button:has-text("Execute in Selected Env")'); 58 + await page.waitForTimeout(2000); 59 + 60 + output = await page.$eval('#env-output', el => el.textContent); 61 + console.log(` Output: ${output}`); 62 + const env1Value = output.includes('200') ? 200 : (output.includes('100') ? 100 : 'unknown'); 63 + console.log(` env_value in env1 = ${env1Value}`); 64 + 65 + // Step 5: Switch back to default environment 66 + console.log('\nStep 5: Switching to default environment...'); 67 + await page.click('.env-btn[data-env=""]'); 68 + await page.waitForTimeout(500); 69 + 70 + // Step 6: Check env_value in default (should be 100) 71 + console.log('Step 6: Checking env_value in default (should be 100)...'); 72 + await page.fill('#env-input', 'env_value;;'); 73 + await page.click('button:has-text("Execute in Selected Env")'); 74 + await page.waitForTimeout(2000); 75 + 76 + output = await page.$eval('#env-output', el => el.textContent); 77 + console.log(` Output: ${output}`); 78 + const defaultValue = output.includes('100') ? 100 : (output.includes('200') ? 200 : 'unknown'); 79 + console.log(` env_value in default = ${defaultValue}`); 80 + 81 + // Summary 82 + console.log('\n=== RESULTS ==='); 83 + console.log(`env1 value: ${env1Value} (expected: 200)`); 84 + console.log(`default value: ${defaultValue} (expected: 100)`); 85 + 86 + if (env1Value === 200 && defaultValue === 100) { 87 + console.log('\n✓ Environment isolation WORKS correctly'); 88 + } else { 89 + console.log('\n✗ Environment isolation BROKEN'); 90 + console.log(' Both environments share the same state!'); 91 + } 92 + 93 + await browser.close(); 94 + } 95 + 96 + testEnvIsolation().catch(e => { 97 + console.error('Test error:', e); 98 + process.exit(1); 99 + });
+110
test/browser/test_features.js
··· 1 + const { chromium } = require('playwright'); 2 + 3 + async function testFeatures() { 4 + console.log('Launching browser...'); 5 + const browser = await chromium.launch({ 6 + headless: true, 7 + args: ['--no-sandbox', '--disable-setuid-sandbox'] 8 + }); 9 + 10 + const page = await browser.newPage(); 11 + 12 + // Collect all console messages 13 + const consoleMessages = []; 14 + page.on('console', msg => { 15 + consoleMessages.push(msg.text()); 16 + console.log('[browser] ' + msg.text()); 17 + }); 18 + page.on('pageerror', err => console.log('[page error] ' + err.message)); 19 + 20 + console.log('Navigating to demo page...'); 21 + await page.goto('http://localhost:8091/demo.html'); 22 + 23 + // Wait for ready 24 + console.log('Waiting for worker to initialize...'); 25 + try { 26 + await page.waitForFunction( 27 + () => document.getElementById('status-text')?.textContent === 'Ready', 28 + { timeout: 60000 } 29 + ); 30 + console.log('Worker ready!\n'); 31 + } catch (e) { 32 + console.log('Worker init failed'); 33 + await browser.close(); 34 + return; 35 + } 36 + 37 + // Test 1: MIME Output 38 + console.log('=== TEST 1: MIME Output ==='); 39 + const mimeCode = `let svg = {|<svg width="100" height="100"><circle cx="50" cy="50" r="40" fill="blue"/></svg>|};; 40 + Mime_printer.push "image/svg+xml" svg;;`; 41 + await page.fill('#mime-input', mimeCode); 42 + await page.evaluate(() => runMime()); 43 + await page.waitForTimeout(5000); 44 + const mimeOutput = await page.evaluate(() => document.getElementById('mime-output')?.textContent); 45 + const mimeRendered = await page.evaluate(() => document.getElementById('mime-rendered')?.innerHTML); 46 + console.log('MIME Output:', mimeOutput?.substring(0, 200)); 47 + console.log('MIME Rendered:', mimeRendered?.substring(0, 200) || '(empty)'); 48 + console.log(''); 49 + 50 + // Test 2: Autocomplete 51 + console.log('=== TEST 2: Autocomplete ==='); 52 + await page.fill('#complete-input', 'List.m'); 53 + await page.evaluate(() => runComplete()); 54 + await page.waitForTimeout(3000); 55 + const completeOutput = await page.evaluate(() => document.getElementById('complete-output')?.textContent); 56 + console.log('Complete Output:', completeOutput?.substring(0, 300)); 57 + console.log(''); 58 + 59 + // Test 3: Type Information 60 + console.log('=== TEST 3: Type Information ==='); 61 + await page.fill('#type-input', 'let x = List.map'); 62 + await page.fill('#type-pos', '10'); 63 + await page.evaluate(() => runTypeEnclosing()); 64 + await page.waitForTimeout(3000); 65 + const typeOutput = await page.evaluate(() => document.getElementById('type-output')?.textContent); 66 + console.log('Type Output:', typeOutput?.substring(0, 300)); 67 + console.log(''); 68 + 69 + // Test 4: Error Reporting 70 + console.log('=== TEST 4: Error Reporting ==='); 71 + await page.fill('#errors-input', 'let x : string = 42'); 72 + await page.evaluate(() => runQueryErrors()); 73 + await page.waitForTimeout(3000); 74 + const errorsOutput = await page.evaluate(() => document.getElementById('errors-output')?.textContent); 75 + console.log('Errors Output:', errorsOutput?.substring(0, 300)); 76 + console.log(''); 77 + 78 + // Test 5: Custom Printers 79 + console.log('=== TEST 5: Custom Printers ==='); 80 + const printerCode = `type point = { x: int; y: int };; 81 + let p = { x = 10; y = 20 };;`; 82 + await page.fill('#printer-input', printerCode); 83 + await page.evaluate(() => runPrinter()); 84 + await page.waitForTimeout(3000); 85 + const printerOutput = await page.evaluate(() => document.getElementById('printer-output')?.textContent); 86 + console.log('Printer Output:', printerOutput?.substring(0, 300)); 87 + console.log(''); 88 + 89 + // Test 6: Library Loading 90 + console.log('=== TEST 6: Library Loading ==='); 91 + const requireCode = `#require "str";; 92 + Str.string_match (Str.regexp "hello") "hello world" 0;;`; 93 + await page.fill('#require-input', requireCode); 94 + await page.evaluate(() => runRequire()); 95 + await page.waitForTimeout(5000); 96 + const requireOutput = await page.evaluate(() => document.getElementById('require-output')?.textContent); 97 + console.log('Require Output:', requireOutput?.substring(0, 300)); 98 + console.log(''); 99 + 100 + // Print any errors from console 101 + const errors = consoleMessages.filter(m => m.includes('Error') || m.includes('error') || m.includes('Exception')); 102 + if (errors.length > 0) { 103 + console.log('=== ERRORS FOUND ==='); 104 + errors.forEach(e => console.log(e)); 105 + } 106 + 107 + await browser.close(); 108 + } 109 + 110 + testFeatures().catch(console.error);
-1
test/browser/test_worker.ml
··· 47 47 Server.exec execute; 48 48 Server.setup (Impl.IdlM.T.lift setup); 49 49 Server.init (Impl.IdlM.T.lift init); 50 - Server.typecheck typecheck_phrase; 51 50 Server.complete_prefix complete_prefix; 52 51 Server.query_errors query_errors; 53 52 Server.type_enclosing type_enclosing;
-3
test/cbor/dune
··· 1 - (test 2 - (name test_cbor) 3 - (libraries js_top_worker-rpc rpclib cbort))
-113
test/cbor/test_cbor.ml
··· 1 - (** Test CBOR encoding of Rpc.t values *) 2 - 3 - module Rpc_cbor = Js_top_worker_rpc.Rpc_cbor 4 - 5 - let () = 6 - let test_roundtrip name v = 7 - let encoded = Rpc_cbor.encode v in 8 - match Rpc_cbor.decode encoded with 9 - | Ok decoded when decoded = v -> Printf.printf "%s: OK\n" name 10 - | Ok decoded -> 11 - Printf.printf "%s: FAIL - mismatch\n expected: %s\n got: %s\n" 12 - name (Rpc.to_string v) (Rpc.to_string decoded) 13 - | Error e -> Printf.printf "%s: FAIL - %s\n" name (Cbort.Error.to_string e) 14 - in 15 - test_roundtrip "Int" (Rpc.Int 42L); 16 - test_roundtrip "Int negative" (Rpc.Int (-100L)); 17 - test_roundtrip "Int32" (Rpc.Int32 42l); 18 - test_roundtrip "Bool true" (Rpc.Bool true); 19 - test_roundtrip "Bool false" (Rpc.Bool false); 20 - test_roundtrip "Float" (Rpc.Float 3.14); 21 - test_roundtrip "String" (Rpc.String "hello"); 22 - test_roundtrip "String empty" (Rpc.String ""); 23 - test_roundtrip "DateTime" (Rpc.DateTime "2024-01-20T12:00:00Z"); 24 - test_roundtrip "Null" Rpc.Null; 25 - test_roundtrip "Base64" (Rpc.Base64 "\x00\x01\x02"); 26 - test_roundtrip "Enum empty" (Rpc.Enum []); 27 - test_roundtrip "Enum" (Rpc.Enum [Rpc.Int 1L; Rpc.String "a"]); 28 - test_roundtrip "Dict empty" (Rpc.Dict []); 29 - test_roundtrip "Dict" (Rpc.Dict [("key", Rpc.Int 42L)]); 30 - test_roundtrip "Nested" (Rpc.Dict [ 31 - ("list", Rpc.Enum [Rpc.Int 1L; Rpc.Int 2L]); 32 - ("obj", Rpc.Dict [("inner", Rpc.String "value")]); 33 - ]); 34 - 35 - print_newline (); 36 - 37 - (* Test call codec *) 38 - let call = Rpc.call "test_method" [Rpc.String "arg1"; Rpc.Int 42L] in 39 - let encoded_call = Rpc_cbor.encode_call call in 40 - (match Rpc_cbor.decode_call encoded_call with 41 - | Ok decoded when decoded = call -> print_endline "Call: OK" 42 - | Ok _ -> print_endline "Call: FAIL - mismatch" 43 - | Error e -> Printf.printf "Call: FAIL - %s\n" (Cbort.Error.to_string e)); 44 - 45 - (* Test notification call *) 46 - let notif = Rpc.notification "notify" [Rpc.Bool true] in 47 - let encoded_notif = Rpc_cbor.encode_call notif in 48 - (match Rpc_cbor.decode_call encoded_notif with 49 - | Ok decoded when decoded = notif -> print_endline "Notification: OK" 50 - | Ok _ -> print_endline "Notification: FAIL - mismatch" 51 - | Error e -> Printf.printf "Notification: FAIL - %s\n" (Cbort.Error.to_string e)); 52 - 53 - (* Test response codec *) 54 - let response = Rpc.success (Rpc.String "result") in 55 - let encoded_response = Rpc_cbor.encode_response response in 56 - (match Rpc_cbor.decode_response encoded_response with 57 - | Ok decoded when decoded = response -> print_endline "Success response: OK" 58 - | Ok _ -> print_endline "Success response: FAIL - mismatch" 59 - | Error e -> Printf.printf "Success response: FAIL - %s\n" (Cbort.Error.to_string e)); 60 - 61 - (* Test failure response *) 62 - let failure = Rpc.failure (Rpc.String "error message") in 63 - let encoded_failure = Rpc_cbor.encode_response failure in 64 - (match Rpc_cbor.decode_response encoded_failure with 65 - | Ok decoded when decoded = failure -> print_endline "Failure response: OK" 66 - | Ok _ -> print_endline "Failure response: FAIL - mismatch" 67 - | Error e -> Printf.printf "Failure response: FAIL - %s\n" (Cbort.Error.to_string e)); 68 - 69 - print_newline (); 70 - print_endline "=== Message Envelope Tests ==="; 71 - 72 - (* Test request envelope *) 73 - let req : Rpc_cbor.request = { 74 - id = Rpc.Int 42L; 75 - call = Rpc.call "test_method" [Rpc.String "arg1"]; 76 - } in 77 - let encoded_req = Rpc_cbor.encode_request req in 78 - (match Rpc_cbor.decode_request encoded_req with 79 - | Ok decoded when decoded = req -> print_endline "Request envelope: OK" 80 - | Ok _ -> print_endline "Request envelope: FAIL - mismatch" 81 - | Error e -> Printf.printf "Request envelope: FAIL - %s\n" (Cbort.Error.to_string e)); 82 - 83 - (* Test response envelope *) 84 - let resp_msg : Rpc_cbor.response_msg = { 85 - id = Rpc.Int 42L; 86 - response = Rpc.success (Rpc.String "result"); 87 - } in 88 - let encoded_resp = Rpc_cbor.encode_response_msg resp_msg in 89 - (match Rpc_cbor.decode_response_msg encoded_resp with 90 - | Ok decoded when decoded = resp_msg -> print_endline "Response envelope: OK" 91 - | Ok _ -> print_endline "Response envelope: FAIL - mismatch" 92 - | Error e -> Printf.printf "Response envelope: FAIL - %s\n" (Cbort.Error.to_string e)); 93 - 94 - (* Test Jsonrpc-compatible API *) 95 - let call = Rpc.call "test" [Rpc.Bool true] in 96 - let id = Rpc.Int 123L in 97 - let encoded = Rpc_cbor.string_of_call ~id call in 98 - let (decoded_id, decoded_call) = Rpc_cbor.id_and_call_of_string encoded in 99 - if decoded_id = id && decoded_call = call then 100 - print_endline "string_of_call/id_and_call_of_string: OK" 101 - else 102 - print_endline "string_of_call/id_and_call_of_string: FAIL - mismatch"; 103 - 104 - let response = Rpc.success (Rpc.Int 999L) in 105 - let encoded_resp = Rpc_cbor.string_of_response ~id response in 106 - let decoded_resp = Rpc_cbor.response_of_string encoded_resp in 107 - if decoded_resp = response then 108 - print_endline "string_of_response/response_of_string: OK" 109 - else 110 - print_endline "string_of_response/response_of_string: FAIL - mismatch"; 111 - 112 - print_newline (); 113 - print_endline "All tests complete!"
-123
test/channel/channel_test.ml
··· 1 - (** Tests for the Channel module (push message support). *) 2 - 3 - open Js_top_worker_rpc 4 - 5 - let test_request_roundtrip () = 6 - let id = 42L in 7 - let call = Rpc.{ name = "test_method"; params = [Rpc.String "arg1"]; is_notification = false } in 8 - let encoded = Channel.encode_request id call in 9 - match Channel.decode encoded with 10 - | Ok (Channel.Request { id = id'; call = call' }) -> 11 - assert (id = id'); 12 - assert (call.name = call'.name); 13 - print_endline "Request roundtrip: OK" 14 - | Ok _ -> failwith "Wrong message type" 15 - | Error e -> failwith ("Decode error: " ^ e) 16 - 17 - let test_response_roundtrip () = 18 - let id = 123L in 19 - let response = Rpc.{ success = true; contents = Rpc.String "result"; is_notification = false } in 20 - let encoded = Channel.encode_response id response in 21 - match Channel.decode encoded with 22 - | Ok (Channel.Response { id = id'; response = response' }) -> 23 - assert (id = id'); 24 - assert (response.success = response'.success); 25 - print_endline "Response roundtrip: OK" 26 - | Ok _ -> failwith "Wrong message type" 27 - | Error e -> failwith ("Decode error: " ^ e) 28 - 29 - let test_push_stdout () = 30 - let data = "Hello, world!" in 31 - let encoded = Channel.push_stdout data in 32 - match Channel.decode encoded with 33 - | Ok (Channel.Push (Channel.Output { stream = `Stdout; data = data' })) -> 34 - assert (data = data'); 35 - print_endline "Push stdout: OK" 36 - | Ok _ -> failwith "Wrong message type" 37 - | Error e -> failwith ("Decode error: " ^ e) 38 - 39 - let test_push_stderr () = 40 - let data = "Error message" in 41 - let encoded = Channel.push_stderr data in 42 - match Channel.decode encoded with 43 - | Ok (Channel.Push (Channel.Output { stream = `Stderr; data = data' })) -> 44 - assert (data = data'); 45 - print_endline "Push stderr: OK" 46 - | Ok _ -> failwith "Wrong message type" 47 - | Error e -> failwith ("Decode error: " ^ e) 48 - 49 - let test_push_widget_update () = 50 - let widget_id = "widget_1" in 51 - let state = Rpc.Dict [("value", Rpc.Int 42L)] in 52 - let encoded = Channel.push_widget_update ~widget_id state in 53 - match Channel.decode encoded with 54 - | Ok (Channel.Push (Channel.Widget_update { widget_id = id'; state = state' })) -> 55 - assert (widget_id = id'); 56 - assert (state = state'); 57 - print_endline "Push widget_update: OK" 58 - | Ok _ -> failwith "Wrong message type" 59 - | Error e -> failwith ("Decode error: " ^ e) 60 - 61 - let test_push_progress () = 62 - let task_id = "task_1" in 63 - let percent = 50 in 64 - let message = Some "Processing..." in 65 - let encoded = Channel.push_progress ~task_id ~percent ?message () in 66 - match Channel.decode encoded with 67 - | Ok (Channel.Push (Channel.Progress { task_id = id'; percent = p'; message = m' })) -> 68 - assert (task_id = id'); 69 - assert (percent = p'); 70 - assert (message = m'); 71 - print_endline "Push progress: OK" 72 - | Ok _ -> failwith "Wrong message type" 73 - | Error e -> failwith ("Decode error: " ^ e) 74 - 75 - let test_event_widget () = 76 - let widget_id = "widget_1" in 77 - let event_type = "click" in 78 - let data = Rpc.Dict [("x", Rpc.Int 100L); ("y", Rpc.Int 200L)] in 79 - let event = Channel.Widget_event { widget_id; event_type; data } in 80 - let encoded = Channel.encode_event event in 81 - match Channel.decode encoded with 82 - | Ok (Channel.Event (Channel.Widget_event { widget_id = id'; event_type = et'; data = d' })) -> 83 - assert (widget_id = id'); 84 - assert (event_type = et'); 85 - assert (data = d'); 86 - print_endline "Event widget: OK" 87 - | Ok _ -> failwith "Wrong message type" 88 - | Error e -> failwith ("Decode error: " ^ e) 89 - 90 - let test_custom_push () = 91 - let kind = "my_custom_push" in 92 - let data = Rpc.Enum [Rpc.String "a"; Rpc.String "b"] in 93 - let push = Channel.Custom_push { kind; data } in 94 - let encoded = Channel.encode_push push in 95 - match Channel.decode encoded with 96 - | Ok (Channel.Push (Channel.Custom_push { kind = k'; data = d' })) -> 97 - assert (kind = k'); 98 - assert (data = d'); 99 - print_endline "Custom push: OK" 100 - | Ok _ -> failwith "Wrong message type" 101 - | Error e -> failwith ("Decode error: " ^ e) 102 - 103 - let () = 104 - print_endline "=== Channel Tests ==="; 105 - print_newline (); 106 - 107 - test_request_roundtrip (); 108 - test_response_roundtrip (); 109 - 110 - print_newline (); 111 - print_endline "=== Push Message Tests ==="; 112 - test_push_stdout (); 113 - test_push_stderr (); 114 - test_push_widget_update (); 115 - test_push_progress (); 116 - test_custom_push (); 117 - 118 - print_newline (); 119 - print_endline "=== Event Tests ==="; 120 - test_event_widget (); 121 - 122 - print_newline (); 123 - print_endline "All channel tests passed!"
-3
test/channel/dune
··· 1 - (test 2 - (name channel_test) 3 - (libraries js_top_worker-rpc))
+30 -7
test/cram/directives.t/run.t
··· 9 9 $ unix_worker & 10 10 unix_worker: [INFO] init() 11 11 unix_worker: [INFO] init() finished 12 + unix_worker: [INFO] init() 13 + unix_worker: [INFO] init() finished 12 14 unix_worker: [INFO] setup() for env default... 13 15 unix_worker: [INFO] Setup complete 14 16 unix_worker: [INFO] setup() finished for env default 17 + unix_worker: [INFO] setup() for env default... 18 + unix_worker: [INFO] setup() already done for env default 15 19 $ sleep 2 16 20 $ unix_client init '{ findlib_requires:[], execute: true }' 17 21 N 18 22 $ unix_client setup '' 19 - {mime_vals:[];stderr:S(error while evaluating #enable "pretty";; 20 - error while evaluating #disable "shortvar";;);stdout:S(OCaml version 5.4.0 21 - Unknown directive enable. 22 - Unknown directive disable.)} 23 + {mime_vals:[];stderr:S(Environment already set up)} 23 24 24 25 ============================================== 25 26 SECTION 1: Basic Code Execution (Baseline) ··· 389 390 #show_val <ident> 390 391 Print the signature of the corresponding value. 391 392 393 + Findlib 394 + #require <str> 395 + Load a package (js_top_worker) 396 + #require <str> 397 + Load a package (js_top_worker) 398 + 392 399 Pretty-printing 393 400 #install_printer <ident> 394 401 Registers a printer for values of a certain type. ··· 429 436 #camlp4r 430 437 #list 431 438 #predicates <str> 432 - #require <str> 433 439 #thread)} 434 440 435 441 ============================================== ··· 482 488 483 489 $ unix_client exec_toplevel '' '# #require "str";;' 484 490 {mime_vals:[];parts:[];script:S(# #require "str";; 485 - /home/node/.opam/default/lib/ocaml/str: added to search path)} 491 + unix_worker: [INFO] Custom #require: loading str 492 + /home/node/.opam/default/lib/ocaml/str: added to search path 493 + unix_worker: [INFO] Custom #require: str loaded)} 486 494 487 495 $ unix_client exec_toplevel '' '# Str.regexp "test";;' 488 496 {mime_vals:[];parts:[];script:S(# Str.regexp "test";; ··· 762 770 ppx_compare.runtime-lib (version: v0.17.0) 763 771 ppx_custom_printf (version: v0.17.0) 764 772 ppx_derivers (version: n/a) 773 + ppx_deriving (version: n/a) 774 + ppx_deriving.api (version: 6.1.1) 775 + ppx_deriving.create (version: 6.1.1) 776 + ppx_deriving.enum (version: 6.1.1) 777 + ppx_deriving.eq (version: 6.1.1) 778 + ppx_deriving.fold (version: 6.1.1) 779 + ppx_deriving.iter (version: 6.1.1) 780 + ppx_deriving.make (version: 6.1.1) 781 + ppx_deriving.map (version: 6.1.1) 782 + ppx_deriving.ord (version: 6.1.1) 783 + ppx_deriving.runtime (version: 6.1.1) 784 + ppx_deriving.show (version: 6.1.1) 785 + ppx_deriving.std (version: 6.1.1) 765 786 ppx_deriving_rpc (version: 10.0.0) 766 787 ppx_diff (version: n/a) 767 788 ppx_diff.diffable (version: v0.17.1) ··· 945 966 946 967 $ unix_client exec_toplevel '' '# #require "nonexistent_package_12345";;' 947 968 {mime_vals:[];parts:[];script:S(# #require "nonexistent_package_12345";; 948 - No such package: nonexistent_package_12345)} 969 + unix_worker: [INFO] Custom #require: loading nonexistent_package_12345 970 + No such package: nonexistent_package_12345 971 + unix_worker: [INFO] Custom #require: nonexistent_package_12345 loaded)} 949 972 950 973 #use non-existent file: 951 974
-5
test/cram/simple.t/run.t
··· 1 1 $ ./script.sh 2 - unix_worker: [INFO] init() 3 - unix_worker: [INFO] init() finished 4 2 N 5 - unix_worker: [INFO] setup() for env default... 6 - unix_worker: [INFO] Setup complete 7 - unix_worker: [INFO] setup() finished for env default 8 3 {mime_vals:[];stderr:S(error while evaluating #enable "pretty";; 9 4 error while evaluating #disable "shortvar";;);stdout:S(OCaml version 5.4.0 10 5 Unknown directive enable.
+3 -5
test/node/dune
··· 41 41 (targets 42 42 (dir _opam)) 43 43 (action 44 - (run jtw opam base ppx_deriving.runtime --no-worker -o _opam))) 44 + (run jtw opam base ppx_deriving.show ppx_deriving.eq ppx_deriving.runtime --no-worker -o _opam))) 45 45 46 46 (rule 47 47 (deps _opam) ··· 121 121 (diff node_directive_test.expected node_directive_test.out))) 122 122 123 123 ; PPX test executable 124 + ; Note: ppx_deriving is NOT statically linked - it's dynamically loaded via #require 124 125 (executable 125 126 (name node_ppx_test) 126 127 (modes byte) ··· 139 140 rpclib.json 140 141 findlib.top 141 142 js_of_ocaml-lwt 142 - zarith_stubs_js 143 - ppx_deriving.show 144 - ppx_deriving.eq 145 - ppx_deriving.runtime)) 143 + zarith_stubs_js)) 146 144 147 145 (rule 148 146 (targets node_ppx_test.js)
+81
test/node/node_directive_test.expected
··· 2 2 3 3 node_directive_test.js: [INFO] init() 4 4 Initializing findlib 5 + Parsed uri: lib/stdlib-shims/META 6 + Reading library: stdlib-shims 7 + Number of children: 0 5 8 Parsed uri: lib/sexplib0/META 6 9 Reading library: sexplib0 7 10 Number of children: 0 11 + Parsed uri: lib/ppxlib/META 12 + Reading library: ppxlib 13 + Number of children: 11 14 + Found child: __private__ 15 + Reading library: ppxlib.__private__ 16 + Number of children: 1 17 + Found child: ppx_foo_deriver 18 + Reading library: ppxlib.__private__.ppx_foo_deriver 19 + Number of children: 0 20 + Found child: ast 21 + Reading library: ppxlib.ast 22 + Number of children: 0 23 + Found child: astlib 24 + Reading library: ppxlib.astlib 25 + Number of children: 0 26 + Found child: metaquot 27 + Reading library: ppxlib.metaquot 28 + Number of children: 0 29 + Found child: metaquot_lifters 30 + Reading library: ppxlib.metaquot_lifters 31 + Number of children: 0 32 + Found child: print_diff 33 + Reading library: ppxlib.print_diff 34 + Number of children: 0 35 + Found child: runner 36 + Reading library: ppxlib.runner 37 + Number of children: 0 38 + Found child: runner_as_ppx 39 + Reading library: ppxlib.runner_as_ppx 40 + Number of children: 0 41 + Found child: stdppx 42 + Reading library: ppxlib.stdppx 43 + Number of children: 0 44 + Found child: traverse 45 + Reading library: ppxlib.traverse 46 + Number of children: 0 47 + Found child: traverse_builtins 48 + Reading library: ppxlib.traverse_builtins 49 + Number of children: 0 8 50 Parsed uri: lib/ppx_deriving/META 9 51 Reading library: ppx_deriving 10 52 Number of children: 12 ··· 44 86 Found child: std 45 87 Reading library: ppx_deriving.std 46 88 Number of children: 0 89 + Parsed uri: lib/ppx_derivers/META 90 + Reading library: ppx_derivers 91 + Number of children: 0 47 92 Parsed uri: lib/ocaml_intrinsics_kernel/META 48 93 Reading library: ocaml_intrinsics_kernel 49 94 Number of children: 0 50 95 Parsed uri: lib/ocaml/stdlib/META 51 96 Reading library: stdlib 97 + Number of children: 0 98 + Parsed uri: lib/ocaml/compiler-libs/META 99 + Reading library: compiler-libs 100 + Number of children: 5 101 + Found child: common 102 + Reading library: compiler-libs.common 103 + Number of children: 0 104 + Found child: bytecomp 105 + Reading library: compiler-libs.bytecomp 106 + Number of children: 0 107 + Found child: optcomp 108 + Reading library: compiler-libs.optcomp 109 + Number of children: 0 110 + Found child: toplevel 111 + Reading library: compiler-libs.toplevel 112 + Number of children: 0 113 + Found child: native-toplevel 114 + Reading library: compiler-libs.native-toplevel 115 + Number of children: 0 116 + Parsed uri: lib/ocaml-compiler-libs/META 117 + Reading library: ocaml-compiler-libs 118 + Number of children: 5 119 + Found child: bytecomp 120 + Reading library: ocaml-compiler-libs.bytecomp 121 + Number of children: 0 122 + Found child: common 123 + Reading library: ocaml-compiler-libs.common 124 + Number of children: 0 125 + Found child: optcomp 126 + Reading library: ocaml-compiler-libs.optcomp 127 + Number of children: 0 128 + Found child: shadow 129 + Reading library: ocaml-compiler-libs.shadow 130 + Number of children: 0 131 + Found child: toplevel 132 + Reading library: ocaml-compiler-libs.toplevel 52 133 Number of children: 0 53 134 Parsed uri: lib/base/META 54 135 Reading library: base
+1 -2
test/node/node_directive_test.ml
··· 112 112 Server.list_envs (IdlM.T.lift list_envs); 113 113 Server.setup (IdlM.T.lift setup); 114 114 Server.exec execute; 115 - Server.typecheck typecheck_phrase; 116 115 Server.complete_prefix complete_prefix; 117 116 Server.query_errors query_errors; 118 117 Server.type_enclosing type_enclosing; ··· 150 149 let ( let* ) = IdlM.ErrM.bind in 151 150 152 151 let init_config = 153 - { stdlib_dcs = None; findlib_requires = []; execute = true } 152 + { stdlib_dcs = None; findlib_requires = []; findlib_index = None; execute = true } 154 153 in 155 154 156 155 let test_sequence =
+81
test/node/node_env_test.expected
··· 2 2 3 3 node_env_test.js: [INFO] init() 4 4 Initializing findlib 5 + Parsed uri: lib/stdlib-shims/META 6 + Reading library: stdlib-shims 7 + Number of children: 0 5 8 Parsed uri: lib/sexplib0/META 6 9 Reading library: sexplib0 7 10 Number of children: 0 11 + Parsed uri: lib/ppxlib/META 12 + Reading library: ppxlib 13 + Number of children: 11 14 + Found child: __private__ 15 + Reading library: ppxlib.__private__ 16 + Number of children: 1 17 + Found child: ppx_foo_deriver 18 + Reading library: ppxlib.__private__.ppx_foo_deriver 19 + Number of children: 0 20 + Found child: ast 21 + Reading library: ppxlib.ast 22 + Number of children: 0 23 + Found child: astlib 24 + Reading library: ppxlib.astlib 25 + Number of children: 0 26 + Found child: metaquot 27 + Reading library: ppxlib.metaquot 28 + Number of children: 0 29 + Found child: metaquot_lifters 30 + Reading library: ppxlib.metaquot_lifters 31 + Number of children: 0 32 + Found child: print_diff 33 + Reading library: ppxlib.print_diff 34 + Number of children: 0 35 + Found child: runner 36 + Reading library: ppxlib.runner 37 + Number of children: 0 38 + Found child: runner_as_ppx 39 + Reading library: ppxlib.runner_as_ppx 40 + Number of children: 0 41 + Found child: stdppx 42 + Reading library: ppxlib.stdppx 43 + Number of children: 0 44 + Found child: traverse 45 + Reading library: ppxlib.traverse 46 + Number of children: 0 47 + Found child: traverse_builtins 48 + Reading library: ppxlib.traverse_builtins 49 + Number of children: 0 8 50 Parsed uri: lib/ppx_deriving/META 9 51 Reading library: ppx_deriving 10 52 Number of children: 12 ··· 44 86 Found child: std 45 87 Reading library: ppx_deriving.std 46 88 Number of children: 0 89 + Parsed uri: lib/ppx_derivers/META 90 + Reading library: ppx_derivers 91 + Number of children: 0 47 92 Parsed uri: lib/ocaml_intrinsics_kernel/META 48 93 Reading library: ocaml_intrinsics_kernel 49 94 Number of children: 0 50 95 Parsed uri: lib/ocaml/stdlib/META 51 96 Reading library: stdlib 97 + Number of children: 0 98 + Parsed uri: lib/ocaml/compiler-libs/META 99 + Reading library: compiler-libs 100 + Number of children: 5 101 + Found child: common 102 + Reading library: compiler-libs.common 103 + Number of children: 0 104 + Found child: bytecomp 105 + Reading library: compiler-libs.bytecomp 106 + Number of children: 0 107 + Found child: optcomp 108 + Reading library: compiler-libs.optcomp 109 + Number of children: 0 110 + Found child: toplevel 111 + Reading library: compiler-libs.toplevel 112 + Number of children: 0 113 + Found child: native-toplevel 114 + Reading library: compiler-libs.native-toplevel 115 + Number of children: 0 116 + Parsed uri: lib/ocaml-compiler-libs/META 117 + Reading library: ocaml-compiler-libs 118 + Number of children: 5 119 + Found child: bytecomp 120 + Reading library: ocaml-compiler-libs.bytecomp 121 + Number of children: 0 122 + Found child: common 123 + Reading library: ocaml-compiler-libs.common 124 + Number of children: 0 125 + Found child: optcomp 126 + Reading library: ocaml-compiler-libs.optcomp 127 + Number of children: 0 128 + Found child: shadow 129 + Reading library: ocaml-compiler-libs.shadow 130 + Number of children: 0 131 + Found child: toplevel 132 + Reading library: ocaml-compiler-libs.toplevel 52 133 Number of children: 0 53 134 Parsed uri: lib/base/META 54 135 Reading library: base
+1 -2
test/node/node_env_test.ml
··· 97 97 Server.list_envs (IdlM.T.lift list_envs); 98 98 Server.setup (IdlM.T.lift setup); 99 99 Server.exec execute; 100 - Server.typecheck typecheck_phrase; 101 100 Server.complete_prefix complete_prefix; 102 101 Server.query_errors query_errors; 103 102 Server.type_enclosing type_enclosing; ··· 135 134 let ( let* ) = IdlM.ErrM.bind in 136 135 137 136 let init_config = 138 - { stdlib_dcs = None; findlib_requires = []; execute = true } 137 + { stdlib_dcs = None; findlib_requires = []; findlib_index = None; execute = true } 139 138 in 140 139 141 140 let test_sequence =
+81
test/node/node_mime_test.expected
··· 2 2 3 3 node_mime_test.js: [INFO] init() 4 4 Initializing findlib 5 + Parsed uri: lib/stdlib-shims/META 6 + Reading library: stdlib-shims 7 + Number of children: 0 5 8 Parsed uri: lib/sexplib0/META 6 9 Reading library: sexplib0 7 10 Number of children: 0 11 + Parsed uri: lib/ppxlib/META 12 + Reading library: ppxlib 13 + Number of children: 11 14 + Found child: __private__ 15 + Reading library: ppxlib.__private__ 16 + Number of children: 1 17 + Found child: ppx_foo_deriver 18 + Reading library: ppxlib.__private__.ppx_foo_deriver 19 + Number of children: 0 20 + Found child: ast 21 + Reading library: ppxlib.ast 22 + Number of children: 0 23 + Found child: astlib 24 + Reading library: ppxlib.astlib 25 + Number of children: 0 26 + Found child: metaquot 27 + Reading library: ppxlib.metaquot 28 + Number of children: 0 29 + Found child: metaquot_lifters 30 + Reading library: ppxlib.metaquot_lifters 31 + Number of children: 0 32 + Found child: print_diff 33 + Reading library: ppxlib.print_diff 34 + Number of children: 0 35 + Found child: runner 36 + Reading library: ppxlib.runner 37 + Number of children: 0 38 + Found child: runner_as_ppx 39 + Reading library: ppxlib.runner_as_ppx 40 + Number of children: 0 41 + Found child: stdppx 42 + Reading library: ppxlib.stdppx 43 + Number of children: 0 44 + Found child: traverse 45 + Reading library: ppxlib.traverse 46 + Number of children: 0 47 + Found child: traverse_builtins 48 + Reading library: ppxlib.traverse_builtins 49 + Number of children: 0 8 50 Parsed uri: lib/ppx_deriving/META 9 51 Reading library: ppx_deriving 10 52 Number of children: 12 ··· 44 86 Found child: std 45 87 Reading library: ppx_deriving.std 46 88 Number of children: 0 89 + Parsed uri: lib/ppx_derivers/META 90 + Reading library: ppx_derivers 91 + Number of children: 0 47 92 Parsed uri: lib/ocaml_intrinsics_kernel/META 48 93 Reading library: ocaml_intrinsics_kernel 49 94 Number of children: 0 50 95 Parsed uri: lib/ocaml/stdlib/META 51 96 Reading library: stdlib 97 + Number of children: 0 98 + Parsed uri: lib/ocaml/compiler-libs/META 99 + Reading library: compiler-libs 100 + Number of children: 5 101 + Found child: common 102 + Reading library: compiler-libs.common 103 + Number of children: 0 104 + Found child: bytecomp 105 + Reading library: compiler-libs.bytecomp 106 + Number of children: 0 107 + Found child: optcomp 108 + Reading library: compiler-libs.optcomp 109 + Number of children: 0 110 + Found child: toplevel 111 + Reading library: compiler-libs.toplevel 112 + Number of children: 0 113 + Found child: native-toplevel 114 + Reading library: compiler-libs.native-toplevel 115 + Number of children: 0 116 + Parsed uri: lib/ocaml-compiler-libs/META 117 + Reading library: ocaml-compiler-libs 118 + Number of children: 5 119 + Found child: bytecomp 120 + Reading library: ocaml-compiler-libs.bytecomp 121 + Number of children: 0 122 + Found child: common 123 + Reading library: ocaml-compiler-libs.common 124 + Number of children: 0 125 + Found child: optcomp 126 + Reading library: ocaml-compiler-libs.optcomp 127 + Number of children: 0 128 + Found child: shadow 129 + Reading library: ocaml-compiler-libs.shadow 130 + Number of children: 0 131 + Found child: toplevel 132 + Reading library: ocaml-compiler-libs.toplevel 52 133 Number of children: 0 53 134 Parsed uri: lib/base/META 54 135 Reading library: base
+1 -2
test/node/node_mime_test.ml
··· 99 99 Server.list_envs (IdlM.T.lift list_envs); 100 100 Server.setup (IdlM.T.lift setup); 101 101 Server.exec execute; 102 - Server.typecheck typecheck_phrase; 103 102 Server.complete_prefix complete_prefix; 104 103 Server.query_errors query_errors; 105 104 Server.type_enclosing type_enclosing; ··· 131 130 let ( let* ) = IdlM.ErrM.bind in 132 131 133 132 let init_config = 134 - { stdlib_dcs = None; findlib_requires = []; execute = true } 133 + { stdlib_dcs = None; findlib_requires = []; findlib_index = None; execute = true } 135 134 in 136 135 137 136 let test_sequence =
+118 -3
test/node/node_ppx_test.expected
··· 2 2 3 3 node_ppx_test.js: [INFO] init() 4 4 Initializing findlib 5 + Parsed uri: lib/stdlib-shims/META 6 + Reading library: stdlib-shims 7 + Number of children: 0 5 8 Parsed uri: lib/sexplib0/META 6 9 Reading library: sexplib0 7 10 Number of children: 0 11 + Parsed uri: lib/ppxlib/META 12 + Reading library: ppxlib 13 + Number of children: 11 14 + Found child: __private__ 15 + Reading library: ppxlib.__private__ 16 + Number of children: 1 17 + Found child: ppx_foo_deriver 18 + Reading library: ppxlib.__private__.ppx_foo_deriver 19 + Number of children: 0 20 + Found child: ast 21 + Reading library: ppxlib.ast 22 + Number of children: 0 23 + Found child: astlib 24 + Reading library: ppxlib.astlib 25 + Number of children: 0 26 + Found child: metaquot 27 + Reading library: ppxlib.metaquot 28 + Number of children: 0 29 + Found child: metaquot_lifters 30 + Reading library: ppxlib.metaquot_lifters 31 + Number of children: 0 32 + Found child: print_diff 33 + Reading library: ppxlib.print_diff 34 + Number of children: 0 35 + Found child: runner 36 + Reading library: ppxlib.runner 37 + Number of children: 0 38 + Found child: runner_as_ppx 39 + Reading library: ppxlib.runner_as_ppx 40 + Number of children: 0 41 + Found child: stdppx 42 + Reading library: ppxlib.stdppx 43 + Number of children: 0 44 + Found child: traverse 45 + Reading library: ppxlib.traverse 46 + Number of children: 0 47 + Found child: traverse_builtins 48 + Reading library: ppxlib.traverse_builtins 49 + Number of children: 0 8 50 Parsed uri: lib/ppx_deriving/META 9 51 Reading library: ppx_deriving 10 52 Number of children: 12 ··· 44 86 Found child: std 45 87 Reading library: ppx_deriving.std 46 88 Number of children: 0 89 + Parsed uri: lib/ppx_derivers/META 90 + Reading library: ppx_derivers 91 + Number of children: 0 47 92 Parsed uri: lib/ocaml_intrinsics_kernel/META 48 93 Reading library: ocaml_intrinsics_kernel 49 94 Number of children: 0 50 95 Parsed uri: lib/ocaml/stdlib/META 51 96 Reading library: stdlib 52 97 Number of children: 0 98 + Parsed uri: lib/ocaml/compiler-libs/META 99 + Reading library: compiler-libs 100 + Number of children: 5 101 + Found child: common 102 + Reading library: compiler-libs.common 103 + Number of children: 0 104 + Found child: bytecomp 105 + Reading library: compiler-libs.bytecomp 106 + Number of children: 0 107 + Found child: optcomp 108 + Reading library: compiler-libs.optcomp 109 + Number of children: 0 110 + Found child: toplevel 111 + Reading library: compiler-libs.toplevel 112 + Number of children: 0 113 + Found child: native-toplevel 114 + Reading library: compiler-libs.native-toplevel 115 + Number of children: 0 116 + Parsed uri: lib/ocaml-compiler-libs/META 117 + Reading library: ocaml-compiler-libs 118 + Number of children: 5 119 + Found child: bytecomp 120 + Reading library: ocaml-compiler-libs.bytecomp 121 + Number of children: 0 122 + Found child: common 123 + Reading library: ocaml-compiler-libs.common 124 + Number of children: 0 125 + Found child: optcomp 126 + Reading library: ocaml-compiler-libs.optcomp 127 + Number of children: 0 128 + Found child: shadow 129 + Reading library: ocaml-compiler-libs.shadow 130 + Number of children: 0 131 + Found child: toplevel 132 + Reading library: ocaml-compiler-libs.toplevel 133 + Number of children: 0 53 134 Parsed uri: lib/base/META 54 135 Reading library: base 55 136 Number of children: 3 ··· 74 155 error while evaluating #disable "shortvar";; 75 156 node_ppx_test.js: [INFO] Setup complete 76 157 node_ppx_test.js: [INFO] setup() finished for env default 77 - /home/node/.opam/default/lib/ppx_deriving/runtime: added to search path 78 - Loading ppx_deriving.runtime: OK 158 + --- Loading PPX dynamically --- 159 + node_ppx_test.js: [INFO] Custom #require: loading ppx_deriving.show 160 + Loading package ppx_deriving.show 161 + lib.dir: show 162 + Loading package ppx_deriving.runtime 163 + lib.dir: runtime 164 + uri: lib/ppx_deriving/runtime/dynamic_cmis.json 165 + importScripts: lib/ppx_deriving/runtime/ppx_deriving_runtime.cma.js 166 + Finished loading package ppx_deriving.runtime 167 + Loading package ppx_deriving 168 + lib.dir: None 169 + uri: lib/ppx_deriving/dynamic_cmis.json 170 + Failed to unmarshal dynamic_cms from url lib/ppx_deriving/dynamic_cmis.json: Failed to fetch dynamic cmis 171 + uri: lib/ppx_deriving/show/dynamic_cmis.json 172 + importScripts: lib/ppx_deriving/show/ppx_deriving_show.cma.js 173 + Finished loading package ppx_deriving.show 174 + node_ppx_test.js: [INFO] Adding toplevel modules for dynamic cmis from lib/ppx_deriving/show/ 175 + node_ppx_test.js: [INFO] toplevel modules: Ppx_deriving_show 176 + node_ppx_test.js: [INFO] Adding toplevel modules for dynamic cmis from lib/ppx_deriving/runtime/ 177 + node_ppx_test.js: [INFO] toplevel modules: Ppx_deriving_runtime 178 + node_ppx_test.js: [INFO] Custom #require: ppx_deriving.show loaded 179 + [PASS] load_ppx_show: ppx_deriving.show loaded 180 + node_ppx_test.js: [INFO] Custom #require: loading ppx_deriving.eq 181 + Loading package ppx_deriving.eq 182 + lib.dir: eq 183 + Loading package ppx_deriving 184 + lib.dir: None 185 + uri: lib/ppx_deriving/dynamic_cmis.json 186 + Failed to unmarshal dynamic_cms from url lib/ppx_deriving/dynamic_cmis.json: Failed to fetch dynamic cmis 187 + uri: lib/ppx_deriving/eq/dynamic_cmis.json 188 + importScripts: lib/ppx_deriving/eq/ppx_deriving_eq.cma.js 189 + Finished loading package ppx_deriving.eq 190 + node_ppx_test.js: [INFO] Adding toplevel modules for dynamic cmis from lib/ppx_deriving/eq/ 191 + node_ppx_test.js: [INFO] toplevel modules: Ppx_deriving_eq 192 + node_ppx_test.js: [INFO] Custom #require: ppx_deriving.eq loaded 193 + [PASS] load_ppx_eq: ppx_deriving.eq loaded 79 194 80 195 --- Section 1: ppx_deriving.show --- 81 196 [PASS] show_type_defined: type color defined ··· 131 246 Hint: Did you mean M.show? 132 247 [PASS] module_show_works: # M.show_t M.A;; 133 248 134 - === Results: 23/23 tests passed === 249 + === Results: 25/25 tests passed === 135 250 SUCCESS: All PPX tests passed!
+14 -6
test/node/node_ppx_test.ml
··· 98 98 Server.list_envs (IdlM.T.lift list_envs); 99 99 Server.setup (IdlM.T.lift setup); 100 100 Server.exec execute; 101 - Server.typecheck typecheck_phrase; 102 101 Server.complete_prefix complete_prefix; 103 102 Server.query_errors query_errors; 104 103 Server.type_enclosing type_enclosing; ··· 134 133 let ( let* ) = IdlM.ErrM.bind in 135 134 136 135 let init_config = 137 - { stdlib_dcs = None; findlib_requires = []; execute = true } 136 + { stdlib_dcs = None; findlib_requires = []; findlib_index = None; execute = true } 138 137 in 139 138 140 139 let test_sequence = ··· 142 141 let* _ = Client.init rpc init_config in 143 142 let* _ = Client.setup rpc "" in 144 143 145 - (* Load ppx_deriving.runtime so generated code can reference it *) 146 - let* r = run_toplevel rpc "#require \"ppx_deriving.runtime\";;" in 147 - Printf.printf "Loading ppx_deriving.runtime: %s\n%!" 148 - (if contains r "Error" then "FAILED" else "OK"); 144 + Printf.printf "--- Loading PPX dynamically ---\n%!"; 145 + 146 + (* Dynamically load ppx_deriving.show - this should: 147 + 1. Load the PPX deriver (registers with ppxlib) 148 + 2. Auto-load ppx_deriving.runtime (via findlibish -ppx_driver predicate) *) 149 + let* r = run_toplevel rpc "#require \"ppx_deriving.show\";;" in 150 + test "load_ppx_show" (not (contains r "Error")) 151 + (if contains r "Error" then r else "ppx_deriving.show loaded"); 152 + 153 + (* Also load eq deriver *) 154 + let* r = run_toplevel rpc "#require \"ppx_deriving.eq\";;" in 155 + test "load_ppx_eq" (not (contains r "Error")) 156 + (if contains r "Error" then r else "ppx_deriving.eq loaded"); 149 157 150 158 Printf.printf "\n--- Section 1: ppx_deriving.show ---\n%!"; 151 159
+86
test/node/node_test.expected
··· 1 1 node_test.js: [INFO] init() 2 2 Initializing findlib 3 3 node_test.js: [INFO] async_get: _opam/findlib_index 4 + node_test.js: [INFO] async_get: _opam/lib/stdlib-shims/META 4 5 node_test.js: [INFO] async_get: _opam/lib/sexplib0/META 6 + node_test.js: [INFO] async_get: _opam/lib/ppxlib/META 5 7 node_test.js: [INFO] async_get: _opam/lib/ppx_deriving/META 8 + node_test.js: [INFO] async_get: _opam/lib/ppx_derivers/META 6 9 node_test.js: [INFO] async_get: _opam/lib/ocaml_intrinsics_kernel/META 7 10 node_test.js: [INFO] async_get: _opam/lib/ocaml/stdlib/META 11 + node_test.js: [INFO] async_get: _opam/lib/ocaml/compiler-libs/META 12 + node_test.js: [INFO] async_get: _opam/lib/ocaml-compiler-libs/META 8 13 node_test.js: [INFO] async_get: _opam/lib/base/META 14 + Parsed uri: lib/stdlib-shims/META 15 + Reading library: stdlib-shims 16 + Number of children: 0 9 17 Parsed uri: lib/sexplib0/META 10 18 Reading library: sexplib0 11 19 Number of children: 0 20 + Parsed uri: lib/ppxlib/META 21 + Reading library: ppxlib 22 + Number of children: 11 23 + Found child: __private__ 24 + Reading library: ppxlib.__private__ 25 + Number of children: 1 26 + Found child: ppx_foo_deriver 27 + Reading library: ppxlib.__private__.ppx_foo_deriver 28 + Number of children: 0 29 + Found child: ast 30 + Reading library: ppxlib.ast 31 + Number of children: 0 32 + Found child: astlib 33 + Reading library: ppxlib.astlib 34 + Number of children: 0 35 + Found child: metaquot 36 + Reading library: ppxlib.metaquot 37 + Number of children: 0 38 + Found child: metaquot_lifters 39 + Reading library: ppxlib.metaquot_lifters 40 + Number of children: 0 41 + Found child: print_diff 42 + Reading library: ppxlib.print_diff 43 + Number of children: 0 44 + Found child: runner 45 + Reading library: ppxlib.runner 46 + Number of children: 0 47 + Found child: runner_as_ppx 48 + Reading library: ppxlib.runner_as_ppx 49 + Number of children: 0 50 + Found child: stdppx 51 + Reading library: ppxlib.stdppx 52 + Number of children: 0 53 + Found child: traverse 54 + Reading library: ppxlib.traverse 55 + Number of children: 0 56 + Found child: traverse_builtins 57 + Reading library: ppxlib.traverse_builtins 58 + Number of children: 0 12 59 Parsed uri: lib/ppx_deriving/META 13 60 Reading library: ppx_deriving 14 61 Number of children: 12 ··· 48 95 Found child: std 49 96 Reading library: ppx_deriving.std 50 97 Number of children: 0 98 + Parsed uri: lib/ppx_derivers/META 99 + Reading library: ppx_derivers 100 + Number of children: 0 51 101 Parsed uri: lib/ocaml_intrinsics_kernel/META 52 102 Reading library: ocaml_intrinsics_kernel 53 103 Number of children: 0 54 104 Parsed uri: lib/ocaml/stdlib/META 55 105 Reading library: stdlib 106 + Number of children: 0 107 + Parsed uri: lib/ocaml/compiler-libs/META 108 + Reading library: compiler-libs 109 + Number of children: 5 110 + Found child: common 111 + Reading library: compiler-libs.common 112 + Number of children: 0 113 + Found child: bytecomp 114 + Reading library: compiler-libs.bytecomp 115 + Number of children: 0 116 + Found child: optcomp 117 + Reading library: compiler-libs.optcomp 118 + Number of children: 0 119 + Found child: toplevel 120 + Reading library: compiler-libs.toplevel 121 + Number of children: 0 122 + Found child: native-toplevel 123 + Reading library: compiler-libs.native-toplevel 124 + Number of children: 0 125 + Parsed uri: lib/ocaml-compiler-libs/META 126 + Reading library: ocaml-compiler-libs 127 + Number of children: 5 128 + Found child: bytecomp 129 + Reading library: ocaml-compiler-libs.bytecomp 130 + Number of children: 0 131 + Found child: common 132 + Reading library: ocaml-compiler-libs.common 133 + Number of children: 0 134 + Found child: optcomp 135 + Reading library: ocaml-compiler-libs.optcomp 136 + Number of children: 0 137 + Found child: shadow 138 + Reading library: ocaml-compiler-libs.shadow 139 + Number of children: 0 140 + Found child: toplevel 141 + Reading library: ocaml-compiler-libs.toplevel 56 142 Number of children: 0 57 143 Parsed uri: lib/base/META 58 144 Reading library: base
+1 -2
test/node/node_test.ml
··· 88 88 Server.list_envs (IdlM.T.lift list_envs); 89 89 Server.setup (IdlM.T.lift setup); 90 90 Server.exec execute; 91 - Server.typecheck typecheck_phrase; 92 91 Server.complete_prefix complete_prefix; 93 92 Server.query_errors query_errors; 94 93 Server.type_enclosing type_enclosing; ··· 103 102 let ( let* ) = IdlM.ErrM.bind in 104 103 let init_config = 105 104 Js_top_worker_rpc.Toplevel_api_gen. 106 - { stdlib_dcs = None; findlib_requires = [ "base" ]; execute = true } 105 + { stdlib_dcs = None; findlib_requires = [ "base" ]; findlib_index = None; execute = true } 107 106 in 108 107 let x = 109 108 let open Client in
+1 -2
test/unix/unix_test.ml
··· 104 104 Server.list_envs (IdlM.T.lift list_envs); 105 105 Server.setup (IdlM.T.lift setup); 106 106 Server.exec execute; 107 - Server.typecheck typecheck_phrase; 108 107 Server.complete_prefix complete_prefix; 109 108 Server.query_errors query_errors; 110 109 Server.type_enclosing type_enclosing; ··· 129 128 let ( let* ) = IdlM.ErrM.bind in 130 129 let init = 131 130 Js_top_worker_rpc.Toplevel_api_gen. 132 - { stdlib_dcs = None; findlib_requires = []; execute = true } 131 + { stdlib_dcs = None; findlib_requires = []; findlib_index = None; execute = true } 133 132 in 134 133 let x = 135 134 let rec run notebook =