split jsoo toplevel into web-worker

asset/toplevel.css

@@ -1,15 +1,13 @@
 #toplevel-container {
-  color: #ccc;
   overflow: auto;
   overflow-x: hidden;
 }
 
 #toplevel-container textarea {
   width: 90%;
   line-height: 18px;
-  font-size: 12px;
+  font-size: 14px;
   background-color: transparent;
-  color: #fff;
   border: 0;
   resize: none;
   outline: none;
@@ -22,25 +20,24 @@
 
 #toplevel-container #output {
   background-color: transparent;
-  color: #ccc;
   border: none;
   line-height: 18px;
-  font-size: 12px;
+  font-size: 14px;
   margin-bottom: 0px;
 }
 
 #toplevel-container #sharp {
   float: left;
   line-height: 18px;
-  font-size: 12px;
+  font-size: 14px;
   font-family: Menlo, Monaco, Consolas, monospace;
   white-space: pre;
 }
 
 #toplevel-container .sharp:before {
   content: "# ";
   line-height: 18px;
-  font-size: 12px;
+  font-size: 14px;
   font-family: Menlo, Monaco, Consolas, monospace;
 }
 

dune-project

@@ -61,6 +61,7 @@
   timedesc
   yojson
   lwt
+  brr
   (js_of_ocaml
    (>= 3.11.0))
   (js_of_ocaml-ppx

ocamlorg.opam

@@ -37,6 +37,7 @@ depends: [
   "timedesc"
   "yojson"
   "lwt"
+  "brr"
   "js_of_ocaml" {>= "3.11.0"}
   "js_of_ocaml-ppx" {>= "3.11.0"}
   "js_of_ocaml-compiler" {>= "3.11.0"}

src/ocamlorg/lib/config.ml

@@ -19,7 +19,7 @@ let opam_repository_path =
   |> Option.map (fun x -> Result.get_ok (Fpath.of_string x))
   |> Option.value ~default:Fpath.(default_cache_dir / "opam-repository")
 
-let topelevels_path =
+let toplevels_path =
   Sys.getenv_opt "OCAMLORG_TOPLEVELS_PATH"
   |> Option.map (fun x -> Result.get_ok (Fpath.of_string x))
   |> Option.value ~default:Fpath.(v "src" / "ocamlorg_toplevel" / "bin" / "js")

src/ocamlorg/lib/config.mli

@@ -6,6 +6,6 @@ val documentation_url : string
 
 val opam_repository_path : Fpath.t
 
-val topelevels_path : Fpath.t
-
 val package_state_path : Fpath.t
+
+val toplevels_path : Fpath.t

src/ocamlorg/lib/ocamlorg.ml

@@ -1,4 +1,4 @@
 module Opam_user = Opam_user
 module Package = Package
 
-let topelevels_path = Config.topelevels_path
+let toplevels_path = Config.toplevels_path

src/ocamlorg/lib/ocamlorg.mli

@@ -3,6 +3,6 @@
 module Opam_user = Opam_user
 module Package = Package
 
-val topelevels_path : Fpath.t
+val toplevels_path : Fpath.t
 (** The path where the toplevel scripts are located. Delete when they are served
     from a CDN. *)

src/ocamlorg/lib/package.ml

@@ -425,7 +425,7 @@ let toplevel t =
   let name = Name.to_string t.name in
   let version = Version.to_string t.version in
   let path =
-    Fpath.(to_string (Config.topelevels_path / (name ^ "-" ^ version ^ ".js")))
+    Fpath.(to_string (Config.toplevels_path / (name ^ "-" ^ version ^ ".js")))
   in
   if Sys.file_exists path then
     Some (topelevel_url name version)

src/ocamlorg_toplevel/bin/dune

@@ -4,9 +4,7 @@
  (name toplevel_base)
  (libraries ocamlorg_toplevel base)
  (modules toplevel_base)
- (flags
-  (:standard -rectypes -linkall))
- (modes byte))
+ (modes js))
 
 (rule
  (targets export_base.txt)
@@ -15,7 +13,7 @@
   (run jsoo_listunits -o %{targets} stdlib base)))
 
 (rule
- (targets toplevel_base.js)
+ (targets worker_base.js)
  (action
   (run
    %{bin:js_of_ocaml}
@@ -26,7 +24,7 @@
    +toplevel.js
    +dynlink.js
    +base/runtime.js
-   %{dep:toplevel_base.bc}
+   %{dep:worker.bc}
    -o
    %{targets})))
 
@@ -36,18 +34,33 @@
  (name toplevel_stdlib)
  (libraries ocamlorg_toplevel stdlib)
  (modules toplevel_stdlib)
- (flags
-  (:standard -rectypes -linkall))
- (modes byte))
+ (modes js))
+
+; Stdlib worker
 
 (rule
  (targets export_stdlib.txt)
  (deps toplevel_stdlib.bc)
  (action
   (run jsoo_listunits -o %{targets} stdlib)))
 
+(executable
+ (name worker)
+ (libraries
+  brr
+  ocamlorg_toplevel
+  js_of_ocaml-toplevel
+  js_of_ocaml-compiler
+  stdlib)
+ (modules worker)
+ (flags
+  (:standard -rectypes -linkall))
+ (preprocess
+  (pps js_of_ocaml-ppx))
+ (modes byte))
+
 (rule
- (targets toplevel_stdlib.js)
+ (targets worker.js)
  (action
   (run
    %{bin:js_of_ocaml}
@@ -57,17 +70,23 @@
    --pretty
    +toplevel.js
    +dynlink.js
-   %{dep:toplevel_stdlib.bc}
+   %{dep:worker.bc}
    -o
    %{targets})))
 
 (subdir
  js/
  (rule
   (alias toplevel)
-  (targets stdlib-4.13.0.js base-v0.14.1.js)
-  (deps ../toplevel_stdlib.js ../toplevel_base.js)
+  (targets stdlib-4.13.0.js worker.js worker_base.js base-v0.14.1.js)
+  (deps
+   ../toplevel_stdlib.bc.js
+   ../worker.js
+   ../worker_base.js
+   ../worker_base.js)
   (action
    (progn
-    (run jsoo_minify ../toplevel_stdlib.js -o stdlib-4.13.0.js)
-    (run jsoo_minify ../toplevel_base.js -o base-v0.14.1.js)))))
+    (run jsoo_minify ../toplevel_stdlib.bc.js -o stdlib-4.13.0.js)
+    (run jsoo_minify ../worker.js -o worker.js)
+    (run jsoo_minify ../toplevel_base.bc.js -o base-v0.14.1.js)
+    (run jsoo_minify ../worker_base.js -o worker_base.js)))))

src/ocamlorg_toplevel/bin/toplevel_base.ml

@@ -0,0 +1 @@
+let () = Ocamlorg_toplevel.Toplevel.run "/toplevels/worker_base.js"

src/ocamlorg_toplevel/bin/toplevel_stdlib.ml

@@ -0,0 +1,10 @@
+open Brr
+
+let () =
+  let button =
+    Document.find_el_by_id G.document (Jstr.v "toplevel-load") |> Option.get
+  in
+  Ev.listen
+    Ev.click
+    (fun _ -> Ocamlorg_toplevel.Toplevel.run "/toplevels/worker_base.js")
+    (El.as_target button)

src/ocamlorg_toplevel/bin/worker.ml

@@ -0,0 +1,152 @@
+open Js_of_ocaml_toplevel
+open Brr
+open Brr_io
+open Ocamlorg_toplevel.Toplevel
+
+(* OCamlorg toplevel in a web worker
+
+   This communicates with the toplevel code via simple json schema, this allows
+   the OCaml execution to not block the "main thread" keeping the page
+   responsive. *)
+
+let jstr_of_buffer v = Jstr.v @@ Buffer.contents v
+
+module Version = struct
+  type t = int list
+
+  let split_char ~sep p =
+    let len = String.length p in
+    let rec split beg cur =
+      if cur >= len then
+        if cur - beg > 0 then [ String.sub p beg (cur - beg) ] else []
+      else if sep p.[cur] then
+        String.sub p beg (cur - beg) :: split (cur + 1) (cur + 1)
+      else
+        split beg (cur + 1)
+    in
+    split 0 0
+
+  let split v =
+    match
+      split_char ~sep:(function '+' | '-' | '~' -> true | _ -> false) v
+    with
+    | [] ->
+      assert false
+    | x :: _ ->
+      List.map
+        int_of_string
+        (split_char ~sep:(function '.' -> true | _ -> false) x)
+
+  let current = split Sys.ocaml_version
+
+  let compint (a : int) b = compare a b
+
+  let rec compare v v' =
+    match v, v' with
+    | [ x ], [ y ] ->
+      compint x y
+    | [], [] ->
+      0
+    | [], y :: _ ->
+      compint 0 y
+    | x :: _, [] ->
+      compint x 0
+    | x :: xs, y :: ys ->
+      (match compint x y with 0 -> compare xs ys | n -> n)
+end
+
+let exec' s =
+  let res : bool = JsooTop.use Format.std_formatter s in
+  if not res then Format.eprintf "error while evaluating %s@." s
+
+let setup () =
+  JsooTop.initialize ();
+  Sys.interactive := false;
+  if Version.compare Version.current [ 4; 07 ] >= 0 then exec' "open Stdlib";
+  let header1 = Printf.sprintf "        %s version %%s" "OCaml" in
+  let header2 =
+    Printf.sprintf
+      "     Compiled with Js_of_ocaml version %s"
+      Js_of_ocaml.Sys_js.js_of_ocaml_version
+  in
+  exec' (Printf.sprintf "Format.printf \"%s@.\" Sys.ocaml_version;;" header1);
+  exec' (Printf.sprintf "Format.printf \"%s@.\";;" header2);
+  exec' "#enable \"pretty\";;";
+  exec' "#disable \"shortvar\";;";
+  let[@alert "-deprecated"] new_directive n k =
+    Hashtbl.add Toploop.directive_table n k
+  in
+  new_directive
+    "load_js"
+    (Toploop.Directive_string
+       (fun name -> Js_of_ocaml.Js.Unsafe.global##load_script_ name));
+  Sys.interactive := true;
+  ()
+
+let setup_printers () =
+  exec' "let _print_unit fmt (_ : 'a) : 'a = Format.pp_print_string fmt \"()\"";
+  Topdirs.dir_install_printer
+    Format.std_formatter
+    Longident.(Lident "_print_unit")
+
+let stdout_buff = Buffer.create 100
+
+let stderr_buff = Buffer.create 100
+
+let execute =
+  let code_buff = Buffer.create 100 in
+  let res_buff = Buffer.create 100 in
+  let pp_code = Format.formatter_of_buffer code_buff in
+  let pp_result = Format.formatter_of_buffer res_buff in
+  let highlighted = ref None in
+  let highlight_location loc =
+    let _file1, line1, col1 = Location.get_pos_info loc.Location.loc_start in
+    let _file2, line2, col2 = Location.get_pos_info loc.Location.loc_end in
+    highlighted := Some ((line1, col1), (line2, col2))
+  in
+  fun phrase ->
+    Buffer.clear code_buff;
+    Buffer.clear res_buff;
+    Buffer.clear stderr_buff;
+    Buffer.clear stdout_buff;
+    JsooTop.execute true ~pp_code ~highlight_location pp_result phrase;
+    Format.pp_print_flush pp_code ();
+    Format.pp_print_flush pp_result ();
+    let highlight = !highlighted in
+    let data =
+      Worker_rpc.create
+        ?highlight
+        ~stdout:(jstr_of_buffer stdout_buff)
+        ~stderr:(jstr_of_buffer stderr_buff)
+        ~sharp_ppf:(jstr_of_buffer code_buff)
+        ~caml_ppf:(jstr_of_buffer res_buff)
+        ()
+    in
+    highlighted := None;
+    let json = Worker_rpc.to_json data in
+    json
+
+let recv_from_page e =
+  let phrase = (Message.Ev.data (Ev.as_type e) : Jstr.t) in
+  match Jstr.to_string phrase with
+  | "setup" ->
+    Js_of_ocaml.Sys_js.set_channel_flusher
+      stdout
+      (Buffer.add_string stdout_buff);
+    Js_of_ocaml.Sys_js.set_channel_flusher
+      stderr
+      (Buffer.add_string stderr_buff);
+    setup ();
+    setup_printers ();
+    let data =
+      Worker_rpc.create
+        ~stdout:(jstr_of_buffer stdout_buff)
+        ~stderr:(jstr_of_buffer stderr_buff)
+        ()
+    in
+    let json = Worker_rpc.to_json data in
+    Worker.G.post json
+  | phrase ->
+    Worker.G.post (execute phrase)
+
+let () = Jv.(set global "onmessage" @@ Jv.repr recv_from_page)

src/ocamlorg_toplevel/lib/dune

@@ -1,9 +1,6 @@
 (library
  (name ocamlorg_toplevel)
  (public_name ocamlorg.toplevel)
- (libraries lwt js_of_ocaml-compiler js_of_ocaml-tyxml js_of_ocaml-toplevel)
- (flags
-  (:standard -rectypes -linkall))
- (modes byte)
+ (libraries lwt brr js_of_ocaml-tyxml)
  (preprocess
   (pps js_of_ocaml-ppx)))