Simplify error types and how to handle them.

README.md

@@ -90,9 +90,7 @@ let config =
     ;b2b = [Crc32c]}
   ;index_location = Start};;
 let codec_chain =
-  {a2a = []
-  ;a2b = ShardingIndexed config
-  ;b2b = [Crc32c]};;
+  {a2a = []; a2b = ShardingIndexed config; b2b = []};;
 
 let shard_node = Result.get_ok @@ ArrayNode.(group_node / "another");;
 
@@ -124,7 +122,6 @@ FilesystemStore.array_exists store shard_node;;
 FilesystemStore.group_exists store group_node;;
 
 let a, g =
-  Result.get_ok @@
   FilesystemStore.find_child_nodes store group_node;;
 List.map ArrayNode.to_path a;;
 (*- : string list = ["/some/group/name"; "/some/group/another"] *)

dune-project

@@ -23,15 +23,15 @@
    dune
    (ocaml (>= 4.14.2))
    yojson
-   ppx_deriving_yojson
+   ppx_deriving
    ezgzip
-   checkseum
+   owl
    stdint
+   checkseum
    (ounit2 :with-test)
    (odoc :with-doc)
    (bisect_ppx
-     (and :dev (>= 2.5.0) :with-test))
-   owl)
+     (and :dev (>= 2.5.0) :with-test)))
  (tags
   (topics "to describe" your project)))
 

lib/codecs/array_to_array.ml

@@ -7,7 +7,7 @@ type array_to_array =
   [@@deriving show]
 
 type error =
-  [ `Invalid_transpose_order of dimension_order * string ]
+  [ `Transpose_order of dimension_order * string ]
 
 (* https://zarr-specs.readthedocs.io/en/latest/v3/codecs/transpose/v1.0.html *)
 module TransposeCodec = struct
@@ -26,29 +26,29 @@ module TransposeCodec = struct
           let msg =
             "transpose order leads to a change in encoded
             representation size, which is prohibited." in
-          Result.error @@ `Invalid_transpose_order (t, msg)
+          Result.error @@ `Transpose_order (t, msg)
         else
           Ok {decoded with shape}
       with
       | Invalid_argument _ ->
         let msg =
           "transpose order max element is larger than
           the decoded representation dimensionality." in
-        Result.error @@ `Invalid_transpose_order (t, msg)
+        Result.error @@ `Transpose_order (t, msg)
 
 
   let parse_order o =
     if Array.length o = 0 then
       let msg = "transpose order cannot be empty." in
-      Result.error @@ `Invalid_transpose_order (o, msg)
+      Result.error @@ `Transpose_order (o, msg)
     else
       let o' = Array.copy o in
       Array.fast_sort Int.compare o';
       if o' <> Array.init (Array.length o') Fun.id then
         let msg =
           "order must not have any repeated dimensions
           or negative values." in
-        Result.error @@ `Invalid_transpose_order (o, msg)
+        Result.error @@ `Transpose_order (o, msg)
       else
         Result.ok @@ Transpose o
 
@@ -64,18 +64,18 @@ module TransposeCodec = struct
       let msg =
         "Transpose order must have the same length
         as the decoded representation's number of dims." in
-      Result.error @@ `Invalid_transpose_order (o, msg)
+      Result.error @@ `Transpose_order (o, msg)
     else if not @@ Array.for_all (fun x -> x <= max) o then
       let msg =
         "Largest value of transpose order must not be larger than
         then dimensionality of the decoded representation." in
-      Result.error @@ `Invalid_transpose_order (o, msg)
+      Result.error @@ `Transpose_order (o, msg)
     else
       Ok ()
 
   let encode o x =
     try Ok (Ndarray.transpose ~axis:o x) with
-    | Failure s -> Error (`Invalid_transpose_order (o, s))
+    | Failure s -> Error (`Transpose_order (o, s))
 
   let decode o x =
     let inv_order = Array.(make (length o) 0) in

lib/codecs/array_to_array.mli

@@ -6,7 +6,7 @@ type array_to_array =
   | Transpose of dimension_order
 
 type error =
-  [ `Invalid_transpose_order of dimension_order * string ]
+  [ `Transpose_order of dimension_order * string ]
 
 val pp_array_to_array : Format.formatter -> array_to_array -> unit
 val show_array_to_array : array_to_array -> string

lib/codecs/array_to_bytes.ml

@@ -32,12 +32,10 @@ and chain =
   [@@deriving show]
 
 type error =
-  [ `Bytes_encode_error of string
-  | `Bytes_decode_error of string
-  | `Sharding_shape_mismatch of int array * int array * string
-  | Extensions.error
+  [ Extensions.error
   | Array_to_array.error
-  | Bytes_to_bytes.error ]
+  | Bytes_to_bytes.error
+  | `Sharding of int array * int array * string ]
 
 (* https://zarr-specs.readthedocs.io/en/latest/v3/codecs/bytes/v1.0.html *)
 module BytesCodec = struct
@@ -205,6 +203,15 @@ end = struct
 
   type t = shard_config  
 
+  let parse_chain repr chain =
+    List.fold_left
+      (fun acc c ->
+         acc >>= fun r ->
+         ArrayToArray.parse r c >>= fun () ->
+         ArrayToArray.compute_encoded_representation c r) (Ok repr) chain.a2a
+    >>= fun repr' ->
+    ArrayToBytes.parse repr' chain.a2b
+
   let parse 
     : type a b.
       (a, b) Util.array_repr ->
@@ -217,19 +224,20 @@ end = struct
       let msg =
         "sharding chunk_shape length must equal the dimensionality of
         the decoded representaton of a shard." in
-      Result.error @@
-      `Sharding_shape_mismatch (t.chunk_shape, repr.shape, msg))
+      Result.error @@ `Sharding (t.chunk_shape, repr.shape, msg))
     >>= fun () ->
-    match
+    (match
       Array.for_all2 (fun x y -> (x mod y) = 0) repr.shape t.chunk_shape
     with
     | true -> Ok ()
     | false ->
       let msg =
         "sharding chunk_shape must evenly divide the size of the shard shape."
       in
-      Result.error @@
-      `Sharding_shape_mismatch (t.chunk_shape, repr.shape, msg)
+      Result.error @@ `Sharding (t.chunk_shape, repr.shape, msg))
+    >>= fun () ->
+    parse_chain repr t.codecs >>= fun () ->
+    parse_chain repr t.index_codecs
 
   let compute_encoded_size input_size t =
     List.fold_left BytesToBytes.compute_encoded_size

lib/codecs/array_to_bytes.mli

@@ -27,9 +27,7 @@ type error =
   [ Extensions.error
   | Array_to_array.error
   | Bytes_to_bytes.error
-  | `Bytes_encode_error of string
-  | `Bytes_decode_error of string
-  | `Sharding_shape_mismatch of int array * int array * string ]
+  | `Sharding of int array * int array * string ]
 
 module ArrayToBytes : sig
   val parse

lib/extensions.ml

@@ -1,10 +1,5 @@
-type grid_info =
-  {msg : string
-  ;chunk_shape : int array
-  ;array_shape : int array}
-
 type error =
-  [ `Grid of grid_info ]
+  [ `Extension of string ]
 
 module RegularGrid = struct
   type t = int array
@@ -15,10 +10,10 @@ module RegularGrid = struct
     match chunk_shape, array_shape with
     | c, a when Array.(length c <> length a) ->
       let msg = "grid chunk and array shape must have the same the length." in
-      Result.error @@ `Grid {msg; array_shape; chunk_shape}
+      Result.error @@ `Extension msg
     | c, a when Util.(max c > max a) -> 
       let msg = "grid chunk dimension size must not be larger than array's." in
-      Result.error @@ `Grid {msg; array_shape; chunk_shape}
+      Result.error @@ `Extension msg
     | c, _ -> Ok c
 
   let ceildiv x y =

lib/extensions.mli

@@ -1,10 +1,5 @@
-type grid_info =
-  {msg : string
-  ;chunk_shape : int array
-  ;array_shape : int array}
-
 type error =
-  [ `Grid of grid_info ]
+  [ `Extension of string ]
 
 module RegularGrid : sig
   type t

lib/metadata.ml

@@ -2,8 +2,7 @@
 open Util.Result_syntax
 
 type error =
-  [ Extensions.error
-  | `Json_decode of string ]
+  [ `Metadata of string ]
 
 module FillValue = struct
   type t =
@@ -126,6 +125,7 @@
     chunks
     =
     RegularGrid.create ~array_shape:shape chunks
+    >>? (fun (`Extension msg) -> `Metadata msg)
     >>| fun chunk_grid ->
     {shape
     ;codecs
@@ -223,7 +223,7 @@
     | xs ->
       RegularGrid.of_yojson xs >>= fun grid -> 
       RegularGrid.(create ~array_shape:shape @@ chunk_shape grid)
-      >>? fun (`Grid {msg; _}) -> msg)
+      >>? fun (`Extension msg) -> msg)
     >>= fun chunk_grid ->
 
     (match member "chunk_key_encoding" x with 
@@ -305,8 +305,7 @@
     Yojson.Safe.to_string @@ to_yojson t
 
   let decode b = 
-    of_yojson @@ Yojson.Safe.from_string b >>? fun s ->
-    `Json_decode s
+    of_yojson @@ Yojson.Safe.from_string b
 
   let update_attributes t attrs =
     {t with attributes = attrs}
@@ -404,8 +403,7 @@
     Ok {zarr_format; node_type; attributes}
 
   let decode s = 
-    of_yojson @@ Yojson.Safe.from_string s >>? fun b ->
-    `Json_decode b
+    of_yojson @@ Yojson.Safe.from_string s
 
   let encode t =
     Yojson.Safe.to_string @@ to_yojson t

lib/metadata.mli

@@ -6,9 +6,8 @@
     [zarr.json] within the prefix of a group or array.*)
 
 type error =
-  [ Extensions.error
-  | `Json_decode of string ]
-(** A type for JSON decoding errors. *)
+  [ `Metadata of string ]
+(** A type for Metadata operation errors. *)
 
 module FillValue : sig
   type t =
@@ -51,7 +50,7 @@ module ArrayMetadata : sig
   val encode : t -> string
   (** [encode t] returns a byte string representing a JSON Zarr array metadata. *)
 
-  val decode : string -> (t, [> error ]) result
+  val decode : string -> (t, string) result
   (** [decode s] decodes a bytes string [s] into a {!ArrayMetadata.t}
       type, and returns an error if the decoding process fails. *)
 
@@ -135,7 +134,7 @@ module GroupMetadata : sig
   val encode : t -> string
   (** [encode t] returns a byte string representing a JSON Zarr group metadata. *)
 
-  val decode : string -> (t, [> error ]) result
+  val decode : string -> (t, string) result
   (** [decode s] decodes a bytes string [s] into a {!t} type, and returns
       an error if the decoding process fails. *)
 

lib/node.ml

@@ -12,7 +12,6 @@
   type t =
     | Root
     | Cons of t * string
-    [@@deriving show]
 
   let create parent name =
     if rep_ok name then
@@ -87,14 +86,16 @@
     | _, Root -> false
     | v, Cons (parent, _) -> parent = v
 
-  let show n = to_path n
+  let show = to_path
+
+  let pp fmt t =
+    Format.fprintf fmt "%s" @@ show t
 end
 
 module ArrayNode = struct
   type t =
     {parent : GroupNode.t
     ;name :  string}
-    [@@deriving show]
 
   let create parent name =
     if rep_ok name then
@@ -145,4 +146,7 @@
   let to_metakey p = to_key p ^ "/zarr.json"
 
   let show = to_path
+
+  let pp fmt t =
+    Format.fprintf fmt "%s" @@ show t
 end

lib/storage/memory.ml

@@ -1,10 +1,4 @@
-module HashableString = struct
-  type t = string
-  let hash = Hashtbl.hash
-  let equal = String.equal
-end
-
-module StrMap = Hashtbl.Make (HashableString)
+module StrMap = Util.StrMap
 
 let create () = StrMap.create 16
 
@@ -13,7 +7,8 @@ module Impl = struct
 
   let get t key =
     Option.to_result
-      ~none:(`Store_read key) @@ StrMap.find_opt t key
+      ~none:(`Store_read (key ^ " not found.")) @@
+      StrMap.find_opt t key
 
   let set t key value =
     StrMap.replace t key value