jon.recoil.org
this repo has no description
1let log fmt =
2 Format.kasprintf
3 (fun s -> Js_of_ocaml.(Console.console##log (Js.string s)))
4 fmt
5
6let map_url url =
7 let open Js_of_ocaml in
8 let global_rel_url =
9 let x : Js.js_string Js.t option =
10 Js.Unsafe.js_expr "globalThis.__global_rel_url" |> Js.Optdef.to_option
11 in
12 Option.map Js.to_string x
13 in
14 let has_scheme =
15 let len = String.length url in
16 (len >= 7 && String.sub url 0 7 = "http://") ||
17 (len >= 8 && String.sub url 0 8 = "https://")
18 in
19 match global_rel_url with
20 | _ when has_scheme -> url
21 | Some rel ->
22 (* If url starts with /, it's relative to server root - just use the scheme/host *)
23 if String.length url > 0 && url.[0] = '/' then
24 (* Extract scheme://host from rel and append url *)
25 match String.index_opt rel ':' with
26 | Some colon_idx ->
27 let after_scheme = colon_idx + 3 in (* skip "://" *)
28 (match String.index_from_opt rel after_scheme '/' with
29 | Some slash_idx -> String.sub rel 0 slash_idx ^ url
30 | None -> rel ^ url)
31 | None -> url
32 else
33 Filename.concat rel url
34 | None -> url
35
36let sync_get url =
37 let open Js_of_ocaml in
38 let url = map_url url in
39 Console.console##log (Js.string ("Fetching: " ^ url));
40 let x = XmlHttpRequest.create () in
41 x##.responseType := Js.string "arraybuffer";
42 x##_open (Js.string "GET") (Js.string url) Js._false;
43 x##send Js.null;
44 match x##.status with
45 | 200 ->
46 Js.Opt.case
47 (File.CoerceTo.arrayBuffer x##.response)
48 (fun () ->
49 Console.console##log (Js.string "Failed to receive file");
50 None)
51 (fun b -> Some (Typed_array.String.of_arrayBuffer b))
52 | _ -> None
53
54let async_get url =
55 let ( let* ) = Lwt.bind in
56 let open Js_of_ocaml in
57 let url = map_url url in
58 Console.console##log (Js.string ("Fetching: " ^ url));
59 let* frame =
60 Js_of_ocaml_lwt.XmlHttpRequest.perform_raw ~response_type:ArrayBuffer url
61 in
62 match frame.code with
63 | 200 ->
64 Lwt.return
65 (Js.Opt.case frame.content
66 (fun () -> Error (`Msg "Failed to receive file"))
67 (fun b -> Ok (Typed_array.String.of_arrayBuffer b)))
68 | _ ->
69 Lwt.return
70 (Error (`Msg (Printf.sprintf "Failed to fetch %s: %d" url frame.code)))