Add unit tests for the Storage module.

lib/metadata.ml

@@ -247,4 +247,6 @@ module GroupMetadata = struct
 
   let update_attributes t attrs =
     {t with attributes = attrs}
+
+  let attributes t = t.attributes
 end

lib/metadata.mli

@@ -154,4 +154,8 @@ module GroupMetadata : sig
 
   val show : t -> string
   (** [show t] pretty-prints the contents of the group metadata type t. *)
+
+  val attributes : t -> Yojson.Safe.t
+  (** [attributes t] Returns a Yojson type containing user attributes assigned
+      to the zarr group represented by [t]. *)
 end

lib/node.ml

@@ -1,7 +1,7 @@
 type t =
   | Root
-  | Cons of t * name
-and name = string
+  | Cons of t * string
+  [@@deriving show]
 
 type error =
   [ `Node_invariant of string ]
@@ -85,3 +85,5 @@ let is_parent x y =
   match x, y with
   | Root, _ -> false
   | Cons (parent, _), v -> parent = v
+
+let show n = to_path n

lib/node.mli

@@ -68,3 +68,9 @@ val to_metakey : t -> string
 val is_parent : t -> t -> bool
 (** [is_parent m n] Tests if node [n] is a the immediate parent of
     node [m]. Returns [true] when the test passes and [false] otherwise. *)
+
+val show : t -> string
+(** [show n] returns a string representation of a node type. *)
+
+val pp : Format.formatter -> t -> unit
+(** [pp fmt t] pretty prints a node type value. *)

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_node.ml

@@ -17,11 +17,14 @@ let tests = [
 "creation from path string" >:: (fun _ ->
   let n = Node.of_path "/" in
   assert_bool creation_failure @@ Result.is_ok n;
-  assert_equal "/" @@ Node.to_path @@ Result.get_ok n;
+  assert_equal
+    ~printer:Node.show Node.root @@ Result.get_ok n;
   let msg = "Creation of node should not succeed" in
   List.iter
     (fun x -> assert_bool msg @@ Result.is_error x) @@
-    List.map Node.of_path [""; "na/meas"; "/some/..."; "/root/__name"; "/sd/"])
+    List.map
+      Node.of_path @@
+      [""; "na/meas"; "/some/..."; "/root/__name"; "/sd/"])
 ;
 "exploratory functions" >:: (fun _ ->
   let s = "/some/dir/moredirs/path/pname" in
@@ -31,36 +34,70 @@ let tests = [
 
   assert_equal None @@ Node.parent Node.root;
   match Node.parent n with
-  | None -> assert_bool "A non-root node must have a parent." false;
-  | Some p -> assert_equal "/some/dir/moredirs/path" @@ Node.to_path p;
+  | None ->
+    assert_failure
+      "A non-root node must have a parent.";
+  | Some p ->
+    assert_equal
+      "/some/dir/moredirs/path" @@ Node.show p;
 
-  assert_bool "" Node.(root = root);
-  assert_bool "root node cannot be equal to its child" @@ not Node.(root = n);
-  assert_bool "non-root node cannot have root as child" @@ not Node.(n = root);
+  assert_equal ~printer:Node.show Node.root Node.root;
+  assert_bool
+    "root node cannot be equal to its child" @@
+    not Node.(root = n);
+  assert_bool
+    "non-root node cannot have root as child" @@
+    not Node.(n = root);
 
   assert_equal [] @@ Node.ancestors Node.root;
   assert_equal
-    ["/"; "/some"; "/some/dir"; "/some/dir/moredirs"; "/some/dir/moredirs/path"]
-    (Node.ancestors n |> List.map Node.to_path);
+    ~printer:[%show: string list]
+    ["/"; "/some"; "/some/dir"; "/some/dir/moredirs"
+    ;"/some/dir/moredirs/path"]
+    (Node.ancestors n |> List.map Node.show);
 
   let p = Node.parent n |> Option.get in
-  assert_bool "" @@ Node.is_parent n p;
-  assert_bool "" @@ not @@ Node.is_parent Node.root n;
-  assert_bool "" @@ not @@ Node.is_parent Node.root Node.root;
+  assert_equal
+    ~printer:string_of_bool
+    true @@
+    Node.is_parent n p;
+  assert_equal
+    ~printer:string_of_bool
+    false @@
+    Node.is_parent Node.root n;
+  assert_equal
+    ~printer:string_of_bool
+    false @@
+    Node.is_parent Node.root Node.root;
 
   let exp_parents = Node.ancestors n in
-  let r, l = List.fold_left_map 
+  let r, l = List.fold_left_map
     (fun acc _ ->
       match Node.parent acc with
       | Some acc' -> acc', acc'
-      | None -> acc, acc) n exp_parents in
-  assert_bool "" (exp_parents = List.rev l);
-  assert_equal r Node.root;
+      | None -> acc, acc) n exp_parents
+  in
+  assert_equal
+    ~printer:[%show: Node.t list]
+    exp_parents @@
+    List.rev l;
+  assert_equal ~printer:Node.show r Node.root;
 
-  assert_equal "" @@ Node.to_key Node.root;
-  let exp_key = "some/dir/moredirs/path/pname" in
-  assert_equal exp_key @@ Node.to_key n;
+  assert_equal
+    ~printer:Fun.id "" @@ Node.to_key Node.root;
 
-  assert_equal "zarr.json" @@ Node.to_metakey Node.root;
-  assert_equal (exp_key ^ "/zarr.json") @@ Node.to_metakey n)
+  assert_equal
+    ~printer:Fun.id
+    "some/dir/moredirs/path/pname" @@
+    Node.to_key n;
+
+  assert_equal
+    ~printer:Fun.id
+    "zarr.json" @@
+    Node.to_metakey Node.root;
+
+  assert_equal
+    ~printer:Fun.id
+    ("some/dir/moredirs/path/pname/zarr.json") @@
+    Node.to_metakey n)
 ]