+149

src/zarr_jsont.ml

reviewed

··· 264 264 |> Jsont.Object.skip_unknown 265 265 |> Jsont.Object.finish 266 266 end 267 267 + 268 268 + module V2 = struct 269 269 + module Compressor = struct 270 270 + module Blosc = struct 271 271 + type t = { 272 272 + cname : string; 273 273 + clevel : int; 274 274 + shuffle : int; 275 275 + blocksize : int option; 276 276 + unknown : Jsont.json; 277 277 + } 278 278 + 279 279 + let cname t = t.cname 280 280 + let clevel t = t.clevel 281 281 + let shuffle t = t.shuffle 282 282 + let blocksize t = t.blocksize 283 283 + let unknown t = t.unknown 284 284 + 285 285 + let jsont = 286 286 + Jsont.Object.map ~kind:"Blosc" 287 287 + (fun _id cname clevel shuffle blocksize unknown -> 288 288 + { cname; clevel; shuffle; blocksize; unknown }) 289 289 + |> Jsont.Object.mem "id" Jsont.string ~enc:(fun _ -> "blosc") 290 290 + |> Jsont.Object.mem "cname" Jsont.string ~enc:(fun t -> t.cname) 291 291 + |> Jsont.Object.mem "clevel" Jsont.int ~enc:(fun t -> t.clevel) 292 292 + |> Jsont.Object.mem "shuffle" Jsont.int ~enc:(fun t -> t.shuffle) 293 293 + |> Jsont.Object.opt_mem "blocksize" Jsont.int ~enc:(fun t -> t.blocksize) 294 294 + |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun t -> t.unknown) 295 295 + |> Jsont.Object.finish 296 296 + end 297 297 + 298 298 + module Zlib = struct 299 299 + type t = { 300 300 + level : int; 301 301 + unknown : Jsont.json; 302 302 + } 303 303 + 304 304 + let level t = t.level 305 305 + let unknown t = t.unknown 306 306 + 307 307 + let jsont = 308 308 + Jsont.Object.map ~kind:"Zlib" 309 309 + (fun _id level unknown -> { level; unknown }) 310 310 + |> Jsont.Object.mem "id" Jsont.string ~enc:(fun _ -> "zlib") 311 311 + |> Jsont.Object.mem "level" Jsont.int ~enc:(fun t -> t.level) 312 312 + |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun t -> t.unknown) 313 313 + |> Jsont.Object.finish 314 314 + end 315 315 + end 316 316 + 317 317 + type compressor = [ 318 318 + | `Blosc of Compressor.Blosc.t 319 319 + | `Zlib of Compressor.Zlib.t 320 320 + | `Other of Other_codec.t 321 321 + ] 322 322 + 323 323 + let find_id mems = 324 324 + List.find_map (fun ((name, _), value) -> 325 325 + if name = "id" then 326 326 + match value with 327 327 + | Jsont.String (s, _) -> Some s 328 328 + | _ -> None 329 329 + else None) mems 330 330 + 331 331 + let compressor_jsont : compressor Jsont.t = 332 332 + Jsont.map ~kind:"V2.Compressor" 333 333 + ~dec:(fun json -> 334 334 + match json with 335 335 + | Jsont.Object (mems, _meta) -> 336 336 + let id = find_id mems in 337 337 + (match id with 338 338 + | Some "blosc" -> 339 339 + (match Jsont.Json.decode Compressor.Blosc.jsont json with 340 340 + | Ok b -> `Blosc b 341 341 + | Error e -> failwith e) 342 342 + | Some "zlib" -> 343 343 + (match Jsont.Json.decode Compressor.Zlib.jsont json with 344 344 + | Ok z -> `Zlib z 345 345 + | Error e -> failwith e) 346 346 + | _ -> 347 347 + (match Jsont.Json.decode Other_codec.jsont json with 348 348 + | Ok o -> `Other o 349 349 + | Error e -> failwith e)) 350 350 + | _ -> failwith "V2.Compressor: expected object") 351 351 + ~enc:(function 352 352 + | `Blosc b -> 353 353 + (match Jsont.Json.encode Compressor.Blosc.jsont b with 354 354 + | Ok j -> j | Error e -> failwith e) 355 355 + | `Zlib z -> 356 356 + (match Jsont.Json.encode Compressor.Zlib.jsont z with 357 357 + | Ok j -> j | Error e -> failwith e) 358 358 + | `Other o -> 359 359 + (match Jsont.Json.encode Other_codec.jsont o with 360 360 + | Ok j -> j | Error e -> failwith e)) 361 361 + Jsont.json 362 362 + 363 363 + module Filter = struct 364 364 + module Delta = struct 365 365 + type t = { 366 366 + dtype : string; 367 367 + astype : string option; 368 368 + unknown : Jsont.json; 369 369 + } 370 370 + 371 371 + let dtype t = t.dtype 372 372 + let astype t = t.astype 373 373 + let unknown t = t.unknown 374 374 + 375 375 + let jsont = 376 376 + Jsont.Object.map ~kind:"Delta" 377 377 + (fun _id dtype astype unknown -> { dtype; astype; unknown }) 378 378 + |> Jsont.Object.mem "id" Jsont.string ~enc:(fun _ -> "delta") 379 379 + |> Jsont.Object.mem "dtype" Jsont.string ~enc:(fun t -> t.dtype) 380 380 + |> Jsont.Object.opt_mem "astype" Jsont.string ~enc:(fun t -> t.astype) 381 381 + |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun t -> t.unknown) 382 382 + |> Jsont.Object.finish 383 383 + end 384 384 + end 385 385 + 386 386 + type filter = [ 387 387 + | `Delta of Filter.Delta.t 388 388 + | `Other of Other_codec.t 389 389 + ] 390 390 + 391 391 + let filter_jsont : filter Jsont.t = 392 392 + Jsont.map ~kind:"V2.Filter" 393 393 + ~dec:(fun json -> 394 394 + match json with 395 395 + | Jsont.Object (mems, _meta) -> 396 396 + let id = find_id mems in 397 397 + (match id with 398 398 + | Some "delta" -> 399 399 + (match Jsont.Json.decode Filter.Delta.jsont json with 400 400 + | Ok d -> `Delta d 401 401 + | Error e -> failwith e) 402 402 + | _ -> 403 403 + (match Jsont.Json.decode Other_codec.jsont json with 404 404 + | Ok o -> `Other o 405 405 + | Error e -> failwith e)) 406 406 + | _ -> failwith "V2.Filter: expected object") 407 407 + ~enc:(function 408 408 + | `Delta d -> 409 409 + (match Jsont.Json.encode Filter.Delta.jsont d with 410 410 + | Ok j -> j | Error e -> failwith e) 411 411 + | `Other o -> 412 412 + (match Jsont.Json.encode Other_codec.jsont o with 413 413 + | Ok j -> j | Error e -> failwith e)) 414 414 + Jsont.json 415 415 + end

+53

src/zarr_jsont.mli

reviewed

··· 72 72 val make : string -> Jsont.json option -> bool -> t 73 73 val jsont : t Jsont.t 74 74 end 75 75 + 76 76 + (** Zarr v2 compressor and filter codecs. *) 77 77 + module V2 : sig 78 78 + (** Typed sub-codecs for known v2 compressors. *) 79 79 + module Compressor : sig 80 80 + (** Blosc compressor codec. *) 81 81 + module Blosc : sig 82 82 + type t 83 83 + val cname : t -> string 84 84 + val clevel : t -> int 85 85 + val shuffle : t -> int 86 86 + val blocksize : t -> int option 87 87 + val unknown : t -> Jsont.json 88 88 + end 89 89 + 90 90 + (** Zlib compressor codec. *) 91 91 + module Zlib : sig 92 92 + type t 93 93 + val level : t -> int 94 94 + val unknown : t -> Jsont.json 95 95 + end 96 96 + end 97 97 + 98 98 + (** A v2 compressor: either a known type or a catch-all. *) 99 99 + type compressor = [ 100 100 + | `Blosc of Compressor.Blosc.t 101 101 + | `Zlib of Compressor.Zlib.t 102 102 + | `Other of Other_codec.t 103 103 + ] 104 104 + 105 105 + val compressor_jsont : compressor Jsont.t 106 106 + (** Codec for {!compressor}. Dispatches on the ["id"] field. *) 107 107 + 108 108 + (** Typed sub-codecs for known v2 filters. *) 109 109 + module Filter : sig 110 110 + (** Delta filter codec. *) 111 111 + module Delta : sig 112 112 + type t 113 113 + val dtype : t -> string 114 114 + val astype : t -> string option 115 115 + val unknown : t -> Jsont.json 116 116 + end 117 117 + end 118 118 + 119 119 + (** A v2 filter: either a known type or a catch-all. *) 120 120 + type filter = [ 121 121 + | `Delta of Filter.Delta.t 122 122 + | `Other of Other_codec.t 123 123 + ] 124 124 + 125 125 + val filter_jsont : filter Jsont.t 126 126 + (** Codec for {!filter}. Dispatches on the ["id"] field. *) 127 127 + end

+44

test/test_zarr_jsont.ml

reviewed

··· 107 107 assert (decode dt json' = s); 108 108 print_endline "test_dtype: ok" 109 109 110 110 + let test_v2_compressor () = 111 111 + let c = Zarr_jsont.V2.compressor_jsont in 112 112 + (* blosc *) 113 113 + let json = {|{"id":"blosc","cname":"lz4","clevel":5,"shuffle":1}|} in 114 114 + let v = decode c json in 115 115 + (match v with 116 116 + | `Blosc b -> 117 117 + assert (Zarr_jsont.V2.Compressor.Blosc.cname b = "lz4"); 118 118 + assert (Zarr_jsont.V2.Compressor.Blosc.clevel b = 5); 119 119 + assert (Zarr_jsont.V2.Compressor.Blosc.shuffle b = 1) 120 120 + | _ -> assert false); 121 121 + (* zlib *) 122 122 + let json = {|{"id":"zlib","level":1}|} in 123 123 + let v = decode c json in 124 124 + (match v with 125 125 + | `Zlib z -> assert (Zarr_jsont.V2.Compressor.Zlib.level z = 1) 126 126 + | _ -> assert false); 127 127 + (* unknown compressor *) 128 128 + let json = {|{"id":"lzma","preset":6}|} in 129 129 + let v = decode c json in 130 130 + (match v with 131 131 + | `Other o -> assert (Zarr_jsont.Other_codec.name o = "lzma") 132 132 + | _ -> assert false); 133 133 + print_endline "test_v2_compressor: ok" 134 134 + 135 135 + let test_v2_filter () = 136 136 + let f = Zarr_jsont.V2.filter_jsont in 137 137 + let json = {|{"id":"delta","dtype":"<f8","astype":"<f4"}|} in 138 138 + let v = decode f json in 139 139 + (match v with 140 140 + | `Delta d -> 141 141 + assert (Zarr_jsont.V2.Filter.Delta.dtype d = "<f8"); 142 142 + assert (Zarr_jsont.V2.Filter.Delta.astype d = Some "<f4") 143 143 + | _ -> assert false); 144 144 + (* unknown filter *) 145 145 + let json = {|{"id":"quantize","digits":10}|} in 146 146 + let v = decode f json in 147 147 + (match v with 148 148 + | `Other o -> assert (Zarr_jsont.Other_codec.name o = "quantize") 149 149 + | _ -> assert false); 150 150 + print_endline "test_v2_filter: ok" 151 151 + 110 152 let () = test_other_codec () 111 153 let () = test_other_ext () 112 154 let () = test_fill_value () 113 155 let () = test_dtype () 156 156 + let () = test_v2_compressor () 157 157 + let () = test_v2_filter ()