Skip to content

Commit e5caead

Browse files
zoj613zoj613
committed
Simplify error types and how to handle them.
1 parent fd68743 commit e5caead

File tree

14 files changed

+100
-146
lines changed

14 files changed

+100
-146
lines changed

‎lib/codecs/array_to_array.ml‎

Lines changed: 8 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,7 @@ type array_to_array =
77
[@@deriving show]
88

99
type error =
10-
[ `Invalid_transpose_order of dimension_order * string ]
10+
[ `Transpose_order of dimension_order * string ]
1111

1212
(* https://zarr-specs.readthedocs.io/en/latest/v3/codecs/transpose/v1.0.html *)
1313
module TransposeCodec = struct
@@ -26,29 +26,29 @@ module TransposeCodec = struct
2626
let msg =
2727
"transpose order leads to a change in encoded
2828
representation size, which is prohibited." in
29-
Result.error @@ `Invalid_transpose_order (t, msg)
29+
Result.error @@ `Transpose_order (t, msg)
3030
else
3131
Ok {decoded with shape}
3232
with
3333
| Invalid_argument _ ->
3434
let msg =
3535
"transpose order max element is larger than
3636
the decoded representation dimensionality." in
37-
Result.error @@ `Invalid_transpose_order (t, msg)
37+
Result.error @@ `Transpose_order (t, msg)
3838

3939

4040
let parse_order o =
4141
if Array.length o = 0 then
4242
let msg = "transpose order cannot be empty." in
43-
Result.error @@ `Invalid_transpose_order (o, msg)
43+
Result.error @@ `Transpose_order (o, msg)
4444
else
4545
let o' = Array.copy o in
4646
Array.fast_sort Int.compare o';
4747
if o' <> Array.init (Array.length o') Fun.id then
4848
let msg =
4949
"order must not have any repeated dimensions
5050
or negative values." in
51-
Result.error @@ `Invalid_transpose_order (o, msg)
51+
Result.error @@ `Transpose_order (o, msg)
5252
else
5353
Result.ok @@ Transpose o
5454

@@ -64,18 +64,18 @@ module TransposeCodec = struct
6464
let msg =
6565
"Transpose order must have the same length
6666
as the decoded representation's number of dims." in
67-
Result.error @@ `Invalid_transpose_order (o, msg)
67+
Result.error @@ `Transpose_order (o, msg)
6868
else if not @@ Array.for_all (fun x -> x <= max) o then
6969
let msg =
7070
"Largest value of transpose order must not be larger than
7171
then dimensionality of the decoded representation." in
72-
Result.error @@ `Invalid_transpose_order (o, msg)
72+
Result.error @@ `Transpose_order (o, msg)
7373
else
7474
Ok ()
7575

7676
let encode o x =
7777
try Ok (Ndarray.transpose ~axis:o x) with
78-
| Failure s -> Error (`Invalid_transpose_order (o, s))
78+
| Failure s -> Error (`Transpose_order (o, s))
7979

8080
let decode o x =
8181
let inv_order = Array.(make (length o) 0) in

‎lib/codecs/array_to_array.mli‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -6,7 +6,7 @@ type array_to_array =
66
| Transpose of dimension_order
77

88
type error =
9-
[ `Invalid_transpose_order of dimension_order * string ]
9+
[ `Transpose_order of dimension_order * string ]
1010

1111
val pp_array_to_array : Format.formatter -> array_to_array -> unit
1212
val show_array_to_array : array_to_array -> string

‎lib/codecs/array_to_bytes.ml‎

Lines changed: 5 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -32,12 +32,10 @@ and chain =
3232
[@@deriving show]
3333

3434
type error =
35-
[ `Bytes_encode_error of string
36-
| `Bytes_decode_error of string
37-
| `Sharding_shape_mismatch of int array * int array * string
38-
| Extensions.error
35+
[ Extensions.error
3936
| Array_to_array.error
40-
| Bytes_to_bytes.error ]
37+
| Bytes_to_bytes.error
38+
| `Sharding of int array * int array * string ]
4139

4240
(* https://zarr-specs.readthedocs.io/en/latest/v3/codecs/bytes/v1.0.html *)
4341
module BytesCodec = struct
@@ -217,8 +215,7 @@ end = struct
217215
let msg =
218216
"sharding chunk_shape length must equal the dimensionality of
219217
the decoded representaton of a shard." in
220-
Result.error @@
221-
`Sharding_shape_mismatch (t.chunk_shape, repr.shape, msg))
218+
Result.error @@ `Sharding (t.chunk_shape, repr.shape, msg))
222219
>>= fun () ->
223220
match
224221
Array.for_all2 (fun x y -> (x mod y) = 0) repr.shape t.chunk_shape
@@ -228,8 +225,7 @@ end = struct
228225
let msg =
229226
"sharding chunk_shape must evenly divide the size of the shard shape."
230227
in
231-
Result.error @@
232-
`Sharding_shape_mismatch (t.chunk_shape, repr.shape, msg)
228+
Result.error @@ `Sharding (t.chunk_shape, repr.shape, msg)
233229

234230
let compute_encoded_size input_size t =
235231
List.fold_left BytesToBytes.compute_encoded_size

‎lib/codecs/array_to_bytes.mli‎

Lines changed: 1 addition & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -27,9 +27,7 @@ type error =
2727
[ Extensions.error
2828
| Array_to_array.error
2929
| Bytes_to_bytes.error
30-
| `Bytes_encode_error of string
31-
| `Bytes_decode_error of string
32-
| `Sharding_shape_mismatch of int array * int array * string ]
30+
| `Sharding of int array * int array * string ]
3331

3432
module ArrayToBytes : sig
3533
val parse

‎lib/extensions.ml‎

Lines changed: 3 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -1,10 +1,5 @@
1-
type grid_info =
2-
{msg : string
3-
;chunk_shape : int array
4-
;array_shape : int array}
5-
61
type error =
7-
[ `Grid of grid_info ]
2+
[ `Extension of string ]
83

94
module RegularGrid = struct
105
type t = int array
@@ -15,10 +10,10 @@ module RegularGrid = struct
1510
match chunk_shape, array_shape with
1611
| c, a when Array.(length c <> length a) ->
1712
let msg = "grid chunk and array shape must have the same the length." in
18-
Result.error @@ `Grid {msg; array_shape; chunk_shape}
13+
Result.error @@ `Extension msg
1914
| c, a when Util.(max c > max a) ->
2015
let msg = "grid chunk dimension size must not be larger than array's." in
21-
Result.error @@ `Grid {msg; array_shape; chunk_shape}
16+
Result.error @@ `Extension msg
2217
| c, _ -> Ok c
2318

2419
let ceildiv x y =

‎lib/extensions.mli‎

Lines changed: 1 addition & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -1,10 +1,5 @@
1-
type grid_info =
2-
{msg : string
3-
;chunk_shape : int array
4-
;array_shape : int array}
5-
61
type error =
7-
[ `Grid of grid_info ]
2+
[ `Extension of string ]
83

94
module RegularGrid : sig
105
type t

‎lib/metadata.ml‎

Lines changed: 5 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -2,8 +2,7 @@ open Extensions
22
open Util.Result_syntax
33

44
type error =
5-
[ Extensions.error
6-
| `Json_decode of string ]
5+
[ `Metadata of string ]
76

87
module FillValue = struct
98
type t =
@@ -126,6 +125,7 @@ module ArrayMetadata = struct
126125
chunks
127126
=
128127
RegularGrid.create ~array_shape:shape chunks
128+
>>? (fun (`Extension msg) -> `Metadata msg)
129129
>>| fun chunk_grid ->
130130
{shape
131131
;codecs
@@ -223,7 +223,7 @@ module ArrayMetadata = struct
223223
| xs ->
224224
RegularGrid.of_yojson xs >>= fun grid ->
225225
RegularGrid.(create ~array_shape:shape @@ chunk_shape grid)
226-
>>? fun (`Grid {msg; _}) -> msg)
226+
>>? fun (`Extension msg) -> msg)
227227
>>= fun chunk_grid ->
228228

229229
(match member "chunk_key_encoding" x with
@@ -305,8 +305,7 @@ module ArrayMetadata = struct
305305
Yojson.Safe.to_string @@ to_yojson t
306306

307307
let decode b =
308-
of_yojson @@ Yojson.Safe.from_string b >>? fun s ->
309-
`Json_decode s
308+
of_yojson @@ Yojson.Safe.from_string b
310309

311310
let update_attributes t attrs =
312311
{t with attributes = attrs}
@@ -404,8 +403,7 @@ module GroupMetadata = struct
404403
Ok {zarr_format; node_type; attributes}
405404

406405
let decode s =
407-
of_yojson @@ Yojson.Safe.from_string s >>? fun b ->
408-
`Json_decode b
406+
of_yojson @@ Yojson.Safe.from_string s
409407

410408
let encode t =
411409
Yojson.Safe.to_string @@ to_yojson t

‎lib/metadata.mli‎

Lines changed: 4 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -6,9 +6,8 @@
66
[zarr.json] within the prefix of a group or array.*)
77

88
type error =
9-
[ Extensions.error
10-
| `Json_decode of string ]
11-
(** A type for JSON decoding errors. *)
9+
[ `Metadata of string ]
10+
(** A type for Metadata operation errors. *)
1211

1312
module FillValue : sig
1413
type t =
@@ -51,7 +50,7 @@ module ArrayMetadata : sig
5150
val encode : t -> string
5251
(** [encode t] returns a byte string representing a JSON Zarr array metadata. *)
5352

54-
val decode : string -> (t, [> error ]) result
53+
val decode : string -> (t, string) result
5554
(** [decode s] decodes a bytes string [s] into a {!ArrayMetadata.t}
5655
type, and returns an error if the decoding process fails. *)
5756

@@ -135,7 +134,7 @@ module GroupMetadata : sig
135134
val encode : t -> string
136135
(** [encode t] returns a byte string representing a JSON Zarr group metadata. *)
137136

138-
val decode : string -> (t, [> error ]) result
137+
val decode : string -> (t, string) result
139138
(** [decode s] decodes a bytes string [s] into a {!t} type, and returns
140139
an error if the decoding process fails. *)
141140

‎lib/storage/memory.ml‎

Lines changed: 3 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -1,10 +1,4 @@
1-
module HashableString = struct
2-
type t = string
3-
let hash = Hashtbl.hash
4-
let equal = String.equal
5-
end
6-
7-
module StrMap = Hashtbl.Make (HashableString)
1+
module StrMap = Util.StrMap
82

93
let create () = StrMap.create 16
104

@@ -13,7 +7,8 @@ module Impl = struct
137

148
let get t key =
159
Option.to_result
16-
~none:(`Store_read key) @@ StrMap.find_opt t key
10+
~none:(`Store_read (key ^ " not found.")) @@
11+
StrMap.find_opt t key
1712

1813
let set t key value =
1914
StrMap.replace t key value

‎lib/storage/storage.ml‎

Lines changed: 19 additions & 32 deletions
Original file line numberDiff line numberDiff line change
@@ -65,20 +65,12 @@ module Make (M : STORE) : S with type t = M.t = struct
6565
Some (ArrayNode.parent node)
6666

6767
let group_metadata node t =
68-
if not @@ group_exists t node then
69-
Result.error @@
70-
`Store_read (GroupNode.show node ^ " is not a member of this store.")
71-
else
72-
get t @@ GroupNode.to_metakey node >>= fun bytes ->
73-
GM.decode bytes
68+
get t @@ GroupNode.to_metakey node >>= fun bytes ->
69+
GM.decode bytes >>? fun msg -> `Store_read msg
7470

7571
let array_metadata node t =
76-
if not @@ array_exists t node then
77-
Result.error @@
78-
`Store_read (ArrayNode.show node ^ " is not a member of this store.")
79-
else
80-
get t @@ ArrayNode.to_metakey node >>= fun bytes ->
81-
AM.decode bytes
72+
get t @@ ArrayNode.to_metakey node >>= fun bytes ->
73+
AM.decode bytes >>? fun msg -> `Store_read msg
8274

8375
(* Assumes without checking that [metakey] is a valid node metadata key.*)
8476
let unsafe_node_type t metakey =
@@ -87,22 +79,16 @@ module Make (M : STORE) : S with type t = M.t = struct
8779
|> Util.member "node_type" |> Util.to_string
8880

8981
let find_child_nodes t node =
90-
if group_exists t node then
91-
Result.ok @@
92-
List.fold_left
93-
(fun (lacc, racc) pre ->
94-
let p = "/" ^ String.(length pre - 1 |> sub pre 0) in
95-
if unsafe_node_type t (pre ^ "zarr.json") = "array" then
96-
let x = Result.get_ok @@ ArrayNode.of_path p in
97-
x :: lacc, racc
98-
else
99-
let x = Result.get_ok @@ GroupNode.of_path p in
100-
lacc, x :: racc)
101-
([], []) (snd @@ list_dir t @@ GroupNode.to_prefix node)
102-
else
103-
let msg =
104-
GroupNode.show node ^ " is not a node in this heirarchy." in
105-
Result.error @@ `Store_read msg
82+
List.fold_left
83+
(fun (lacc, racc) pre ->
84+
let p = "/" ^ String.(length pre - 1 |> sub pre 0) in
85+
if unsafe_node_type t (pre ^ "zarr.json") = "array" then
86+
let x = Result.get_ok @@ ArrayNode.of_path p in
87+
x :: lacc, racc
88+
else
89+
let x = Result.get_ok @@ GroupNode.of_path p in
90+
lacc, x :: racc)
91+
([], []) (snd @@ list_dir t @@ GroupNode.to_prefix node)
10692

10793
let find_all_nodes t =
10894
let keys =
@@ -138,11 +124,11 @@ module Make (M : STORE) : S with type t = M.t = struct
138124
Owl_types.index array ->
139125
(a, b) Ndarray.t ->
140126
t ->
141-
(unit, [> error]) result
127+
(unit, [> error ]) result
142128
= fun node slice x t ->
143129
let open Util in
144130
get t @@ ArrayNode.to_metakey node >>= fun bytes ->
145-
AM.decode bytes >>= fun meta ->
131+
AM.decode bytes >>? (fun msg -> `Store_write msg) >>= fun meta ->
146132
(if Ndarray.shape x = Indexing.slice_shape slice @@ AM.shape meta then
147133
Ok ()
148134
else
@@ -199,7 +185,7 @@ module Make (M : STORE) : S with type t = M.t = struct
199185
= fun node slice kind t ->
200186
let open Util in
201187
get t @@ ArrayNode.to_metakey node >>= fun bytes ->
202-
AM.decode bytes >>= fun meta ->
188+
AM.decode bytes >>? (fun msg -> `Store_read msg) >>= fun meta ->
203189
(if AM.is_valid_kind meta kind then
204190
Ok ()
205191
else
@@ -245,7 +231,8 @@ module Make (M : STORE) : S with type t = M.t = struct
245231
let reshape t node shape =
246232
let mkey = ArrayNode.to_metakey node in
247233
get t mkey >>= fun bytes ->
248-
AM.decode bytes >>= fun meta ->
234+
AM.decode bytes >>? (fun msg -> `Store_write msg)
235+
>>= fun meta ->
249236
(if Array.length shape = Array.length @@ AM.shape meta then
250237
Ok ()
251238
else

0 commit comments

Comments
 (0)