OCaml Zarr jsont codecs for v2/v3 and common conventions
feat: fill_value polymorphic variant codec
Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
+126
+75
src/zarr_jsont.ml
+75
src/zarr_jsont.ml
···
14
14
|> Jsont.Object.finish
15
15
end
16
16
17
+
type fill_value = [
18
+
| `Null
19
+
| `Bool of bool
20
+
| `Int of int64
21
+
| `Float of float
22
+
| `Complex of float * float
23
+
| `Bytes of string
24
+
]
25
+
26
+
let fill_value_jsont =
27
+
(* Decode a float from a JSON number, deciding if it should be `Int or `Float *)
28
+
let dec_number_to_fill f =
29
+
if Float.is_finite f && Float.is_integer f && f >= Int64.(to_float min_int) && f <= Int64.(to_float max_int)
30
+
then `Int (Int64.of_float f)
31
+
else `Float f
32
+
in
33
+
let number_codec =
34
+
Jsont.map ~kind:"fill_value_number"
35
+
~dec:dec_number_to_fill
36
+
~enc:(function
37
+
| `Int i -> Int64.to_float i
38
+
| `Float f -> f
39
+
| _ -> assert false)
40
+
Jsont.number
41
+
in
42
+
let string_codec =
43
+
Jsont.map ~kind:"fill_value_string"
44
+
~dec:(fun s -> match s with
45
+
| "NaN" -> `Float Float.nan
46
+
| "Infinity" -> `Float Float.infinity
47
+
| "-Infinity" -> `Float Float.neg_infinity
48
+
| _ when String.length s > 2 && s.[0] = '0' && (s.[1] = 'x' || s.[1] = 'X') ->
49
+
let i = Int64.of_string s in
50
+
`Float (Int64.to_float i)
51
+
| _ -> `Bytes s)
52
+
~enc:(function
53
+
| `Float f when Float.is_nan f -> "NaN"
54
+
| `Float f when f = Float.infinity -> "Infinity"
55
+
| `Float f when f = Float.neg_infinity -> "-Infinity"
56
+
| `Bytes s -> s
57
+
| _ -> assert false)
58
+
Jsont.string
59
+
in
60
+
(* Array codec: either complex (2 floats) or bytes (list of ints 0-255) *)
61
+
let array_codec =
62
+
Jsont.map ~kind:"fill_value_array"
63
+
~dec:(fun fs -> match fs with
64
+
| [r; i] -> `Complex (r, i)
65
+
| bs ->
66
+
let buf = Bytes.create (List.length bs) in
67
+
List.iteri (fun idx b -> Bytes.set buf idx (Char.chr (int_of_float b))) bs;
68
+
`Bytes (Bytes.to_string buf))
69
+
~enc:(function
70
+
| `Complex (r, i) -> [r; i]
71
+
| `Bytes s ->
72
+
String.to_seq s |> Seq.map (fun c -> float_of_int (Char.code c)) |> List.of_seq
73
+
| _ -> assert false)
74
+
(Jsont.list Jsont.number)
75
+
in
76
+
Jsont.any ~kind:"fill_value"
77
+
~dec_null:(Jsont.null `Null)
78
+
~dec_bool:(Jsont.map ~kind:"fill_value_bool" ~dec:(fun b -> `Bool b) ~enc:(function `Bool b -> b | _ -> assert false) Jsont.bool)
79
+
~dec_number:number_codec
80
+
~dec_string:string_codec
81
+
~dec_array:array_codec
82
+
~enc:(function
83
+
| `Null -> Jsont.null `Null
84
+
| `Bool _ -> Jsont.map ~kind:"fill_value_bool" ~dec:(fun b -> `Bool b) ~enc:(function `Bool b -> b | _ -> assert false) Jsont.bool
85
+
| `Int _ -> number_codec
86
+
| `Float f when Float.is_nan f || not (Float.is_finite f) -> string_codec
87
+
| `Float _ -> number_codec
88
+
| `Complex _ -> array_codec
89
+
| `Bytes _ -> array_codec)
90
+
()
91
+
17
92
module Other_ext = struct
18
93
type t = { name : string; configuration : Jsont.json option; must_understand : bool }
19
94
+19
src/zarr_jsont.mli
+19
src/zarr_jsont.mli
···
1
1
(** Jsont codecs for Zarr v2 and v3 metadata. *)
2
2
3
+
(** Polymorphic fill value shared between Zarr v2 and v3 array metadata.
4
+
5
+
Encodes the value stored in unwritten or missing chunks. The JSON
6
+
representation is flexible: null, boolean, integer number, floating-point
7
+
number (including the special strings ["NaN"], ["Infinity"],
8
+
["-Infinity"]), a two-element array for complex numbers, or an integer
9
+
array (0–255) for raw bytes. *)
10
+
type fill_value = [
11
+
| `Null
12
+
| `Bool of bool
13
+
| `Int of int64
14
+
| `Float of float
15
+
| `Complex of float * float
16
+
| `Bytes of string
17
+
]
18
+
19
+
val fill_value_jsont : fill_value Jsont.t
20
+
(** Codec for {!fill_value}. Dispatches on the JSON sort via {!Jsont.any}. *)
21
+
3
22
(** Catch-all type for unrecognized v2 codecs.
4
23
5
24
Represents objects with an ["id"] key plus arbitrary extra fields,
+32
test/test_zarr_jsont.ml
+32
test/test_zarr_jsont.ml
···
24
24
assert (Zarr_jsont.Other_ext.name v' = "custom.ext");
25
25
print_endline "test_other_ext: ok"
26
26
27
+
let test_fill_value () =
28
+
let fv = Zarr_jsont.fill_value_jsont in
29
+
(* null *)
30
+
let v = decode fv "null" in
31
+
assert (v = `Null);
32
+
(* bool *)
33
+
let v = decode fv "true" in
34
+
assert (v = `Bool true);
35
+
(* int *)
36
+
let v = decode fv "42" in
37
+
assert (v = `Int 42L);
38
+
(* float *)
39
+
let v = decode fv "3.14" in
40
+
(match v with `Float f -> assert (f = 3.14) | _ -> assert false);
41
+
(* NaN string *)
42
+
let v = decode fv {|"NaN"|} in
43
+
(match v with `Float f -> assert (Float.is_nan f) | _ -> assert false);
44
+
(* Infinity string *)
45
+
let v = decode fv {|"Infinity"|} in
46
+
(match v with `Float f -> assert (f = infinity) | _ -> assert false);
47
+
(* -Infinity string *)
48
+
let v = decode fv {|"-Infinity"|} in
49
+
(match v with `Float f -> assert (f = neg_infinity) | _ -> assert false);
50
+
(* complex as array *)
51
+
let v = decode fv {|[1.0, 2.0]|} in
52
+
assert (v = `Complex (1.0, 2.0));
53
+
(* bytes as int array *)
54
+
let v = decode fv {|[0, 255, 128]|} in
55
+
(match v with `Bytes s -> assert (String.length s = 3) | _ -> assert false);
56
+
print_endline "test_fill_value: ok"
57
+
27
58
let () = test_other_codec ()
28
59
let () = test_other_ext ()
60
+
let () = test_fill_value ()