forked from
anil.recoil.org/monopam-myspace
My aggregated monorepo of OCaml code, automaintained
tessera-zarr-jsoo: async fetch + sync fallback for notebook cells
- fetch: async XHR (Js._true) with Lwt promises for parallel shard downloads
- fetch_sync: synchronous XHR for web worker context
- fetch_region: uses async fetch, returns Lwt.t
- fetch_region_sync: uses sync fetch + Lwt.poll for notebook cells
that need immediate results
Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
+56
-22
+1
-1
tessera-zarr-jsoo/lib/dune
+1
-1
tessera-zarr-jsoo/lib/dune
+55
-21
tessera-zarr-jsoo/lib/tessera_zarr_jsoo.ml
+55
-21
tessera-zarr-jsoo/lib/tessera_zarr_jsoo.ml
···
1
1
open Js_of_ocaml
2
2
3
-
(* Synchronous XHR fetch — matches the existing Geotessera_jsoo pattern.
4
-
All Lwt promises resolve immediately, so Lwt.join degenerates to
5
-
sequential execution. This is fine for a web worker. *)
3
+
(* Async HTTP fetch using XHR with Lwt promises.
4
+
Multiple shard fetches run in parallel via Lwt.join. *)
6
5
let fetch url ?off ?len () =
7
6
let xhr = XmlHttpRequest.create () in
8
7
xhr##.responseType := Js.string "arraybuffer";
9
-
xhr##_open (Js.string "GET") (Js.string url) Js._false; (* sync! *)
8
+
xhr##_open (Js.string "GET") (Js.string url) Js._true;
10
9
(match off, len with
11
10
| Some o, Some l ->
12
11
xhr##setRequestHeader (Js.string "Range")
13
12
(Js.string (Printf.sprintf "bytes=%d-%d" o (o + l - 1)))
14
13
| _ -> ());
14
+
let (p, resolver) = Lwt.wait () in
15
+
xhr##.onload := Dom.handler (fun _ ->
16
+
let data = match xhr##.status with
17
+
| 200 | 206 ->
18
+
Js.Opt.case
19
+
(File.CoerceTo.arrayBuffer xhr##.response)
20
+
(fun () -> failwith ("Empty response from " ^ url))
21
+
(fun b -> Typed_array.String.of_arrayBuffer b)
22
+
| code ->
23
+
failwith (Printf.sprintf "HTTP %d fetching %s" code url)
24
+
in
25
+
Lwt.wakeup resolver data;
26
+
Js._false);
27
+
xhr##.onerror := Dom.handler (fun _ ->
28
+
Lwt.wakeup_exn resolver
29
+
(Failure (Printf.sprintf "XHR error fetching %s" url));
30
+
Js._false);
15
31
xhr##send Js.null;
16
-
let data = match xhr##.status with
17
-
| 200 | 206 ->
32
+
p
33
+
34
+
(* Synchronous HTTP fetch for web worker context.
35
+
Blocks the worker thread but allows notebook cells to get results directly. *)
36
+
let fetch_sync url ?off ?len () =
37
+
let xhr = XmlHttpRequest.create () in
38
+
xhr##.responseType := Js.string "arraybuffer";
39
+
xhr##_open (Js.string "GET") (Js.string url) Js._false;
40
+
(match off, len with
41
+
| Some o, Some l ->
42
+
xhr##setRequestHeader (Js.string "Range")
43
+
(Js.string (Printf.sprintf "bytes=%d-%d" o (o + l - 1)))
44
+
| _ -> ());
45
+
xhr##send Js.null;
46
+
match xhr##.status with
47
+
| 200 | 206 ->
48
+
Lwt.return (
18
49
Js.Opt.case
19
50
(File.CoerceTo.arrayBuffer xhr##.response)
20
-
(fun () -> failwith ("Failed to read response from " ^ url))
21
-
(fun b -> Typed_array.String.of_arrayBuffer b)
22
-
| code ->
23
-
failwith (Printf.sprintf "HTTP %d fetching %s" code url)
24
-
in
25
-
Lwt.return data
51
+
(fun () -> failwith ("Empty response from " ^ url))
52
+
(fun b -> Typed_array.String.of_arrayBuffer b))
53
+
| code ->
54
+
failwith (Printf.sprintf "HTTP %d fetching %s" code url)
26
55
27
56
let codecs _name = None
28
57
···
31
60
let url = Printf.sprintf "%s/%d.zarr" base_url year in
32
61
Zarr_v3.Store.open_store ~fetch ~codecs url
33
62
34
-
(* Run a synchronous Lwt computation. Works because all our fetches
35
-
are synchronous XHR, so every Lwt.t is already resolved. *)
36
-
let run_sync t =
37
-
match Lwt.poll t with
38
-
| Some v -> v
39
-
| None -> failwith "Tessera_zarr_jsoo: unexpected async operation"
40
-
41
63
let fetch_region ?(base_url = "https://dl2.geotessera.org/zarr/v1")
42
64
?(year = 2024) bbox =
43
65
let open Lwt.Syntax in
44
66
let* store = open_store ~base_url ~year () in
45
67
Tessera_zarr.fetch_region ~store bbox
46
68
47
-
let fetch_region_sync ?base_url ?year bbox =
48
-
run_sync (fetch_region ?base_url ?year bbox)
69
+
(* Synchronous version for notebook cells.
70
+
Uses synchronous XHR so all Lwt promises resolve immediately. *)
71
+
let fetch_region_sync ?(base_url = "https://dl2.geotessera.org/zarr/v1")
72
+
?(year = 2024) bbox =
73
+
let url = Printf.sprintf "%s/%d.zarr" base_url year in
74
+
let store_lwt = Zarr_v3.Store.open_store ~fetch:fetch_sync ~codecs url in
75
+
let store = match Lwt.poll store_lwt with
76
+
| Some s -> s
77
+
| None -> failwith "Tessera_zarr_jsoo: unexpected async in store open"
78
+
in
79
+
let result_lwt = Tessera_zarr.fetch_region ~store bbox in
80
+
match Lwt.poll result_lwt with
81
+
| Some v -> v
82
+
| None -> failwith "Tessera_zarr_jsoo: unexpected async in fetch_region"