jon.recoil.org
this repo has no description
1module Worker = Brr_webworkers.Worker
2open Brr
3
4type t = {
5 mutable worker : Worker.t;
6 url : string; (* wrapped data: URL *)
7 extra_load : string option;
8 mutable on_message_cb : (X_protocol.response -> unit);
9}
10
11let current_url =
12 let url = Window.location G.window in
13 let path = Jstr.to_string (Uri.path url) in
14 let url =
15 match List.rev (String.split_on_char '/' path) with
16 | [] | "" :: _ -> url
17 | _ :: rev_path -> (
18 let path = Jstr.of_string @@ String.concat "/" @@ List.rev rev_path in
19 match Uri.with_uri ~path ~query:Jstr.empty ~fragment:Jstr.empty url with
20 | Ok url -> url
21 | Error _ -> url)
22 in
23 Jstr.to_string (Uri.to_jstr url)
24
25let origin =
26 Jstr.to_string (Jv.Jstr.get (Jv.get (Window.to_jv G.window) "location") "origin")
27
28let absolute_url url =
29 if String.starts_with ~prefix:"http:" url || String.starts_with ~prefix:"https:" url
30 then url
31 else if String.starts_with ~prefix:"/" url then
32 origin ^ url
33 else current_url ^ url
34
35let wrap_url ?extra_load url =
36 let url = absolute_url url in
37 let extra =
38 match extra_load with
39 | None -> ""
40 | Some extra -> "','" ^ absolute_url extra
41 in
42 let script = "importScripts('" ^ url ^ extra ^ "');" in
43 let script = Jstr.of_string script in
44 let url =
45 match Base64.(encode (data_of_binary_jstr script)) with
46 | Ok data -> Jstr.to_string data
47 | Error _ -> assert false
48 in
49 "data:text/javascript;base64," ^ url
50
51let create_worker ?extra_load url =
52 Worker.create @@ Jstr.of_string @@ wrap_url ?extra_load url
53
54let register_listener t =
55 let fn m =
56 let m = Ev.as_type m in
57 let msg = Bytes.to_string @@ Brr_io.Message.Ev.data m in
58 t.on_message_cb (X_protocol.resp_of_string msg)
59 in
60 let _listener =
61 Ev.listen Brr_io.Message.Ev.message fn @@ Worker.as_target t.worker
62 in
63 ()
64
65let make ?extra_load url =
66 let worker = create_worker ?extra_load url in
67 let t = { worker; url; extra_load; on_message_cb = (fun _ -> ()) } in
68 t
69
70let on_message t fn =
71 t.on_message_cb <- fn;
72 register_listener t
73
74let post t msg = Worker.post t.worker (X_protocol.req_to_bytes msg)
75
76let eval ~id ~line_number t code =
77 post t (Eval (id, line_number, code))
78
79let fmt ~id t code = post t (Format (id, code))
80
81let reset t =
82 Worker.terminate t.worker;
83 t.worker <- create_worker ?extra_load:t.extra_load t.url;
84 register_listener t