this repo has no description
Initial import from monorepo
+286
+14
dune-project
+14
dune-project
···
1
+
(lang dune 3.17)
2
+
(name tessera-zarr-jsoo)
3
+
(generate_opam_files true)
4
+
(license ISC)
5
+
(package
6
+
(name tessera-zarr-jsoo)
7
+
(synopsis "Browser backend for tessera-zarr")
8
+
(depends
9
+
(ocaml (>= 5.2))
10
+
(zarr-v3 (>= 0.1))
11
+
(tessera-zarr (>= 0.1))
12
+
(js_of_ocaml (>= 5.0))
13
+
(js_of_ocaml-ppx (>= 5.0))
14
+
(lwt (>= 5.0))))
+5
lib/dune
+5
lib/dune
+52
lib/frp_async.ml
+52
lib/frp_async.ml
···
1
+
(** Bridge between Note FRP signals and Lwt async operations. *)
2
+
3
+
type 'a state =
4
+
| Idle
5
+
| Loading of string
6
+
| Ready of 'a
7
+
| Error of string
8
+
9
+
let state_eq eq a b = match a, b with
10
+
| Idle, Idle -> true
11
+
| Loading a, Loading b -> String.equal a b
12
+
| Ready a, Ready b -> eq a b
13
+
| Error a, Error b -> String.equal a b
14
+
| _ -> false
15
+
16
+
let async_bind
17
+
(type a b)
18
+
?(eq : b -> b -> bool = fun _ _ -> false)
19
+
(signal : a option Note.signal)
20
+
(f : a -> (string -> unit) -> b Lwt.t)
21
+
: b state Note.signal =
22
+
let (out_signal, set_out) = Note.S.create ~eq:(state_eq eq) Idle in
23
+
let generation = ref 0 in
24
+
(* Observe the input signal: when it changes, kick off the async work *)
25
+
let logr = Note.Logr.create (
26
+
Note.Logr.app (Note.Logr.const (fun v ->
27
+
incr generation;
28
+
let my_gen = !generation in
29
+
match v with
30
+
| None ->
31
+
set_out Idle
32
+
| Some input ->
33
+
set_out (Loading "starting...");
34
+
let progress msg =
35
+
if !generation = my_gen then
36
+
set_out (Loading msg)
37
+
in
38
+
Lwt.async (fun () ->
39
+
Lwt.catch
40
+
(fun () ->
41
+
let open Lwt.Syntax in
42
+
let+ result = f input progress in
43
+
if !generation = my_gen then
44
+
set_out (Ready result))
45
+
(fun exn ->
46
+
if !generation = my_gen then
47
+
set_out (Error (Printexc.to_string exn));
48
+
Lwt.return_unit))))
49
+
(Note.S.obs signal)
50
+
) in
51
+
Note.Logr.hold logr;
52
+
out_signal
+23
lib/frp_async.mli
+23
lib/frp_async.mli
···
1
+
(** Bridge between Note FRP signals and Lwt async operations. *)
2
+
3
+
type 'a state =
4
+
| Idle (** No input / initial state *)
5
+
| Loading of string (** Async operation in progress, with status message *)
6
+
| Ready of 'a (** Operation completed successfully *)
7
+
| Error of string (** Operation failed *)
8
+
9
+
val async_bind :
10
+
?eq:('b -> 'b -> bool) ->
11
+
'a option Note.signal ->
12
+
('a -> (string -> unit) -> 'b Lwt.t) ->
13
+
'b state Note.signal
14
+
(** [async_bind signal f] maps a signal through an async function.
15
+
16
+
When [signal] changes to [Some v], starts [f v progress] asynchronously.
17
+
[progress] can be called to update the loading status message.
18
+
The output signal transitions through [Loading msg] → [Ready result].
19
+
20
+
When [signal] changes to [None], the output is [Idle].
21
+
22
+
If [signal] changes again before [f] completes, the previous
23
+
computation's result is silently discarded (stale cancellation). *)
+121
lib/tessera_zarr_jsoo.ml
+121
lib/tessera_zarr_jsoo.ml
···
1
+
open Js_of_ocaml
2
+
3
+
(* Async HTTP fetch using XHR with Lwt promises.
4
+
Multiple shard fetches run in parallel via Lwt.join. *)
5
+
let fetch url ?off ?len () =
6
+
let xhr = XmlHttpRequest.create () in
7
+
xhr##.responseType := Js.string "arraybuffer";
8
+
xhr##_open (Js.string "GET") (Js.string url) Js._true;
9
+
(match off, len with
10
+
| Some o, Some l ->
11
+
xhr##setRequestHeader (Js.string "Range")
12
+
(Js.string (Printf.sprintf "bytes=%d-%d" o (o + l - 1)))
13
+
| None, Some l ->
14
+
(* Suffix range: last l bytes *)
15
+
xhr##setRequestHeader (Js.string "Range")
16
+
(Js.string (Printf.sprintf "bytes=-%d" l))
17
+
| _ -> ());
18
+
let (p, resolver) = Lwt.wait () in
19
+
xhr##.onload := Dom.handler (fun _ ->
20
+
let data = match xhr##.status with
21
+
| 200 | 206 ->
22
+
Js.Opt.case
23
+
(File.CoerceTo.arrayBuffer xhr##.response)
24
+
(fun () -> failwith ("Empty response from " ^ url))
25
+
(fun b -> Typed_array.String.of_arrayBuffer b)
26
+
| code ->
27
+
failwith (Printf.sprintf "HTTP %d fetching %s" code url)
28
+
in
29
+
Lwt.wakeup resolver data;
30
+
Js._false);
31
+
xhr##.onerror := Dom.handler (fun _ ->
32
+
Lwt.wakeup_exn resolver
33
+
(Failure (Printf.sprintf "XHR error fetching %s" url));
34
+
Js._false);
35
+
xhr##send Js.null;
36
+
p
37
+
38
+
(* Synchronous HTTP fetch for web worker context.
39
+
Blocks the worker thread but allows notebook cells to get results directly. *)
40
+
let fetch_sync url ?off ?len () =
41
+
let xhr = XmlHttpRequest.create () in
42
+
xhr##.responseType := Js.string "arraybuffer";
43
+
xhr##_open (Js.string "GET") (Js.string url) Js._false;
44
+
(match off, len with
45
+
| Some o, Some l ->
46
+
xhr##setRequestHeader (Js.string "Range")
47
+
(Js.string (Printf.sprintf "bytes=%d-%d" o (o + l - 1)))
48
+
| None, Some l ->
49
+
xhr##setRequestHeader (Js.string "Range")
50
+
(Js.string (Printf.sprintf "bytes=-%d" l))
51
+
| _ -> ());
52
+
xhr##send Js.null;
53
+
match xhr##.status with
54
+
| 200 | 206 ->
55
+
Lwt.return (
56
+
Js.Opt.case
57
+
(File.CoerceTo.arrayBuffer xhr##.response)
58
+
(fun () -> failwith ("Empty response from " ^ url))
59
+
(fun b -> Typed_array.String.of_arrayBuffer b))
60
+
| code ->
61
+
failwith (Printf.sprintf "HTTP %d fetching %s" code url)
62
+
63
+
(* Zstd decompressor via fzstd.js (must be loaded via importScripts).
64
+
fzstd.decompress takes a Uint8Array and returns a Uint8Array. *)
65
+
let zstd_decompress data =
66
+
let fzstd = Js.Unsafe.global##.fzstd in
67
+
if not (Js.Optdef.test fzstd) then
68
+
failwith "fzstd not loaded. Add importScripts for fzstd in setup cell.";
69
+
(* Convert OCaml string → Uint8Array *)
70
+
let input = Typed_array.Bytes.to_uint8Array (Bytes.of_string data) in
71
+
(* Call fzstd.decompress(uint8array) → uint8array *)
72
+
let output : Typed_array.uint8Array Js.t =
73
+
Js.Unsafe.meth_call fzstd "decompress"
74
+
[| Js.Unsafe.inject input |] in
75
+
(* Convert Uint8Array → OCaml string via ArrayBuffer *)
76
+
Typed_array.String.of_uint8Array output
77
+
78
+
let codecs name =
79
+
match name with
80
+
| "zstd" -> Some zstd_decompress
81
+
| _ -> None
82
+
83
+
(* Build the store URL from a base URL and year.
84
+
MegaZarr: base_url ends in ".zarr", store is just the base_url
85
+
Legacy: base_url is a directory, store is "{base_url}/{year}.zarr" *)
86
+
let store_url base_url year =
87
+
if String.length base_url > 5 &&
88
+
String.sub base_url (String.length base_url - 5) 5 = ".zarr" then
89
+
(* MegaZarr: URL already points to the store *)
90
+
base_url
91
+
else
92
+
(* Legacy per-year: append {year}.zarr *)
93
+
Printf.sprintf "%s/%d.zarr" base_url year
94
+
95
+
let open_store ?(base_url = "https://dl2.geotessera.org/zarr/v2/store.zarr")
96
+
?(year = 2024) () =
97
+
let url = store_url base_url year in
98
+
Zarr_v3.Store.open_store ~fetch ~codecs url
99
+
100
+
let fetch_region ?progress ?(base_url = "https://dl2.geotessera.org/zarr/v2/store.zarr")
101
+
?(year = 2024) bbox =
102
+
let open Lwt.Syntax in
103
+
let* store = open_store ~base_url ~year () in
104
+
Tessera_zarr.fetch_region ?progress ~year ~store bbox
105
+
106
+
(* Synchronous version for notebook cells.
107
+
Uses synchronous XHR so all Lwt promises resolve immediately. *)
108
+
let fetch_region_sync ?(base_url = "https://dl2.geotessera.org/zarr/v2/store.zarr")
109
+
?(year = 2024) bbox =
110
+
let url = store_url base_url year in
111
+
let store_lwt = Zarr_v3.Store.open_store ~fetch:fetch_sync ~codecs url in
112
+
let store = match Lwt.poll store_lwt with
113
+
| Some s -> s
114
+
| None -> failwith "Tessera_zarr_jsoo: unexpected async in store open"
115
+
in
116
+
let result_lwt = Tessera_zarr.fetch_region ~year ~store bbox in
117
+
match Lwt.poll result_lwt with
118
+
| Some v -> v
119
+
| None -> failwith "Tessera_zarr_jsoo: unexpected async in fetch_region"
120
+
121
+
module Frp_async = Frp_async
+43
lib/tessera_zarr_jsoo.mli
+43
lib/tessera_zarr_jsoo.mli
···
1
+
(** Browser backend for tessera-zarr.
2
+
3
+
{b Warning:} This library was vibe-coded with AI assistance and has not
4
+
been thoroughly reviewed or tested. Use at your own risk and expect
5
+
breaking changes.
6
+
7
+
Provides async and sync HTTP fetch with byte-range support,
8
+
convenience wrappers for opening the GeoTessera Zarr store,
9
+
and an FRP bridge for reactive notebooks.
10
+
11
+
Defaults to the MegaZarr store ([store.zarr]) which is a single
12
+
store with year as a dimension. Pass [~base_url] ending in
13
+
[".zarr"] for MegaZarr, or a directory URL for legacy per-year
14
+
stores. *)
15
+
16
+
val fetch : Zarr_v3.Store.fetch
17
+
(** Async HTTP fetch via [XMLHttpRequest] with [Range] header support. *)
18
+
19
+
val fetch_sync : Zarr_v3.Store.fetch
20
+
(** Synchronous HTTP fetch. Returns immediately-resolved {!Lwt.t}. *)
21
+
22
+
val codecs : Zarr_v3.Store.codec_registry
23
+
(** Codec registry. Currently returns [None] for all codecs. *)
24
+
25
+
val open_store : ?base_url:string -> ?year:int -> unit -> Zarr_v3.Store.store Lwt.t
26
+
(** Open the GeoTessera Zarr store (async fetch).
27
+
For MegaZarr (default), [year] selects the time dimension.
28
+
For legacy per-year stores, [year] selects which store to open. *)
29
+
30
+
val fetch_region : ?progress:(string -> unit) -> ?base_url:string -> ?year:int ->
31
+
Geotessera.bbox -> (Linalg.mat * int * int * Geotessera.bbox) Lwt.t
32
+
(** Async: opens the store and fetches embeddings for a bbox.
33
+
[progress] receives status messages during fetching.
34
+
Defaults to MegaZarr store; pass a legacy [base_url] for
35
+
backward compat. *)
36
+
37
+
val fetch_region_sync : ?base_url:string -> ?year:int ->
38
+
Geotessera.bbox -> Linalg.mat * int * int * Geotessera.bbox
39
+
(** Synchronous convenience for imperative notebook cells. *)
40
+
41
+
(** {1 FRP bridge} *)
42
+
43
+
module Frp_async = Frp_async
+28
tessera-zarr-jsoo.opam
+28
tessera-zarr-jsoo.opam
···
1
+
# This file is generated by dune, edit dune-project instead
2
+
opam-version: "2.0"
3
+
synopsis: "Browser backend for tessera-zarr"
4
+
license: "ISC"
5
+
depends: [
6
+
"dune" {>= "3.17"}
7
+
"ocaml" {>= "5.2"}
8
+
"zarr-v3" {>= "0.1"}
9
+
"tessera-zarr" {>= "0.1"}
10
+
"js_of_ocaml" {>= "5.0"}
11
+
"js_of_ocaml-ppx" {>= "5.0"}
12
+
"lwt" {>= "5.0"}
13
+
"odoc" {with-doc}
14
+
]
15
+
build: [
16
+
["dune" "subst"] {dev}
17
+
[
18
+
"dune"
19
+
"build"
20
+
"-p"
21
+
name
22
+
"-j"
23
+
jobs
24
+
"@install"
25
+
"@runtest" {with-test}
26
+
"@doc" {with-doc}
27
+
]
28
+
]