OCaml Zarr jsont codecs for v2/v3 and common conventions
refactor: simplify dtype codec to pure codec composition
Replace manual JSON AST pattern matching with codec-based decoding:
- jdec/jenc helpers: decode/encode via any jsont codec, raise jsont errors
- field_jsont: positional tuple via Jsont.list Jsont.json + jdec for each element
- structured_codec: just Jsont.list field_jsont wrapped in a trivial map
- No Jsont.String/Array/Number constructor matching anywhere in dtype
Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
+29
-61
+29
-61
src/zarr_jsont.ml
+29
-61
src/zarr_jsont.ml
···
165
165
| `Raw n -> Printf.sprintf "|V%d" n
166
166
| `Structured _ -> assert false (* structured uses array encoding *)
167
167
168
-
(* Structured dtype field: ["name", "<f4"] or ["name", "<f4", [3]] *)
169
-
let decode_shape items =
170
-
let rec aux = function
171
-
| [] -> Ok []
172
-
| Jsont.Number (f, _) :: rest ->
173
-
(match aux rest with Ok tl -> Ok (int_of_float f :: tl) | e -> e)
174
-
| _ -> Error "expected integer in shape"
175
-
in
176
-
aux items
168
+
(* Helpers for using Jsont codecs inside ~dec/~enc functions.
169
+
These raise Jsont.Error on failure, which the framework catches. *)
170
+
let jdec codec json = match Jsont.Json.decode codec json with
171
+
| Ok v -> v | Error e -> Jsont.Error.msg Jsont.Meta.none e
177
172
178
-
let decode_field self (json_items : Jsont.json list)
179
-
: (string * dtype * int list option, string) result =
180
-
let decode_dt = function
181
-
| Jsont.String (typestr, _) -> parse_typestr typestr
182
-
| Jsont.Array _ as nested ->
183
-
Jsont.Json.decode self nested
184
-
| _ -> Error "expected string or array for dtype"
185
-
in
186
-
match json_items with
187
-
| Jsont.String (name, _) :: dt_json :: rest ->
188
-
(match decode_dt dt_json with
189
-
| Error _ as e -> e
190
-
| Ok dt ->
191
-
match rest with
192
-
| [] -> Ok (name, dt, None)
193
-
| [Jsont.Array (shape_items, _)] ->
194
-
(match decode_shape shape_items with
195
-
| Ok s -> Ok (name, dt, Some s)
196
-
| Error e -> Error e)
197
-
| _ -> Error "expected optional shape array as third element")
198
-
| _ -> Error "field descriptor must start with a string name"
173
+
let jenc codec v = match Jsont.Json.encode codec v with
174
+
| Ok j -> j | Error e -> Jsont.Error.msg Jsont.Meta.none e
199
175
200
176
let rec dtype_jsont_lazy : dtype Jsont.t Lazy.t = lazy (
201
177
let self = Jsont.rec' dtype_jsont_lazy in
202
178
let simple_codec =
203
179
Jsont.of_of_string ~kind:"dtype" parse_typestr ~enc:encode_typestr
204
180
in
205
-
let encode_field (name, dt, shape_opt) =
206
-
let name_json = Jsont.Json.string name in
207
-
let dtype_json = match dt with
208
-
| `Structured _ ->
209
-
(match Jsont.Json.encode self dt with
210
-
| Ok j -> j
211
-
| Error e -> Jsont.Error.msg Jsont.Meta.none e)
212
-
| _ -> Jsont.Json.string (encode_typestr dt)
213
-
in
214
-
match shape_opt with
215
-
| None -> Jsont.Json.list [ name_json; dtype_json ]
216
-
| Some shape ->
217
-
Jsont.Json.list [ name_json; dtype_json;
218
-
Jsont.Json.list (List.map (fun n -> Jsont.Json.number (float_of_int n)) shape) ]
219
-
in
220
-
let decode_fields fields_json =
221
-
let rec aux = function
222
-
| [] -> Ok []
223
-
| Jsont.Array (items, _) :: rest ->
224
-
Result.bind (decode_field self items) (fun field ->
225
-
Result.map (fun tl -> field :: tl) (aux rest))
226
-
| _ -> Error "expected array for each field descriptor"
227
-
in
228
-
match aux fields_json with
229
-
| Ok fields -> (`Structured fields : dtype)
230
-
| Error e -> Jsont.Error.msgf Jsont.Meta.none "dtype: %s" e
181
+
(* A structured field is a JSON array: ["name", dtype] or ["name", dtype, [shape]] *)
182
+
let field_jsont =
183
+
Jsont.map ~kind:"dtype_field"
184
+
~dec:(fun items ->
185
+
let n = List.length items in
186
+
if n < 2 then
187
+
Jsont.Error.msgf Jsont.Meta.none "dtype field: need at least 2 elements";
188
+
let name = jdec Jsont.string (List.nth items 0) in
189
+
let dt = jdec self (List.nth items 1) in
190
+
let shape =
191
+
if n >= 3 then Some (jdec (Jsont.list Jsont.int) (List.nth items 2))
192
+
else None
193
+
in
194
+
(name, dt, shape))
195
+
~enc:(fun (name, dt, shape) ->
196
+
let elts = [ Jsont.Json.string name; jenc self dt ] in
197
+
match shape with
198
+
| None -> elts
199
+
| Some s -> elts @ [ jenc (Jsont.list Jsont.int) s ])
200
+
(Jsont.list Jsont.json)
231
201
in
232
202
let structured_codec =
233
203
Jsont.map ~kind:"dtype"
234
-
~dec:decode_fields
235
-
~enc:(function
236
-
| `Structured fields -> List.map encode_field fields
237
-
| _ -> assert false)
238
-
(Jsont.list Jsont.json)
204
+
~dec:(fun fields -> `Structured fields)
205
+
~enc:(function `Structured fields -> fields | _ -> assert false)
206
+
(Jsont.list field_jsont)
239
207
in
240
208
Jsont.any ~kind:"dtype"
241
209
~dec_string:simple_codec