Add unit tests for the Storage module.

lib/storage/filesystem.ml

@@ -27,7 +27,7 @@ module Impl = struct
         (fun ic -> Ok (In_channel.input_all ic))
     with
     | Sys_error _ | End_of_file ->
-      Error (`Store_read_error fpath)
+      Error (`Store_read fpath)
 
   let set t key value =
     let filename = key_to_fspath t key in
@@ -108,7 +108,7 @@ let open_store ?(file_perm=0o640) path =
     Ok Impl.{dirname; file_perm}
   else
     Result.error @@
-    `Store_read_error (path ^ " is not a Filesystem store.")
+    `Store_read (path ^ " is not a Filesystem store.")
 
 let open_or_create ?(file_perm=0o640) path =
   try open_store ~file_perm path with

lib/storage/interface.ml

@@ -5,7 +5,7 @@ type key = string
 type range = ByteRange of int * int option
 
 type error =
-  [ `Store_read_error of string
+  [ `Store_read of string
   | `Invalid_slice of string
   | `Invalid_kind of string
   | `Reshape_error of string
@@ -89,17 +89,21 @@ module Make (M : STORE) : S with type t = M.t = struct
   module GM = GroupMetadata
   include M
 
+  (* All nodes are explicit upon creation so just check the node's metadata key.*)
+  let is_member t node =
+    M.is_member t @@ Node.to_metakey node
+
   let rec create_group ?metadata t node =
-    match metadata, Node.to_metakey node with
-    | Some m, k -> set t k @@ GM.encode m;
-    | None, k -> set t k @@ GM.(default |> encode);
-    make_implicit_groups_explicit t node
+    if is_member t node then ()
+    else
+      (match metadata, Node.to_metakey node with
+      | Some m, k -> set t k @@ GM.encode m;
+      | None, k -> set t k @@ GM.(default |> encode));
+      make_implicit_groups_explicit t @@ Node.parent node
 
-  and make_implicit_groups_explicit t node =
-    List.iter (fun n ->
-      match get t @@ Node.to_metakey n with
-      | Ok _ -> ()
-      | Error _ -> create_group t n) @@ Node.ancestors node
+  and make_implicit_groups_explicit t = function
+    | None -> ()
+    | Some n -> create_group t n
 
   let create_array
     ?(sep=Extensions.Slash)
@@ -121,14 +125,17 @@ module Make (M : STORE) : S with type t = M.t = struct
     >>= fun codecs ->
     let meta =
       AM.create
-        ~sep ~codecs ~dimension_names ~attributes ~shape kind fill_value chunks
+        ~sep
+        ~codecs
+        ~dimension_names
+        ~attributes
+        ~shape
+        kind
+        fill_value
+        chunks
     in
     set t (Node.to_metakey node) (AM.encode meta);
-    Ok (make_implicit_groups_explicit t node)
-
-  (* All nodes are explicit upon creation so just check the node's metadata key.*)
-  let is_member t node =
-    M.is_member t @@ Node.to_metakey node
+    Ok (make_implicit_groups_explicit t @@ Node.parent node)
 
   (* Assumes without checking that [metakey] is a valid node metadata key.*)
   let unsafe_node_type t metakey =
@@ -147,38 +154,47 @@ module Make (M : STORE) : S with type t = M.t = struct
       GM.decode bytes >>= fun meta ->
       Ok (Either.right meta)
     | false, _ ->
-      Error (`Store_read_error (Node.to_path node ^ " is not a store member."))
+      Result.error @@
+      `Store_read (Node.show node ^ " is not a store member.")
 
   let group_metadata node t =
     match get_metadata node t with
-    | Ok x -> Ok (Either.find_right x |> Option.get)
+    | Ok x when Either.is_right x ->
+      Ok (Either.find_right x |> Option.get)
+    | Ok _ ->
+      Result.error @@
+      `Store_read (Node.show node ^ " is not a group node.")
     | Error _ as err -> err
 
   let array_metadata node t =
     match get_metadata node t with
-    | Ok x -> Ok (Either.find_left x |> Option.get)
+    | Ok x when Either.is_left x ->
+      Ok (Either.find_left x |> Option.get)
+    | Ok _ ->
+      Result.error @@
+      `Store_read (Node.show node ^ " is not an array node.")
     | Error _ as err -> err
 
   let find_child_nodes t node =
     match is_member t node, Node.to_metakey node with
     | true, k when unsafe_node_type t k = "group" ->
       Result.ok @@
-      List.fold_left (fun (lacc, racc) pre ->
-        match
-          Node.of_path @@
-          "/" ^ String.(length pre - 1 |> sub pre 0)
-        with
-        | Ok x ->
+      List.fold_left
+        (fun (lacc, racc) pre ->
+          let x =
+            Result.get_ok @@  (* this operation should not fail *)
+            Node.of_path @@
+            "/" ^ String.(length pre - 1 |> sub pre 0)
+          in
           if unsafe_node_type t (pre ^ "zarr.json") = "array" then
             x :: lacc, racc
           else
-            lacc, x :: racc
-        | Error _ -> lacc, racc)
+            lacc, x :: racc)
         ([], []) (snd @@ list_dir t @@ Node.to_prefix node)
     | true, _ ->
-      Error (Node.to_path node ^ " is not a group node.")
+      Error (Node.show node ^ " is not a group node.")
     | false, _ ->
-      Error (Node.to_path node ^ " is not a node in this heirarchy.")
+      Error (Node.show node ^ " is not a node in this heirarchy.")
 
   let find_all_nodes t =
     let rec aux acc p =
@@ -276,7 +292,7 @@ module Make (M : STORE) : S with type t = M.t = struct
     with
     | Assert_failure _ -> 
       Result.error @@
-      `Store_read_error "slice shape is not compatible with node's shape.")
+      `Store_read "slice shape is not compatible with node's shape.")
     >>= fun sshape ->
     let pair = 
       Array.map
@@ -312,7 +328,7 @@ module Make (M : STORE) : S with type t = M.t = struct
     (if "array" = unsafe_node_type t mkey then
       Ok ()
     else
-      Error (`Reshape_error (Node.to_path node ^ " is not an array node.")))
+      Error (`Reshape_error (Node.show node ^ " is not an array node.")))
     >>= fun () ->
     get t mkey >>= fun bytes ->
     AM.decode bytes >>= fun meta ->

lib/storage/memory.ml

@@ -11,8 +11,7 @@ module Impl = struct
 
   let get t key =
     Option.to_result
-      ~none:(`Store_read_error key) @@
-      StrMap.find_opt t key
+      ~none:(`Store_read key) @@ StrMap.find_opt t key
 
   let set t key value =
     StrMap.replace t key value

test/test_storage.ml

@@ -0,0 +1,191 @@
+open OUnit2
+open Zarr
+open Zarr.Storage
+
+module Ndarray = Owl.Dense.Ndarray.Generic
+
+let string_of_list = [%show: string list]
+
+let test_store
+  (type a) (module M : Zarr.Storage.S with type t = a) (store : a) =
+  let gnode = Node.root in
+
+  M.create_group store gnode;
+  assert_equal
+    ~printer:string_of_bool
+    true @@
+    M.is_member store gnode;
+
+  (match M.group_metadata gnode store with
+  | Ok meta ->
+    assert_equal
+      ~printer:GroupMetadata.show GroupMetadata.default meta
+  | Error _ ->
+    assert_failure
+      "group node created with default values should
+      have metadata with default values.");
+
+  M.erase_node store gnode;
+  assert_bool
+    "Cannot retrive metadata of a node not in the store." @@
+    Result.is_error @@ M.group_metadata gnode store;
+  assert_equal 
+    ~printer:[%show: Node.t list]
+    [] @@
+    M.find_all_nodes store;
+
+  let attrs = `Assoc [("questions", `String "answer")] in
+  M.create_group 
+    ~metadata:GroupMetadata.(update_attributes default attrs)
+    store
+    gnode;
+  (match M.group_metadata gnode store with
+  | Ok meta ->
+    assert_equal
+      ~printer:Yojson.Safe.show
+      attrs @@
+      GroupMetadata.attributes meta
+  | Error _ ->
+    assert_failure
+      "group node created with specified values should
+      have metadata with said values.");
+
+  let fake = Node.(gnode / "non-member") |> Result.get_ok in
+  assert_equal
+    ~printer:string_of_bool
+    false @@
+    M.is_member store fake;
+
+  let anode = Node.(gnode / "arrnode") |> Result.get_ok in
+  let r =
+    M.create_array
+      ~shape:[|100; 100; 50|]
+      ~chunks:[|10; 15; 20|]
+      Bigarray.Complex64
+      Complex.zero
+      anode
+      store
+  in
+  assert_equal (Ok ()) r;
+
+  assert_bool
+    "Cannot get group metadata from an array node" @@
+    Result.is_error @@ M.group_metadata anode store;
+
+  let slice = Owl_types.[|R [0; 20]; I 10; R []|] in
+  let expected =
+    Ndarray.create Bigarray.Complex64 [|21; 1; 50|] Complex.zero in
+  let got =
+    Result.get_ok @@
+    M.get_array anode slice Bigarray.Complex64 store in
+  assert_equal
+    ~printer:Owl_pretty.dsnda_to_string
+    expected
+    got;
+
+  let x' = Ndarray.map (fun _ -> Complex.one) got in
+  let r = M.set_array anode slice x' store in
+  assert_equal (Ok ()) r;
+  let got =
+    Result.get_ok @@
+    M.get_array anode slice Bigarray.Complex64 store
+  in
+  assert_equal ~printer:Owl_pretty.dsnda_to_string x' got;
+  assert_bool
+    "get_array can only work with the correct array kind" @@
+    Result.is_error @@ M.get_array anode slice Bigarray.Int32 store;
+  assert_bool
+    "get_array slice shape must be the same as the array's." @@
+    Result.is_error @@
+    M.get_array
+      anode
+      Owl_types.[|R [0; 20]; I 10; R []; R [] |]
+      Bigarray.Complex64
+      store;
+
+  let bad_slice = Owl_types.[|R [0; 20]; I 10; I 0|] in
+  assert_bool
+    "slice written to store must have the same
+    shape as the array to be written" @@
+    Result.is_error @@
+    M.set_array anode bad_slice x' store;
+  let bad_arr =
+    Ndarray.create Bigarray.Int32 [|21; 1; 50|] Int32.max_int in
+  assert_bool
+    "slice written to store must have the same
+    shape as the array to be written" @@
+    Result.is_error @@
+    M.set_array anode slice bad_arr store;
+
+  let child = Node.of_path "/some/child" |> Result.get_ok in
+  M.create_group store child;
+  (match M.find_child_nodes store gnode with
+  | Ok (arrays, groups) ->
+    assert_equal
+      ~printer:string_of_list
+      ["/arrnode"] @@
+      List.map Node.to_path arrays;
+    assert_equal
+      ~printer:string_of_list
+      ["/some"] @@
+      List.map Node.to_path groups
+  | Error _ ->
+    assert_failure
+      "a store with more than one node
+      should return children for a root node.");
+
+  assert_bool
+    "Array nodes cannot have children"
+    (Result.is_error @@ M.find_child_nodes store anode);
+
+  let got =
+    M.find_all_nodes store
+    |> List.map Node.show
+    |> List.fast_sort String.compare in
+  assert_equal
+    ~printer:string_of_list
+    ["/"; "/arrnode"; "/some"; "/some/child"]
+    got;
+
+  let new_shape = [|25; 32; 10|] in
+  let r = M.reshape store anode new_shape in
+  assert_equal (Ok ()) r;
+  let meta =
+    Result.get_ok @@
+    M.array_metadata anode store in
+  assert_equal
+    ~printer:[%show: int array]
+    new_shape @@
+    ArrayMetadata.shape meta;
+  assert_bool
+    "Group nodes cannot be reshaped" @@
+    Result.is_error @@ M.reshape store gnode new_shape;
+  assert_bool
+    "New shape must have the number of dims as the node." @@
+    Result.is_error @@ M.reshape store anode [|25; 10|];
+
+  assert_bool
+    "Cannot get array metadata from a group node" @@
+    Result.is_error @@ M.array_metadata gnode store;
+  assert_bool
+    "Cannot get array metadata from a node not a member of store" @@
+    Result.is_error @@ M.array_metadata fake store;
+
+  M.erase_node store anode
+
+
+let tests = [
+  "test in-memory store" >::
+    (fun _ ->
+      test_store
+        (module MemoryStore) @@ MemoryStore.create ())
+;
+  "test filesystem store" >::
+    (fun _ ->
+      let tmp_dir = Filename.get_temp_dir_name () ^ ".zarr" in
+      Sys.mkdir tmp_dir 0o777;
+      match FilesystemStore.open_or_create ~file_perm:0o777 tmp_dir with
+      | Ok s -> test_store (module FilesystemStore) s
+      | Error _ ->
+        assert_failure "FilesystemStore creation should not fail.")
+]

test/test_zarr.ml

@@ -6,6 +6,8 @@ let () =
       Test_node.tests @
       Test_indexing.tests @
       Test_metadata.tests @
-      Test_codecs.tests
+      Test_codecs.tests @
+      Test_storage.tests
+
   in
   run_test_tt_main suite