diff --git a/README.md b/README.md index 0518fab6..d784c1a5 100644 --- a/README.md +++ b/README.md @@ -52,8 +52,6 @@ A similar example using the `Lwt`-backed Asynchronous API can be found [here][7] ### setup ```ocaml open Zarr -open Zarr.Metadata -open Zarr.Node open Zarr.Codecs open Zarr.Indexing open Zarr_sync.Storage @@ -64,14 +62,14 @@ let store = FilesystemStore.create "testdata.zarr";; ``` ### create group ```ocaml -let group_node = GroupNode.of_path "/some/group";; -FilesystemStore.create_group store group_node;; +let group_node = Node.Group.of_path "/some/group";; +FilesystemStore.Group.create store group_node;; ``` ### create an array ```ocaml -let array_node = ArrayNode.(group_node / "name");; +let array_node = Node.Array.(group_node / "name");; (* creates an array with char data type and fill value '?' *) -FilesystemStore.create_array +FilesystemStore.Array.create ~codecs:[`Transpose [|2; 0; 1|]; `Bytes BE; `Gzip L2] ~shape:[|100; 100; 50|] ~chunks:[|10; 15; 20|] @@ -83,11 +81,11 @@ FilesystemStore.create_array ### read/write from/to an array ```ocaml let slice = [|R [|0; 20|]; I 10; R [||]|];; -let x = FilesystemStore.read_array store array_node slice Ndarray.Char;; +let x = FilesystemStore.Array.read store array_node slice Ndarray.Char;; (* Do some computation on the array slice *) let x' = Zarr.Ndarray.map (fun _ -> Random.int 256 |> Char.chr) x;; -FilesystemStore.write_array store array_node slice x';; -let y = FilesystemStore.read_array store array_node slice Ndarray.Char;; +FilesystemStore.Array.write store array_node slice x';; +let y = FilesystemStore.Array.read store array_node slice Ndarray.Char;; assert (Ndarray.equal x' y);; ``` ### create an array with sharding @@ -98,9 +96,9 @@ let config = ;index_codecs = [`Bytes BE; `Crc32c] ;index_location = Start};; -let shard_node = ArrayNode.(group_node / "another");; +let shard_node = Node.Array.(group_node / "another");; -FilesystemStore.create_array +FilesystemStore.Array.create ~codecs:[`ShardingIndexed config] ~shape:[|100; 100; 50|] ~chunks:[|10; 15; 20|] @@ -111,30 +109,30 @@ FilesystemStore.create_array ``` ### exploratory functions ```ocaml -let a, g = FilesystemStore.find_all_nodes store;; -List.map ArrayNode.to_path a;; +let a, g = FilesystemStore.hierarchy store;; +List.map Node.Array.to_path a;; (*- : string list = ["/some/group/name"; "/some/group/another"] *) -List.map GroupNode.to_path g;; +List.map Node.Group.to_path g;; (*- : string list = ["/"; "/some"; "/some/group"] *) -FilesystemStore.reshape store array_node [|25; 32; 10|];; +FilesystemStore.Array.reshape store array_node [|25; 32; 10|];; -let meta = FilesystemStore.group_metadata store group_node;; -GroupMetadata.show meta;; (* pretty prints the contents of the metadata *) +let meta = FilesystemStore.Group.metadata store group_node;; +Metadata.Group.show meta;; (* pretty prints the contents of the metadata *) -FilesystemStore.array_exists store shard_node;; -FilesystemStore.group_exists store group_node;; +FilesystemStore.Array.exists store shard_node;; +FilesystemStore.Group.exists store group_node;; -let a, g = FilesystemStore.find_child_nodes store group_node;; -List.map ArrayNode.to_path a;; +let a, g = FilesystemStore.Group.children store group_node;; +List.map Node.Array.to_path a;; (*- : string list = ["/some/group/name"; "/some/group/another"] *) -List.map GroupNode.to_path g;; +List.map Node.Group.to_path g;; (*- : string list = [] *) -FilesystemStore.erase_group_node store group_node;; -FilesystemStore.erase_all_nodes store;; (* clears the store *) -FilesystemStore.rename_group store group_node;; -FilesystemStore.rename_array store anode;; +FilesystemStore.Group.delete store group_node;; +FilesystemStore.clear store;; (* clears the store *) +FilesystemStore.Group.rename store group_node;; +FilesystemStore.Array.rename store anode;; ``` [1]: https://codecov.io/gh/zoj613/zarr-ml/graph/badge.svg?token=KOOG2Y1SH5 diff --git a/examples/inmemory_zipstore.ml b/examples/inmemory_zipstore.ml index 193c1822..ce14ebb5 100644 --- a/examples/inmemory_zipstore.ml +++ b/examples/inmemory_zipstore.ml @@ -14,7 +14,7 @@ dune exec -- examples/inmemory_zipstore.exe in your shell at the root of this project. *) -module MemoryZipStore : sig +module ZipStore : sig include Zarr.Storage.STORE with type 'a Deferred.t = 'a Lwt.t val with_open : ?level:Zipc_deflate.level -> string -> (t -> 'a Deferred.t) -> 'a Deferred.t end = struct @@ -143,32 +143,30 @@ end = struct | Error e -> failwith e in Lwt.finalize (fun () -> f t) @@ fun () -> - Lwt_io.with_file - ~flags:Unix.[O_WRONLY; O_TRUNC; O_CREAT; O_NONBLOCK] - ~mode:Lwt_io.Output - t.path - (fun oc -> - Result.fold ~error:failwith ~ok:(Lwt_io.write oc) @@ Zipc.to_binary_string t.ic) + let flags = Unix.[O_WRONLY; O_TRUNC; O_CREAT; O_NONBLOCK] in + Lwt_io.with_file ~flags ~mode:Lwt_io.Output t.path @@ fun oc -> + Result.fold ~error:failwith ~ok:(Lwt_io.write oc) @@ Zipc.to_binary_string t.ic end let _ = Lwt_main.run @@ begin - let open Zarr.Node in + let open Zarr in + let open Zarr.Ndarray in let open Zarr.Indexing in - let open MemoryZipStore.Deferred.Syntax in + let open ZipStore.Deferred.Syntax in - MemoryZipStore.with_open "examples/data/testdata.zip" @@ fun store -> - let* xs, _ = MemoryZipStore.find_all_nodes store in + ZipStore.with_open "examples/data/testdata.zip" @@ fun store -> + let* xs, _ = ZipStore.hierarchy store in let anode = List.hd @@ List.filter - (fun node -> ArrayNode.to_path node = "/some/group/name") xs in + (fun node -> Node.Array.to_path node = "/some/group/name") xs in let slice = [|R [|0; 20|]; I 10; R [||]|] in - let* x = MemoryZipStore.read_array store anode slice Zarr.Ndarray.Char in + let* x = ZipStore.Array.read store anode slice Char in let x' = x |> Zarr.Ndarray.map @@ fun _ -> Random.int 256 |> Char.chr in - let* () = MemoryZipStore.write_array store anode slice x' in - let* y = MemoryZipStore.read_array store anode slice Zarr.Ndarray.Char in + let* () = ZipStore.Array.write store anode slice x' in + let* y = ZipStore.Array.read store anode slice Char in assert (Zarr.Ndarray.equal x' y); - let* () = MemoryZipStore.rename_array store anode "name2" in - let+ exists = MemoryZipStore.array_exists store @@ ArrayNode.of_path "/some/group/name2" in + let* () = ZipStore.Array.rename store anode "name2" in + let+ exists = ZipStore.Array.exists store @@ Node.Array.of_path "/some/group/name2" in assert exists end; - print_endline "Zip store has been update." + print_endline "Zip store has been updated." diff --git a/examples/readonly_zipstore.ml b/examples/readonly_zipstore.ml index 45867a3f..6d5dba69 100644 --- a/examples/readonly_zipstore.ml +++ b/examples/readonly_zipstore.ml @@ -5,22 +5,22 @@ raise a Not_implemented exception for the set_* and erase_* family of functions. This effectively allows us to create a read-only store since calling any of the following functions would result in error: - - ReadOnlyZipStore.create_group - - ReadOnlyZipStore.create_array - - ReadOnlyZipStore.erase_group_node - - ReadOnlyZipStore.erase_array_node - - ReadOnlyZipStore.erase_all_nodes - - ReadOnlyZipStore.write_array - - ReadOnlyZipStore.reshape - - ReadOnlyZipStore.rename_array - - ReadOnlyZipStore.rename_group + - ZipStore.create_group + - ZipStore.create_array + - ZipStore.erase_group_node + - ZipStore.erase_array_node + - ZipStore.clear + - ZipStore.write_array + - ZipStore.reshape + - ZipStore.rename_array + - ZipStore.rename_group Below we show how to implement this custom Zarr Store. To compile & run this example execute the command dune exec -- examples/zipstore.exe in your shell at the root of this project. *) -module ReadOnlyZipStore : sig +module ZipStore : sig exception Not_implemented include Zarr.Storage.STORE with type 'a Deferred.t = 'a val with_open : string -> (t -> 'a) -> 'a @@ -94,12 +94,13 @@ end let _ = Eio_main.run @@ fun _ -> - let open Zarr.Node in + let open Zarr in + let open Zarr.Ndarray in - ReadOnlyZipStore.with_open "examples/data/testdata.zip" @@ fun store -> - let xs, _ = ReadOnlyZipStore.find_all_nodes store in + ZipStore.with_open "examples/data/testdata.zip" @@ fun store -> + let xs, _ = ZipStore.hierarchy store in let anode = List.hd @@ Eio.Fiber.List.filter - (fun node -> ArrayNode.to_path node = "/some/group/name") xs in - let arr = ReadOnlyZipStore.read_array store anode [||] Zarr.Ndarray.Char in - try ReadOnlyZipStore.write_array store anode [||] arr with - | ReadOnlyZipStore.Not_implemented -> print_endline "Store is read-only" + (fun node -> Node.Array.to_path node = "/some/group/name") xs in + let arr = ZipStore.Array.read store anode [||] Char in + try ZipStore.Array.write store anode [||] arr with + | ZipStore.Not_implemented -> print_endline "Store is read-only" diff --git a/zarr-eio/test/test_eio.ml b/zarr-eio/test/test_eio.ml index 27e95957..99cf5a47 100644 --- a/zarr-eio/test/test_eio.ml +++ b/zarr-eio/test/test_eio.ml @@ -1,13 +1,11 @@ open OUnit2 open Zarr open Zarr.Indexing -open Zarr.Metadata -open Zarr.Node open Zarr.Codecs open Zarr_eio.Storage let string_of_list = [%show: string list] -let print_node_pair = [%show: ArrayNode.t list * GroupNode.t list] +let print_node_pair = [%show: Node.Array.t list * Node.Group.t list] let print_int_array = [%show : int array] module type EIO_STORE = sig @@ -17,30 +15,30 @@ end let test_storage (type a) (module M : EIO_STORE with type t = a) (store : a) = let open M in - let gnode = GroupNode.root in + let gnode = Node.Group.root in - let nodes = find_all_nodes store in + let nodes = hierarchy store in assert_equal ~printer:print_node_pair ([], []) nodes; - create_group store gnode; - let exists = group_exists store gnode in + Group.create store gnode; + let exists = Group.exists store gnode in assert_equal ~printer:string_of_bool true exists; - let meta = group_metadata store gnode in - assert_equal ~printer:GroupMetadata.show GroupMetadata.default meta; + let meta = Group.metadata store gnode in + assert_equal ~printer:Metadata.Group.show Metadata.Group.default meta; - erase_group_node store gnode; - let exists = group_exists store gnode in + Group.delete store gnode; + let exists = Group.exists store gnode in assert_equal ~printer:string_of_bool false exists; - let nodes = find_all_nodes store in + let nodes = hierarchy store in assert_equal ~printer:print_node_pair ([], []) nodes; let attrs = `Assoc [("questions", `String "answer")] in - create_group ~attrs store gnode; - let meta = group_metadata store gnode in - assert_equal ~printer:Yojson.Safe.show attrs @@ GroupMetadata.attributes meta; + Group.create ~attrs store gnode; + let meta = Group.metadata store gnode in + assert_equal ~printer:Yojson.Safe.show attrs @@ Metadata.Group.attributes meta; - let exists = array_exists store @@ ArrayNode.(gnode / "non-member") in + let exists = Array.exists store @@ Node.Array.(gnode / "non-member") in assert_equal ~printer:string_of_bool false exists; let cfg = @@ -48,72 +46,72 @@ let test_storage ;index_location = End ;index_codecs = [`Bytes BE] ;codecs = [`Bytes LE]} in - let anode = ArrayNode.(gnode / "arrnode") in + let anode = Node.Array.(gnode / "arrnode") in let slice = [|R [|0; 20|]; I 10; R [|0; 29|]|] in let exp = Ndarray.init Complex32 [|21; 1; 30|] (Fun.const Complex.one) in List.iter (fun codecs -> - create_array + Array.create ~codecs ~shape:[|100; 100; 50|] ~chunks:[|10; 15; 20|] Complex32 Complex.one anode store; - write_array store anode slice exp; - let got = read_array store anode slice Complex32 in + Array.write store anode slice exp; + let got = Array.read store anode slice Complex32 in assert_equal exp got; Ndarray.fill exp Complex.{re=2.0; im=0.}; - write_array store anode slice exp; - let got = read_array store anode slice Complex32 in + Array.write store anode slice exp; + let got = Array.read store anode slice Complex32 in assert_equal exp got; Ndarray.fill exp Complex.{re=0.; im=3.0}; - write_array store anode slice exp; - let got = read_array store anode slice Complex32 in + Array.write store anode slice exp; + let got = Array.read store anode slice Complex32 in assert_equal exp got) [[`ShardingIndexed cfg]; [`Bytes BE]]; - let child = GroupNode.of_path "/some/child/group" in - create_group store child; - let arrays, groups = find_child_nodes store gnode in + let child = Node.Group.of_path "/some/child/group" in + Group.create store child; + let arrays, groups = Group.children store gnode in assert_equal - ~printer:string_of_list ["/arrnode"] (List.map ArrayNode.to_path arrays); + ~printer:string_of_list ["/arrnode"] (List.map Node.Array.to_path arrays); assert_equal - ~printer:string_of_list ["/some"] (List.map GroupNode.to_path groups); + ~printer:string_of_list ["/some"] (List.map Node.Group.to_path groups); - let c = find_child_nodes store @@ GroupNode.(root / "fakegroup") in + let c = Group.children store @@ Node.Group.(root / "fakegroup") in assert_equal ([], []) c; - let ac, gc = find_all_nodes store in + let ac, gc = hierarchy store in let got = List.fast_sort String.compare @@ - List.map ArrayNode.show ac @ List.map GroupNode.show gc in + List.map Node.Array.show ac @ List.map Node.Group.show gc in assert_equal ~printer:string_of_list ["/"; "/arrnode"; "/some"; "/some/child"; "/some/child/group"] got; (* tests for renaming nodes *) - let some = GroupNode.of_path "/some/child" in - rename_array store anode "ARRAYNODE"; - rename_group store some "CHILD"; - let ac, gc = find_all_nodes store in + let some = Node.Group.of_path "/some/child" in + Array.rename store anode "ARRAYNODE"; + Group.rename store some "CHILD"; + let ac, gc = hierarchy store in let got = List.fast_sort String.compare @@ - List.map ArrayNode.show ac @ List.map GroupNode.show gc in + List.map Node.Array.show ac @ List.map Node.Group.show gc in assert_equal ~printer:string_of_list ["/"; "/ARRAYNODE"; "/some"; "/some/CHILD"; "/some/CHILD/group"] got; (* restore old array node name. *) - rename_array store (ArrayNode.of_path "/ARRAYNODE") "arrnode"; + Array.rename store (Node.Array.of_path "/ARRAYNODE") "arrnode"; let nshape = [|25; 32; 10|] in - reshape store anode nshape; - let meta = array_metadata store anode in - assert_equal ~printer:print_int_array nshape @@ ArrayMetadata.shape meta; + Array.reshape store anode nshape; + let meta = Array.metadata store anode in + assert_equal ~printer:print_int_array nshape @@ Metadata.Array.shape meta; assert_raises (Zarr.Storage.Key_not_found "fakegroup/zarr.json") - (fun () -> array_metadata store ArrayNode.(gnode / "fakegroup")); + (fun () -> Array.metadata store Node.Array.(gnode / "fakegroup")); - erase_array_node store anode; - erase_all_nodes store; - let got = find_all_nodes store in + Array.delete store anode; + clear store; + let got = hierarchy store in assert_equal ~printer:print_node_pair ([], []) got let _ = diff --git a/zarr-lwt/test/test_lwt.ml b/zarr-lwt/test/test_lwt.ml index b87bf5b7..164d1ea6 100644 --- a/zarr-lwt/test/test_lwt.ml +++ b/zarr-lwt/test/test_lwt.ml @@ -1,13 +1,11 @@ open OUnit2 open Zarr -open Zarr.Metadata open Zarr.Indexing -open Zarr.Node open Zarr.Codecs open Zarr_lwt.Storage let string_of_list = [%show: string list] -let print_node_pair = [%show: ArrayNode.t list * GroupNode.t list] +let print_node_pair = [%show: Node.Array.t list * Node.Group.t list] let print_int_array = [%show : int array] module type LWT_STORE = sig @@ -18,30 +16,30 @@ let test_storage (type a) (module M : LWT_STORE with type t = a) (store : a) = let open M in let open M.Deferred.Infix in - let gnode = GroupNode.root in + let gnode = Node.Group.root in - find_all_nodes store >>= fun nodes -> + hierarchy store >>= fun nodes -> assert_equal ~printer:print_node_pair ([], []) nodes; - create_group store gnode >>= fun () -> - group_exists store gnode >>= fun exists -> + Group.create store gnode >>= fun () -> + Group.exists store gnode >>= fun exists -> assert_equal ~printer:string_of_bool true exists; - group_metadata store gnode >>= fun meta -> - assert_equal ~printer:GroupMetadata.show GroupMetadata.default meta; + Group.metadata store gnode >>= fun meta -> + assert_equal ~printer:Metadata.Group.show Metadata.Group.default meta; - erase_group_node store gnode >>= fun () -> - group_exists store gnode >>= fun exists -> + Group.delete store gnode >>= fun () -> + Group.exists store gnode >>= fun exists -> assert_equal ~printer:string_of_bool false exists; - find_all_nodes store >>= fun nodes -> + hierarchy store >>= fun nodes -> assert_equal ~printer:print_node_pair ([], []) nodes; let attrs = `Assoc [("questions", `String "answer")] in - create_group ~attrs store gnode >>= fun () -> - group_metadata store gnode >>= fun meta -> - assert_equal ~printer:Yojson.Safe.show attrs @@ GroupMetadata.attributes meta; + Group.create ~attrs store gnode >>= fun () -> + Group.metadata store gnode >>= fun meta -> + assert_equal ~printer:Yojson.Safe.show attrs @@ Metadata.Group.attributes meta; - array_exists store @@ ArrayNode.(gnode / "non-member") >>= fun exists -> + Array.exists store @@ Node.Array.(gnode / "non-member") >>= fun exists -> assert_equal ~printer:string_of_bool false exists; let cfg = @@ -49,69 +47,69 @@ let test_storage ;index_location = End ;index_codecs = [`Bytes BE] ;codecs = [`Bytes LE]} in - let anode = ArrayNode.(gnode / "arrnode") in + let anode = Node.Array.(gnode / "arrnode") in let slice = [|R [|0; 20|]; I 10; R [|0; 29|]|] in let exp = Ndarray.init Ndarray.Complex32 [|21; 1; 30|] (Fun.const Complex.one) in Lwt_list.iter_s (fun codecs -> - create_array + Array.create ~codecs ~shape:[|100; 100; 50|] ~chunks:[|10; 15; 20|] Ndarray.Complex32 Complex.one anode store >>= fun () -> - write_array store anode slice exp >>= fun () -> - read_array store anode slice Complex32 >>= fun got -> + Array.write store anode slice exp >>= fun () -> + Array.read store anode slice Complex32 >>= fun got -> assert_equal exp got; Ndarray.fill exp Complex.{re=2.0; im=0.}; - write_array store anode slice exp >>= fun () -> - read_array store anode slice Complex32 >>= fun arr -> + Array.write store anode slice exp >>= fun () -> + Array.read store anode slice Complex32 >>= fun arr -> assert_equal exp arr; Ndarray.fill exp Complex.{re=0.; im=3.0}; - write_array store anode slice exp >>= fun () -> - read_array store anode slice Complex32 >>| fun got -> + Array.write store anode slice exp >>= fun () -> + Array.read store anode slice Complex32 >>| fun got -> assert_equal exp got) [[`ShardingIndexed cfg]; [`Bytes BE]] >>= fun () -> - let child = GroupNode.of_path "/some/child/group" in - create_group store child >>= fun () -> - find_child_nodes store gnode >>= fun (arrays, groups) -> + let child = Node.Group.of_path "/some/child/group" in + Group.create store child >>= fun () -> + Group.children store gnode >>= fun (arrays, groups) -> assert_equal - ~printer:string_of_list ["/arrnode"] (List.map ArrayNode.to_path arrays); + ~printer:string_of_list ["/arrnode"] (List.map Node.Array.to_path arrays); assert_equal - ~printer:string_of_list ["/some"] (List.map GroupNode.to_path groups); + ~printer:string_of_list ["/some"] (List.map Node.Group.to_path groups); - find_child_nodes store @@ GroupNode.(root / "fakegroup") >>= fun c -> + Group.children store @@ Node.Group.(root / "fakegroup") >>= fun c -> assert_equal ([], []) c; - find_all_nodes store >>= fun (ac, gc) -> + hierarchy store >>= fun (ac, gc) -> let got = List.fast_sort String.compare @@ - List.map ArrayNode.show ac @ List.map GroupNode.show gc in + List.map Node.Array.show ac @ List.map Node.Group.show gc in assert_equal ~printer:string_of_list ["/"; "/arrnode"; "/some"; "/some/child"; "/some/child/group"] got; (* tests for renaming nodes *) - let some = GroupNode.of_path "/some/child" in - rename_array store anode "ARRAYNODE" >>= fun () -> - rename_group store some "CHILD" >>= fun () -> - find_all_nodes store >>= fun (ac, gc) -> + let some = Node.Group.of_path "/some/child" in + Array.rename store anode "ARRAYNODE" >>= fun () -> + Group.rename store some "CHILD" >>= fun () -> + hierarchy store >>= fun (ac, gc) -> let got = List.fast_sort String.compare @@ - List.map ArrayNode.show ac @ List.map GroupNode.show gc in + List.map Node.Array.show ac @ List.map Node.Group.show gc in assert_equal ~printer:string_of_list ["/"; "/ARRAYNODE"; "/some"; "/some/CHILD"; "/some/CHILD/group"] got; (* restore old array node name. *) - rename_array store (ArrayNode.of_path "/ARRAYNODE") "arrnode" >>= fun () -> + Array.rename store (Node.Array.of_path "/ARRAYNODE") "arrnode" >>= fun () -> let nshape = [|25; 32; 10|] in - reshape store anode nshape >>= fun () -> - array_metadata store anode >>= fun meta -> - assert_equal ~printer:print_int_array nshape @@ ArrayMetadata.shape meta; + Array.reshape store anode nshape >>= fun () -> + Array.metadata store anode >>= fun meta -> + assert_equal ~printer:print_int_array nshape @@ Metadata.Array.shape meta; - erase_array_node store anode >>= fun () -> - erase_all_nodes store >>= fun () -> - find_all_nodes store >>= fun got -> + Array.delete store anode >>= fun () -> + clear store >>= fun () -> + hierarchy store >>= fun got -> assert_equal ~printer:print_node_pair ([], []) got; Deferred.return_unit diff --git a/zarr-sync/test/test_sync.ml b/zarr-sync/test/test_sync.ml index e11b561a..61656a2b 100644 --- a/zarr-sync/test/test_sync.ml +++ b/zarr-sync/test/test_sync.ml @@ -1,13 +1,11 @@ open OUnit2 open Zarr -open Zarr.Metadata open Zarr.Indexing -open Zarr.Node open Zarr.Codecs open Zarr_sync.Storage let string_of_list = [%show: string list] -let print_node_pair = [%show: ArrayNode.t list * GroupNode.t list] +let print_node_pair = [%show: Node.Array.t list * Node.Group.t list] let print_int_array = [%show : int array] module type SYNC_STORE = sig @@ -17,30 +15,30 @@ end let test_storage (type a) (module M : SYNC_STORE with type t = a) (store : a) = let open M in - let gnode = GroupNode.root in + let gnode = Node.Group.root in - let nodes = find_all_nodes store in + let nodes = hierarchy store in assert_equal ~printer:print_node_pair ([], []) nodes; - create_group store gnode; - let exists = group_exists store gnode in + Group.create store gnode; + let exists = Group.exists store gnode in assert_equal ~printer:string_of_bool true exists; - let meta = group_metadata store gnode in - assert_equal ~printer:GroupMetadata.show GroupMetadata.default meta; + let meta = Group.metadata store gnode in + assert_equal ~printer:Metadata.Group.show Metadata.Group.default meta; - erase_group_node store gnode; - let exists = group_exists store gnode in + Group.delete store gnode; + let exists = Group.exists store gnode in assert_equal ~printer:string_of_bool false exists; - let nodes = find_all_nodes store in + let nodes = hierarchy store in assert_equal ~printer:print_node_pair ([], []) nodes; let attrs = `Assoc [("questions", `String "answer")] in - create_group ~attrs store gnode; - let meta = group_metadata store gnode in - assert_equal ~printer:Yojson.Safe.show attrs @@ GroupMetadata.attributes meta; + Group.create ~attrs store gnode; + let meta = Group.metadata store gnode in + assert_equal ~printer:Yojson.Safe.show attrs @@ Metadata.Group.attributes meta; - let exists = array_exists store @@ ArrayNode.(gnode / "non-member") in + let exists = Array.exists store @@ Node.Array.(gnode / "non-member") in assert_equal ~printer:string_of_bool false exists; let cfg = @@ -53,114 +51,114 @@ let test_storage ;index_location = Start ;index_codecs = [`Bytes BE] ;codecs = [`Bytes LE]} in - let anode = ArrayNode.(gnode / "arrnode") in + let anode = Node.Array.(gnode / "arrnode") in let slice = [|R [|0; 20|]; I 10; R [|0; 29|]|] in List.iter (fun codecs -> - create_array + Array.create ~codecs ~shape:[|100; 100; 50|] ~chunks:[|10; 15; 20|] Complex32 Complex.one anode store; let exp = Ndarray.init Complex32 [|21; 1; 30|] (Fun.const Complex.one) in - let got = read_array store anode slice Complex32 in + let got = Array.read store anode slice Complex32 in assert_equal exp got; Ndarray.fill exp Complex.{re=2.0; im=0.}; - write_array store anode slice exp; - let got = read_array store anode slice Complex32 in + Array.write store anode slice exp; + let got = Array.read store anode slice Complex32 in assert_equal exp got; Ndarray.fill exp Complex.{re=0.; im=3.0}; - write_array store anode slice exp; - let got = read_array store anode slice Complex32 in + Array.write store anode slice exp; + let got = Array.read store anode slice Complex32 in assert_equal exp got; - erase_array_node store anode) + Array.delete store anode) [[`ShardingIndexed cfg]; [`ShardingIndexed cfg2]]; (* repeat tests for non-sharding codec chain *) - create_array + Array.create ~sep:`Dot ~codecs:[`Bytes BE] ~shape:[|100; 100; 50|] ~chunks:[|10; 15; 20|] Ndarray.Int Int.max_int anode store; (* test path where there is no chunk key present in store *) let exp = Ndarray.init Int [|21; 1; 30|] (Fun.const Int.max_int) in - write_array store anode slice exp; - let got = read_array store anode slice Int in + Array.write store anode slice exp; + let got = Array.read store anode slice Int in assert_equal exp got; (* test path where there is a chunk key present in store at write time. *) - write_array store anode slice exp; - let got = read_array store anode slice Int in + Array.write store anode slice exp; + let got = Array.read store anode slice Int in assert_equal exp got; assert_raises (Zarr.Storage.Invalid_data_type) - (fun () -> read_array store anode slice Ndarray.Char); + (fun () -> Array.read store anode slice Ndarray.Char); let badslice = [|R [|0; 20|]; I 10; R [||]; R [||] |] in assert_raises (Zarr.Storage.Invalid_array_slice) - (fun () -> read_array store anode badslice Ndarray.Int); + (fun () -> Array.read store anode badslice Ndarray.Int); assert_raises (Zarr.Storage.Invalid_array_slice) - (fun () -> write_array store anode badslice exp); + (fun () -> Array.write store anode badslice exp); assert_raises (Zarr.Storage.Invalid_array_slice) - (fun () -> write_array store anode [|R [|0; 20|]; R [||]; R [||]|] exp); + (fun () -> Array.write store anode [|R [|0; 20|]; R [||]; R [||]|] exp); let badarray = Ndarray.init Float64 [|21; 1; 30|] (Fun.const 0.) in assert_raises (Zarr.Storage.Invalid_data_type) - (fun () -> write_array store anode slice badarray); + (fun () -> Array.write store anode slice badarray); - let child = GroupNode.of_path "/some/child/group" in - create_group store child; - let arrays, groups = find_child_nodes store gnode in + let child = Node.Group.of_path "/some/child/group" in + Group.create store child; + let arrays, groups = Group.children store gnode in assert_equal - ~printer:string_of_list ["/arrnode"] (List.map ArrayNode.to_path arrays); + ~printer:string_of_list ["/arrnode"] (List.map Node.Array.to_path arrays); assert_equal - ~printer:string_of_list ["/some"] (List.map GroupNode.to_path groups); + ~printer:string_of_list ["/some"] (List.map Node.Group.to_path groups); - assert_equal ([], []) @@ find_child_nodes store child; - assert_equal ([], []) @@ find_child_nodes store GroupNode.(root / "fakegroup"); + assert_equal ([], []) @@ Group.children store child; + assert_equal ([], []) @@ Group.children store Node.Group.(root / "fakegroup"); - let ac, gc = find_all_nodes store in + let ac, gc = hierarchy store in let got = List.fast_sort String.compare @@ - List.map ArrayNode.show ac @ List.map GroupNode.show gc in + List.map Node.Array.show ac @ List.map Node.Group.show gc in assert_equal ~printer:string_of_list ["/"; "/arrnode"; "/some"; "/some/child"; "/some/child/group"] got; (* tests for renaming nodes *) - let some = GroupNode.of_path "/some/child" in - rename_group store some "CHILD"; - rename_array store anode "ARRAYNODE"; - let ac, gc = find_all_nodes store in + let some = Node.Group.of_path "/some/child" in + Group.rename store some "CHILD"; + Array.rename store anode "ARRAYNODE"; + let ac, gc = hierarchy store in let got = List.fast_sort String.compare @@ - List.map ArrayNode.show ac @ List.map GroupNode.show gc in + List.map Node.Array.show ac @ List.map Node.Group.show gc in assert_equal ~printer:string_of_list ["/"; "/ARRAYNODE"; "/some"; "/some/CHILD"; "/some/CHILD/group"] got; assert_raises (Zarr.Storage.Key_not_found "fakegroup") - (fun () -> rename_group store GroupNode.(gnode / "fakegroup") "somename"); + (fun () -> Group.rename store Node.Group.(gnode / "fakegroup") "somename"); assert_raises (Zarr.Storage.Key_not_found "fakearray") - (fun () -> rename_array store ArrayNode.(gnode / "fakearray") "somename"); + (fun () -> Array.rename store Node.Array.(gnode / "fakearray") "somename"); (* restore old array node name. *) - rename_array store (ArrayNode.of_path "/ARRAYNODE") "arrnode"; + Array.rename store (Node.Array.of_path "/ARRAYNODE") "arrnode"; let nshape = [|25; 32; 10|] in - reshape store anode nshape; - let meta = array_metadata store anode in - assert_equal ~printer:print_int_array nshape @@ ArrayMetadata.shape meta; + Array.reshape store anode nshape; + let meta = Array.metadata store anode in + assert_equal ~printer:print_int_array nshape @@ Metadata.Array.shape meta; assert_raises (Zarr.Storage.Invalid_resize_shape) - (fun () -> reshape store anode [|25; 10|]); + (fun () -> Array.reshape store anode [|25; 10|]); assert_raises (Zarr.Storage.Key_not_found "fakegroup/zarr.json") - (fun () -> array_metadata store ArrayNode.(gnode / "fakegroup")); + (fun () -> Array.metadata store Node.Array.(gnode / "fakegroup")); - erase_array_node store anode; - erase_all_nodes store; - let got = find_all_nodes store in + Array.delete store anode; + clear store; + let got = hierarchy store in assert_equal ~printer:print_node_pair ([], []) got let _ = @@ -190,7 +188,7 @@ let _ = (Fun.flip Out_channel.output_string {|{"zarr_format":3,"node_type":"unknown"}|}); assert_raises (Zarr.Metadata.Parse_error "invalid node_type in badnode/zarr.json") - (fun () -> FilesystemStore.find_all_nodes s); + (fun () -> FilesystemStore.hierarchy s); Sys.(remove fname; rmdir dname); (* ensure it works with an extra "/" appended to directory name. *) diff --git a/zarr/src/metadata.ml b/zarr/src/metadata.ml index 0c151197..8e9463f9 100644 --- a/zarr/src/metadata.ml +++ b/zarr/src/metadata.ml @@ -99,7 +99,7 @@ module FillValue = struct `List [to_yojson (FloatBits re); to_yojson (FloatBits im)] end -module ArrayMetadata = struct +module Array = struct type t = {zarr_format : int ;shape : int array @@ -347,7 +347,7 @@ module ArrayMetadata = struct | _ -> failwith "kind is not compatible with node's fill value." end -module GroupMetadata = struct +module Group = struct type t = {zarr_format : int ;node_type : string diff --git a/zarr/src/metadata.mli b/zarr/src/metadata.mli index ef45bffa..1213fcc9 100644 --- a/zarr/src/metadata.mli +++ b/zarr/src/metadata.mli @@ -25,7 +25,7 @@ module FillValue : sig a Zarr array. The permitted values depend on the data type. *) end -module ArrayMetadata : sig +module Array : sig (** A module which contains functionality to work with a parsed JSON Zarr array metadata document. *) @@ -108,7 +108,7 @@ module ArrayMetadata : sig and false otherwise. *) end -module GroupMetadata : sig +module Group : sig (** A module which contains functionality to work with a parsed JSON Zarr group metadata document. *) diff --git a/zarr/src/node.ml b/zarr/src/node.ml index ef42635d..b204c893 100644 --- a/zarr/src/node.ml +++ b/zarr/src/node.ml @@ -8,7 +8,7 @@ let rep_ok name = not (String.for_all (Char.equal '.') name) && not (String.starts_with ~prefix:"__" name) -module GroupNode = struct +module Group = struct type t = | Root | Cons of t * string @@ -87,8 +87,8 @@ module GroupNode = struct | Root -> raise Cannot_rename_root end -module ArrayNode = struct - type t = {parent : GroupNode.t option; name : string} +module Array = struct + type t = {parent : Group.t option; name : string} let create g name = if rep_ok name then {parent = Some g; name} @@ -99,9 +99,9 @@ module ArrayNode = struct let root = {parent = None; name = ""} let of_path p = - let g = GroupNode.of_path p in - match GroupNode.parent g with - | Some _ as parent -> {parent; name = GroupNode.name g} + let g = Group.of_path p in + match Group.parent g with + | Some _ as parent -> {parent; name = Group.name g} | None -> raise Node_invariant let ( = ) @@ -114,19 +114,19 @@ module ArrayNode = struct let to_path {parent = p; name} = match p with | None -> "/" - | Some g when GroupNode.(g = root) -> "/" ^ name - | Some g -> GroupNode.to_path g ^ "/" ^ name + | Some g when Group.(g = root) -> "/" ^ name + | Some g -> Group.to_path g ^ "/" ^ name let ancestors {parent; _} = match parent with | None -> [] - | Some g -> g :: GroupNode.ancestors g + | Some g -> g :: Group.ancestors g let is_parent {parent; _} y = match parent with | None -> false - | Some g -> GroupNode.(g = y) + | Some g -> Group.(g = y) let to_key {parent; name} = match parent with - | Some g -> GroupNode.to_prefix g ^ name + | Some g -> Group.to_prefix g ^ name | None -> "" let to_metakey = function diff --git a/zarr/src/node.mli b/zarr/src/node.mli index 387b4357..874c577f 100644 --- a/zarr/src/node.mli +++ b/zarr/src/node.mli @@ -16,7 +16,7 @@ exception Node_invariant exception Cannot_rename_root (** raised when attempting to rename a root node. *) -module GroupNode : sig +module Group : sig type t (** The type of a Group node. *) @@ -82,18 +82,17 @@ module GroupNode : sig @raise Node_invariant if [s] is invalid name. @raise Renaming_root if [t] is a root node.*) - end -module ArrayNode : sig +module Array : sig type t (** The type of an array node. *) - val create : GroupNode.t -> string -> t + val create : Group.t -> string -> t (** [create p n] returns an array node with parent [p] and name [n]. @raise Failure if node invariants are not satisfied. *) - val ( / ) : GroupNode.t -> string -> t + val ( / ) : Group.t -> string -> t (** The infix operator alias of {!ArrayNode.create} *) val root : t @@ -109,7 +108,7 @@ module ArrayNode : sig val name : t -> string (** [name n] returns the name of array node [n]. *) - val parent : t -> GroupNode.t option + val parent : t -> Group.t option (** [parent n] returns [Some p] where [p] is the parent group node of [n] or [None] if node [n] is a root node. *) @@ -117,10 +116,10 @@ module ArrayNode : sig (** [x = y] returns [true] if nodes [x] and [y] are equal, and [false] otherwise. *) - val ancestors : t -> GroupNode.t list + val ancestors : t -> Group.t list (** [ancestors n] returns ancestor group nodes of [n]. *) - val is_parent : t -> GroupNode.t -> bool + val is_parent : t -> Group.t -> bool (** [is_parent n g] returns [true] if group node [g] is the immediate parent of array node [n] and [false] otherwise. *) diff --git a/zarr/src/storage/storage.ml b/zarr/src/storage/storage.ml index 8dd5ca1b..aa1b3ee5 100644 --- a/zarr/src/storage/storage.ml +++ b/zarr/src/storage/storage.ml @@ -1,6 +1,4 @@ include Storage_intf -open Metadata -open Node module ArrayMap = Util.ArrayMap module Indexing = Ndarray.Indexing @@ -20,59 +18,14 @@ module Make (Io : Types.IO) = struct type t = Io.t - (* All nodes are explicit upon creation so just check the node's metadata key.*) - let group_exists t node = - is_member t @@ GroupNode.to_metakey node - - let array_exists t node = - is_member t @@ ArrayNode.to_metakey node - - let rec create_group ?(attrs=`Null) t node = - group_exists t node >>= function - | true -> Deferred.return_unit - | false -> - let k = GroupNode.to_metakey node in - let* () = set t k GroupMetadata.(update_attributes default attrs |> encode) in - GroupNode.parent node - |> Option.fold ~none:Deferred.return_unit ~some:(create_group t) - - let create_array - ?(sep=`Slash) ?(dimension_names=[]) ?(attributes=`Null) - ~codecs ~shape ~chunks - kind fv node t = - let c = Codecs.Chain.create chunks codecs in - let m = ArrayMetadata.create - ~sep ~codecs:c ~dimension_names ~attributes ~shape kind fv chunks in - let* () = set t (ArrayNode.to_metakey node) @@ ArrayMetadata.encode m in - ArrayNode.parent node - |> Option.fold ~none:Deferred.return_unit ~some:(create_group t) - - let group_metadata t node = - get t @@ GroupNode.to_metakey node >>| GroupMetadata.decode - - let array_metadata t node = - get t @@ ArrayNode.to_metakey node >>| ArrayMetadata.decode - let node_kind t metakey = let+ s = get t metakey in match Yojson.Safe.(Util.member "node_type" @@ from_string s) with | `String "array" -> `Array | `String "group" -> `Group - | _ -> raise @@ Parse_error (Printf.sprintf "invalid node_type in %s" metakey) - - let find_child_nodes t node = - group_exists t node >>= function - | false -> Deferred.return ([], []) - | true -> - let* _, ps = list_dir t @@ GroupNode.to_prefix node in - Deferred.fold_left - (fun (l, r) prefix -> - let p = "/" ^ String.(length prefix - 1 |> sub prefix 0) in - node_kind t (prefix ^ "zarr.json") >>| function - | `Array -> ArrayNode.of_path p :: l, r - | `Group -> l, GroupNode.of_path p :: r) ([], []) ps - - let find_all_nodes t = + | _ -> raise @@ Metadata.Parse_error (Printf.sprintf "invalid node_type in %s" metakey) + + let hierarchy t = let* keys = list t in Deferred.fold_left (fun ((l, r) as a) -> function @@ -82,136 +35,181 @@ module Make (Io : Types.IO) = struct | "zarr.json" -> "/" | s -> "/" ^ String.(length s - 10 |> sub s 0) in node_kind t k >>| function - | `Array -> ArrayNode.of_path p :: l, r - | `Group -> l, GroupNode.of_path p :: r) ([], []) keys - - let erase_group_node t node = - erase_prefix t @@ GroupNode.to_prefix node - - let erase_array_node t node = - erase_prefix t @@ ArrayNode.to_key node ^ "/" - - let erase_all_nodes t = erase_prefix t "" - - let write_array t node slice x = - let* b = get t @@ ArrayNode.to_metakey node in - let meta = ArrayMetadata.decode b in - let shape = ArrayMetadata.shape meta in - let slice_shape = match Indexing.slice_shape slice shape with - | exception Assert_failure _ -> raise Invalid_array_slice - | s -> s in - if Ndarray.shape x <> slice_shape then raise Invalid_array_slice else - let kind = Ndarray.data_type x in - if not @@ ArrayMetadata.is_valid_kind meta kind then raise Invalid_data_type else - let m = - Array.fold_left - (fun acc (co, y) -> - let k, c = ArrayMetadata.index_coord_pair meta co in - ArrayMap.add_to_list k (c, y) acc) - ArrayMap.empty @@ Array.combine - (Indexing.coords_of_slice slice shape) (Ndarray.to_array x) - in - let fv = ArrayMetadata.fillvalue_of_kind meta kind in - let repr = Codecs.{kind; shape = ArrayMetadata.chunk_shape meta} in - let prefix = ArrayNode.to_key node ^ "/" in - let chain = ArrayMetadata.codecs meta in - (* NOTE: there is opportunity to compute this step in parallel since - each iteration acts on independent chunks. Maybe use Domainslib? *) - Deferred.iter - (fun (idx, pairs) -> - let ckey = prefix ^ ArrayMetadata.chunk_key meta idx in - is_member t ckey >>= function - | true when PartialChain.is_just_sharding chain -> - let* csize = size t ckey in - let get_p = get_partial_values t ckey in - let set_p = set_partial_values t ckey in - PartialChain.partial_encode chain get_p set_p csize repr pairs - | true -> - let* v = get t ckey in - let arr = Codecs.Chain.decode chain repr v in - List.iter (fun (c, v) -> Ndarray.set arr c v) pairs; - set t ckey @@ Codecs.Chain.encode chain arr - | false -> - let arr = Ndarray.create repr.kind repr.shape fv in - List.iter (fun (c, v) -> Ndarray.set arr c v) pairs; - set t ckey @@ Codecs.Chain.encode chain arr) (ArrayMap.bindings m) - - let read_array : - type a. t -> - ArrayNode.t -> - Indexing.index array -> - a Ndarray.dtype -> - a Ndarray.t Deferred.t - = fun t node slice kind -> - let* b = get t @@ ArrayNode.to_metakey node in - let meta = ArrayMetadata.decode b in - if not @@ ArrayMetadata.is_valid_kind meta kind - then raise Invalid_data_type else - let shape = ArrayMetadata.shape meta in - let slice_shape = match Indexing.slice_shape slice shape with - | exception Assert_failure _ -> raise Invalid_array_slice - | s -> s in - let ic = Array.mapi (fun i v -> i, v) (Indexing.coords_of_slice slice shape) in - let m = - Array.fold_left - (fun acc (i, y) -> - let k, c = ArrayMetadata.index_coord_pair meta y in - ArrayMap.add_to_list k (i, c) acc) ArrayMap.empty ic in - let chain = ArrayMetadata.codecs meta in - let prefix = ArrayNode.to_key node ^ "/" in - let fill_value = ArrayMetadata.fillvalue_of_kind meta kind in - let repr = Codecs.{kind; shape = ArrayMetadata.chunk_shape meta} in - (* NOTE: there is opportunity to compute this step in parallel since - each iteration acts on independent chunks. *) - Deferred.concat_map - (fun (idx, pairs) -> - let ckey = prefix ^ ArrayMetadata.chunk_key meta idx in - is_member t ckey >>= function - | true when PartialChain.is_just_sharding chain -> - let get_p = get_partial_values t ckey in - let* csize = size t ckey in - PartialChain.partial_decode chain get_p csize repr pairs - | true -> - let+ v = get t ckey in - let arr = Codecs.Chain.decode chain repr v in - List.map (fun (i, c) -> i, Ndarray.get arr c) pairs - | false -> - Deferred.return @@ List.map (fun (i, _) -> i, fill_value) pairs) - (ArrayMap.bindings m) >>| fun pairs -> - (* sorting restores the C-order of the decoded array coordinates. *) - let v = - Array.of_list @@ snd @@ List.split @@ - List.fast_sort (fun (x, _) (y, _) -> Int.compare x y) pairs in - Ndarray.of_array kind slice_shape v - - let reshape t node nshape = - let mkey = ArrayNode.to_metakey node in - let* b = get t mkey in - let meta = ArrayMetadata.decode b in - let oshape = ArrayMetadata.shape meta in - if Array.(length nshape <> length oshape) - then raise Invalid_resize_shape else - let s = ArraySet.of_list @@ ArrayMetadata.chunk_indices meta oshape in - let s' = ArraySet.of_list @@ ArrayMetadata.chunk_indices meta nshape in - let pre = ArrayNode.to_key node ^ "/" in - let* () = + | `Array -> Node.Array.of_path p :: l, r + | `Group -> l, Node.Group.of_path p :: r) ([], []) keys + + let clear t = erase_prefix t "" + + module Group = struct + let exists t node = + is_member t @@ Node.Group.to_metakey node + + let rec create ?(attrs=`Null) t node = + exists t node >>= function + | true -> Deferred.return_unit + | false -> + let k = Node.Group.to_metakey node in + let* () = set t k Metadata.Group.(update_attributes default attrs |> encode) in + Node.Group.parent node |> Option.fold ~none:Deferred.return_unit ~some:(create t) + + let metadata t node = + get t @@ Node.Group.to_metakey node >>| Metadata.Group.decode + + let children t node = + exists t node >>= function + | false -> Deferred.return ([], []) + | true -> + let* _, ps = list_dir t @@ Node.Group.to_prefix node in + Deferred.fold_left + (fun (l, r) prefix -> + let p = "/" ^ String.(length prefix - 1 |> sub prefix 0) in + node_kind t (prefix ^ "zarr.json") >>| function + | `Array -> Node.Array.of_path p :: l, r + | `Group -> l, Node.Group.of_path p :: r) ([], []) ps + + let delete t node = + erase_prefix t @@ Node.Group.to_prefix node + + let rename t node str = + let key = Node.Group.to_key node in + exists t node >>= function + | false -> raise @@ Key_not_found key + | true -> rename t key Node.Group.(rename node str |> to_key) + end + + module Array = struct + let exists t node = + is_member t @@ Node.Array.to_metakey node + + let create + ?(sep=`Slash) ?(dimension_names=[]) ?(attributes=`Null) ~codecs ~shape ~chunks + kind fv node t = + let c = Codecs.Chain.create chunks codecs in + let m = Metadata.Array.create + ~sep ~codecs:c ~dimension_names ~attributes ~shape kind fv chunks in + let* () = set t (Node.Array.to_metakey node) @@ Metadata.Array.encode m in + Node.Array.parent node |> Option.fold ~none:Deferred.return_unit ~some:(Group.create t) + + let metadata t node = + get t @@ Node.Array.to_metakey node >>| Metadata.Array.decode + + let delete t node = + erase_prefix t @@ Node.Array.to_key node ^ "/" + + let write t node slice x = + let* b = get t @@ Node.Array.to_metakey node in + let meta = Metadata.Array.decode b in + let shape = Metadata.Array.shape meta in + let slice_shape = match Indexing.slice_shape slice shape with + | exception Assert_failure _ -> raise Invalid_array_slice + | s -> s in + if Ndarray.shape x <> slice_shape then raise Invalid_array_slice else + let kind = Ndarray.data_type x in + if not @@ Metadata.Array.is_valid_kind meta kind then raise Invalid_data_type else + let m = + Array.fold_left + (fun acc (co, y) -> + let k, c = Metadata.Array.index_coord_pair meta co in + ArrayMap.add_to_list k (c, y) acc) + ArrayMap.empty @@ Array.combine + (Indexing.coords_of_slice slice shape) (Ndarray.to_array x) + in + let fv = Metadata.Array.fillvalue_of_kind meta kind in + let repr = Codecs.{kind; shape = Metadata.Array.chunk_shape meta} in + let prefix = Node.Array.to_key node ^ "/" in + let chain = Metadata.Array.codecs meta in + (* NOTE: there is opportunity to compute this step in parallel since + each iteration acts on independent chunks. Maybe use Domainslib? *) Deferred.iter - (fun v -> - let key = pre ^ ArrayMetadata.chunk_key meta v in - is_member t key >>= function - | true -> erase t key - | false -> Deferred.return_unit) ArraySet.(elements @@ diff s s') - in set t mkey @@ ArrayMetadata.(encode @@ update_shape meta nshape) - - let rename_array t node str = - let key = ArrayNode.to_key node in - array_exists t node >>= function - | false -> raise @@ Key_not_found key - | true -> rename t key ArrayNode.(rename node str |> to_key) - - let rename_group t node str = - let key = GroupNode.to_key node in - group_exists t node >>= function - | false -> raise @@ Key_not_found key - | true -> rename t key GroupNode.(rename node str |> to_key) + (fun (idx, pairs) -> + let ckey = prefix ^ Metadata.Array.chunk_key meta idx in + is_member t ckey >>= function + | true when PartialChain.is_just_sharding chain -> + let* csize = size t ckey in + let get_p = get_partial_values t ckey in + let set_p = set_partial_values t ckey in + PartialChain.partial_encode chain get_p set_p csize repr pairs + | true -> + let* v = get t ckey in + let arr = Codecs.Chain.decode chain repr v in + List.iter (fun (c, v) -> Ndarray.set arr c v) pairs; + set t ckey @@ Codecs.Chain.encode chain arr + | false -> + let arr = Ndarray.create repr.kind repr.shape fv in + List.iter (fun (c, v) -> Ndarray.set arr c v) pairs; + set t ckey @@ Codecs.Chain.encode chain arr) (ArrayMap.bindings m) + + let read : + type a. t -> + Node.Array.t -> + Indexing.index array -> + a Ndarray.dtype -> + a Ndarray.t Deferred.t + = fun t node slice kind -> + let* b = get t @@ Node.Array.to_metakey node in + let meta = Metadata.Array.decode b in + if not @@ Metadata.Array.is_valid_kind meta kind + then raise Invalid_data_type else + let shape = Metadata.Array.shape meta in + let slice_shape = match Indexing.slice_shape slice shape with + | exception Assert_failure _ -> raise Invalid_array_slice + | s -> s in + let ic = Array.mapi (fun i v -> i, v) (Indexing.coords_of_slice slice shape) in + let m = + Array.fold_left + (fun acc (i, y) -> + let k, c = Metadata.Array.index_coord_pair meta y in + ArrayMap.add_to_list k (i, c) acc) ArrayMap.empty ic in + let chain = Metadata.Array.codecs meta in + let prefix = Node.Array.to_key node ^ "/" in + let fill_value = Metadata.Array.fillvalue_of_kind meta kind in + let repr = Codecs.{kind; shape = Metadata.Array.chunk_shape meta} in + (* NOTE: there is opportunity to compute this step in parallel since + each iteration acts on independent chunks. *) + Deferred.concat_map + (fun (idx, pairs) -> + let ckey = prefix ^ Metadata.Array.chunk_key meta idx in + is_member t ckey >>= function + | true when PartialChain.is_just_sharding chain -> + let get_p = get_partial_values t ckey in + let* csize = size t ckey in + PartialChain.partial_decode chain get_p csize repr pairs + | true -> + let+ v = get t ckey in + let arr = Codecs.Chain.decode chain repr v in + List.map (fun (i, c) -> i, Ndarray.get arr c) pairs + | false -> + Deferred.return @@ List.map (fun (i, _) -> i, fill_value) pairs) + (ArrayMap.bindings m) >>| fun pairs -> + (* sorting restores the C-order of the decoded array coordinates. *) + let v = + Array.of_list @@ snd @@ List.split @@ + List.fast_sort (fun (x, _) (y, _) -> Int.compare x y) pairs in + Ndarray.of_array kind slice_shape v + + let reshape t node nshape = + let mkey = Node.Array.to_metakey node in + let* b = get t mkey in + let meta = Metadata.Array.decode b in + let oshape = Metadata.Array.shape meta in + if Array.(length nshape <> length oshape) + then raise Invalid_resize_shape else + let s = ArraySet.of_list @@ Metadata.Array.chunk_indices meta oshape in + let s' = ArraySet.of_list @@ Metadata.Array.chunk_indices meta nshape in + let pre = Node.Array.to_key node ^ "/" in + let* () = + Deferred.iter + (fun v -> + let key = pre ^ Metadata.Array.chunk_key meta v in + is_member t key >>= function + | true -> erase t key + | false -> Deferred.return_unit) ArraySet.(elements @@ diff s s') + in set t mkey @@ Metadata.Array.(encode @@ update_shape meta nshape) + + let rename t node str = + let key = Node.Array.to_key node in + exists t node >>= function + | false -> raise @@ Key_not_found key + | true -> rename t key Node.Array.(rename node str |> to_key) + end end diff --git a/zarr/src/storage/storage_intf.ml b/zarr/src/storage/storage_intf.ml index a9d33efe..fad8a092 100644 --- a/zarr/src/storage/storage_intf.ml +++ b/zarr/src/storage/storage_intf.ml @@ -1,6 +1,3 @@ -open Metadata -open Node - exception Invalid_resize_shape exception Invalid_data_type exception Invalid_array_slice @@ -12,60 +9,128 @@ module type STORE = sig type t (** The storage type. *) - val create_group : ?attrs:Yojson.Safe.t -> t -> GroupNode.t -> unit Deferred.t - (** [create_group ?attrs t node] creates a group node in store [t] - containing attributes [attrs]. This is a no-op if [node] - is already a member of this store. *) - - val create_array : - ?sep:[< `Dot | `Slash > `Slash ] -> - ?dimension_names:string option list -> - ?attributes:Yojson.Safe.t -> - codecs:Codecs.codec_chain -> - shape:int array -> - chunks:int array -> - 'a Ndarray.dtype -> - 'a -> - ArrayNode.t -> - t -> - unit Deferred.t - (** [create_array ~sep ~dimension_names ~attributes ~codecs ~shape ~chunks kind fill node t] - creates an array node in store [t] where: - - Separator [sep] is used in the array's chunk key encoding. - - Dimension names [dimension_names] and user attributes [attributes] - are included in it's metadata document. - - A codec chain defined by [codecs]. - - The array has shape [shape] and chunk shape [chunks]. - - The array has data kind [kind] and fill value [fv]. - - @raise Codecs.Bytes_to_bytes_invariant - if [codecs] contains more than one bytes->bytes codec. - @raise Codecs.Invalid_transpose_order - if [codecs] contains a transpose codec with invalid order array. - @raise Codecs.Invalid_sharding_chunk_shape - if [codecs] contains a shardingindexed codec with an - incorrect inner chunk shape. *) - - val array_metadata : t -> ArrayNode.t -> ArrayMetadata.t Deferred.t - (** [array_metadata node t] returns the metadata of array node [node]. - - @raise Key_not_found if node is not a member of store [t]. *) - - val group_metadata : t -> GroupNode.t -> GroupMetadata.t Deferred.t - (** [group_metadata node t] returns the metadata of group node [node]. - - @raise Key_not_found if node is not a member of store [t].*) - - val find_child_nodes - : t -> GroupNode.t -> (ArrayNode.t list * GroupNode.t list) Deferred.t - (** [find_child_nodes t n] returns a tuple of child nodes of group node [n]. - This operation returns a pair of empty lists if node [n] has no - children or is not a member of store [t]. - - @raise Parse_error if any child node has invalid [node_type] metadata.*) - - val find_all_nodes : t -> (ArrayNode.t list * GroupNode.t list) Deferred.t - (** [find_all_nodes t] returns [Some p] where [p] is a pair of lists + module Group : sig + val create : ?attrs:Yojson.Safe.t -> t -> Node.Group.t -> unit Deferred.t + (** [create ?attrs t node] creates a group node in store [t] + containing attributes [attrs]. This is a no-op if [node] + is already a member of this store. *) + + val metadata : t -> Node.Group.t -> Metadata.Group.t Deferred.t + (** [metadata node t] returns the metadata of group node [node]. + + @raise Key_not_found if node is not a member of store [t].*) + + val children : t -> Node.Group.t -> (Node.Array.t list * Node.Group.t list) Deferred.t + (** [children t n] returns a tuple of child nodes of group node [n]. + This operation returns a pair of empty lists if node [n] has no + children or is not a member of store [t]. + + @raise Parse_error if any child node has invalid [node_type] metadata.*) + + val delete : t -> Node.Group.t -> unit Deferred.t + (** [delete t n] erases group node [n] from store [t]. This also + erases all child nodes of [n]. If node [n] is not a member + of store [t] then this is a no-op. *) + + val exists : t -> Node.Group.t -> bool Deferred.t + (** [exists t n] returns [true] if group node [n] is a member + of store [t] and [false] otherwise. *) + + val rename : t -> Node.Group.t -> string -> unit Deferred.t + (** [rename t g name] changes the name of group node [g] in store [t] to [name]. + + @raise Key_not_found if [g] is not a member of store [t]. + @raise Renaming_root if [g] is the store's root node. + @raise Node_invariant if [name] is an invalid node name.*) + end + + module Array : sig + val create : + ?sep:[< `Dot | `Slash > `Slash ] -> + ?dimension_names:string option list -> + ?attributes:Yojson.Safe.t -> + codecs:Codecs.codec_chain -> + shape:int array -> + chunks:int array -> + 'a Ndarray.dtype -> + 'a -> + Node.Array.t -> + t -> + unit Deferred.t + (** [create ~sep ~dimension_names ~attributes ~codecs ~shape ~chunks kind fill node t] + creates an array node in store [t] where: + - Separator [sep] is used in the array's chunk key encoding. + - Dimension names [dimension_names] and user attributes [attributes] + are included in it's metadata document. + - A codec chain defined by [codecs]. + - The array has shape [shape] and chunk shape [chunks]. + - The array has data kind [kind] and fill value [fv]. + + @raise Codecs.Bytes_to_bytes_invariant + if [codecs] contains more than one bytes->bytes codec. + @raise Codecs.Invalid_transpose_order + if [codecs] contains a transpose codec with invalid order array. + @raise Codecs.Invalid_sharding_chunk_shape + if [codecs] contains a shardingindexed codec with an + incorrect inner chunk shape. *) + + val metadata : t -> Node.Array.t -> Metadata.Array.t Deferred.t + (** [metadata node t] returns the metadata of array node [node]. + + @raise Key_not_found if node is not a member of store [t]. *) + + val delete : t -> Node.Array.t -> unit Deferred.t + (** [delete t n] erases array node [n] from store [t]. If node [n] + is not a member of store [t] then this is a no-op. *) + + val exists : t -> Node.Array.t -> bool Deferred.t + (** [exists t n] returns [true] if array node [n] is a member + of store [t] and [false] otherwise. *) + + val write : t -> Node.Array.t -> Ndarray.Indexing.index array -> 'a Ndarray.t -> unit Deferred.t + (** [write t n s x] writes n-dimensional array [x] to the slice [s] + of array node [n] in store [t]. + + @raise Invalid_array_slice + if the ndarray [x] size does not equal slice [s]. + @raise Invalid_data_type + if the kind of [x] is not compatible with node [n]'s data type as + described in its metadata document. *) + + val read : + t -> + Node.Array.t -> + Ndarray.Indexing.index array -> + 'a Ndarray.dtype -> + 'a Ndarray.t Deferred.t + (** [read t n s k] reads an n-dimensional array of size determined + by slice [s] from array node [n]. + + @raise Invalid_data_type + if kind [k] is not compatible with node [n]'s data type as described + in its metadata document. + @raise Invalid_array_slice + if the slice [s] is not a valid slice of array node [n].*) + + val reshape : t -> Node.Array.t -> int array -> unit Deferred.t + (** [reshape t n shape] resizes array node [n] of store [t] into new + size [shape]. + + @raise Invalid_resize_shape + if [shape] does not have the same dimensions as [n]'s shape. + @raise Key_not_found + if node [n] is not a member of store [t]. *) + + val rename : t -> Node.Array.t -> string -> unit Deferred.t + (** [rename t n name] changes the name of array node [n] in store [t] to [name]. + + @raise Key_not_found if [g] is not a member of store [t]. + @raise Renaming_root if [g] is the store's root node. + @raise Node_invariant if [name] is an invalid node name.*) + end + + val hierarchy : t -> (Node.Array.t list * Node.Group.t list) Deferred.t + (** [hierarchy t] returns [p] where [p] is a pair of lists representing all nodes in store [t]. The first element of the pair is a list of all array nodes, and the second element is a list of all group nodes. This operation returns a pair of empty lists if @@ -73,80 +138,9 @@ module type STORE = sig @raise Parse_error if any node has invalid [node_type] metadata.*) - val erase_group_node : t -> GroupNode.t -> unit Deferred.t - (** [erase_group_node t n] erases group node [n] from store [t]. This also - erases all child nodes of [n]. If node [n] is not a member - of store [t] then this is a no-op. *) - - val erase_array_node : t -> ArrayNode.t -> unit Deferred.t - (** [erase_array_node t n] erases group node [n] from store [t]. This also - erases all child nodes of [n]. If node [n] is not a member - of store [t] then this is a no-op. *) - - val erase_all_nodes : t -> unit Deferred.t - (** [erase_all_nodes t] clears the store [t] by deleting all nodes. + val clear : t -> unit Deferred.t + (** [clear t] clears the store [t] by deleting all nodes. If the store is already empty, this is a no-op. *) - - val group_exists : t -> GroupNode.t -> bool Deferred.t - (** [group_exists t n] returns [true] if group node [n] is a member - of store [t] and [false] otherwise. *) - - val array_exists : t -> ArrayNode.t -> bool Deferred.t - (** [array_exists t n] returns [true] if array node [n] is a member - of store [t] and [false] otherwise. *) - - val write_array : - t -> - ArrayNode.t -> - Ndarray.Indexing.index array -> - 'a Ndarray.t -> - unit Deferred.t - (** [write_array t n s x] writes n-dimensional array [x] to the slice [s] - of array node [n] in store [t]. - - @raise Invalid_array_slice - if the ndarray [x] size does not equal slice [s]. - @raise Invalid_data_type - if the kind of [x] is not compatible with node [n]'s data type as - described in its metadata document. *) - - val read_array : - t -> - ArrayNode.t -> - Ndarray.Indexing.index array -> - 'a Ndarray.dtype -> - 'a Ndarray.t Deferred.t - (** [read_array t n s k] reads an n-dimensional array of size determined - by slice [s] from array node [n]. - - @raise Invalid_data_type - if kind [k] is not compatible with node [n]'s data type as described - in its metadata document. - @raise Invalid_array_slice - if the slice [s] is not a valid slice of array node [n].*) - - val reshape : t -> ArrayNode.t -> int array -> unit Deferred.t - (** [reshape t n shape] resizes array node [n] of store [t] into new - size [shape]. - - @raise Invalid_resize_shape - if [shape] does not have the same dimensions as [n]'s shape. - @raise Key_not_found - if node [n] is not a member of store [t]. *) - - val rename_group : t -> GroupNode.t -> string -> unit Deferred.t - (** [rename t g name] changes the name of group node [g] in store [t] to [name]. - - @raise Key_not_found if [g] is not a member of store [t]. - @raise Renaming_root if [g] is the store's root node. - @raise Node_invariant if [name] is an invalid node name.*) - - val rename_array : t -> ArrayNode.t -> string -> unit Deferred.t - (** [rename t n name] changes the name of array node [n] in store [t] to [name]. - - @raise Key_not_found if [g] is not a member of store [t]. - @raise Renaming_root if [g] is the store's root node. - @raise Node_invariant if [name] is an invalid node name.*) end module type Interface = sig diff --git a/zarr/test/test_metadata.ml b/zarr/test/test_metadata.ml index fb304500..1da55b91 100644 --- a/zarr/test/test_metadata.ml +++ b/zarr/test/test_metadata.ml @@ -1,6 +1,5 @@ open OUnit2 open Zarr -open Zarr.Metadata let flatten_fstring s = String.(split_on_char ' ' s |> concat "" |> split_on_char '\n' |> concat "") @@ -8,28 +7,28 @@ let flatten_fstring s = let decode_bad_group_metadata ~str ~msg = assert_raises (Metadata.Parse_error msg) - (fun () -> GroupMetadata.decode str) + (fun () -> Metadata.Group.decode str) let group = [ "group metadata" >:: (fun _ -> - let meta = GroupMetadata.default in + let meta = Metadata.Group.default in let expected = {|{"zarr_format":3,"node_type":"group"}|} in - let got = GroupMetadata.encode meta in + let got = Metadata.Group.encode meta in assert_equal ~printer:Fun.id expected got; - assert_equal ~printer:GroupMetadata.show meta @@ GroupMetadata.decode got; + assert_equal ~printer:Metadata.Group.show meta @@ Metadata.Group.decode got; assert_raises (Metadata.Parse_error "group metadata must contain a zarr_format field.") - (fun () -> GroupMetadata.decode {|{"bad_json":0}|}); + (fun () -> Metadata.Group.decode {|{"bad_json":0}|}); let meta' = - GroupMetadata.update_attributes + Metadata.Group.update_attributes meta @@ `Assoc [("spam", `String "ham"); ("eggs", `Int 42)] in let expected = {|{"zarr_format":3,"node_type":"group","attributes":{"spam":"ham","eggs":42}}|} in - assert_equal expected @@ GroupMetadata.encode meta'; + assert_equal expected @@ Metadata.Group.encode meta'; (* test bad zarr_format field value. *) decode_bad_group_metadata @@ -59,36 +58,36 @@ let test_array_metadata let meta = match dimension_names with | Some d -> - ArrayMetadata.create ~codecs ~shape ~dimension_names:d kind fv chunks + Metadata.Array.create ~codecs ~shape ~dimension_names:d kind fv chunks | None -> - ArrayMetadata.create ~codecs ~shape kind fv chunks + Metadata.Array.create ~codecs ~shape kind fv chunks in assert_bool "should not fail" - ArrayMetadata.(ArrayMetadata.(encode meta |> decode) = meta); + Metadata.Array.(Metadata.Array.(encode meta |> decode) = meta); assert_raises (Metadata.Parse_error "array metadata must contain a zarr_format field.") - (fun () -> ArrayMetadata.decode {|{"bad_json":0}|}); + (fun () -> Metadata.Array.decode {|{"bad_json":0}|}); let show_int_array = [%show: int array] in - assert_equal ~printer:show_int_array shape @@ ArrayMetadata.shape meta; - assert_equal ~printer:show_int_array chunks @@ ArrayMetadata.chunk_shape meta; + assert_equal ~printer:show_int_array shape @@ Metadata.Array.shape meta; + assert_equal ~printer:show_int_array chunks @@ Metadata.Array.chunk_shape meta; let show_int_array_tuple = [%show: int array * int array] in assert_equal ~printer:show_int_array_tuple ([|1; 3; 1|], [|3; 1; 0|]) @@ - ArrayMetadata.index_coord_pair meta [|8; 7; 6|]; + Metadata.Array.index_coord_pair meta [|8; 7; 6|]; assert_equal ~printer:show_int_array_tuple ([|2; 5; 1|], [|0; 0; 4|]) @@ - ArrayMetadata.index_coord_pair meta [|10; 10; 10|]; + Metadata.Array.index_coord_pair meta [|10; 10; 10|]; assert_equal ~printer:Fun.id "c/2/5/1" @@ - ArrayMetadata.chunk_key meta [|2; 5; 1|]; + Metadata.Array.chunk_key meta [|2; 5; 1|]; let indices = [[|0; 0; 0|]; [|0; 0; 1|]; [|0; 1; 0|]; [|0; 1; 1|] @@ -97,48 +96,48 @@ let test_array_metadata assert_equal ~printer:[%show: int array list] indices @@ - ArrayMetadata.chunk_indices meta [|10; 4; 10|]; + Metadata.Array.chunk_indices meta [|10; 4; 10|]; assert_equal ~printer:[%show: string option list] (if dimension_names = None then [] else Option.get dimension_names) - (ArrayMetadata.dimension_names meta); + (Metadata.Array.dimension_names meta); assert_equal ~printer:Yojson.Safe.show `Null @@ - ArrayMetadata.attributes meta; + Metadata.Array.attributes meta; let attrs = `Assoc [("questions", `String "answer")] in assert_equal ~printer:Yojson.Safe.show attrs - ArrayMetadata.(attributes @@ update_attributes meta attrs); + Metadata.Array.(attributes @@ update_attributes meta attrs); let new_shape = [|20; 10; 6|] in assert_equal ~printer:show_int_array new_shape @@ - ArrayMetadata.(shape @@ update_shape meta new_shape); + Metadata.Array.(shape @@ update_shape meta new_shape); assert_bool "Using the correct kind must not fail this op" @@ - ArrayMetadata.is_valid_kind meta kind; + Metadata.Array.is_valid_kind meta kind; assert_bool "Float32 is the only valid kind for this metadata" - (not @@ ArrayMetadata.is_valid_kind meta bad_kind); + (not @@ Metadata.Array.is_valid_kind meta bad_kind); - assert_equal fv @@ ArrayMetadata.fillvalue_of_kind meta kind; + assert_equal fv @@ Metadata.Array.fillvalue_of_kind meta kind; assert_raises (Failure "kind is not compatible with node's fill value.") - (fun () -> ArrayMetadata.fillvalue_of_kind meta bad_kind) + (fun () -> Metadata.Array.fillvalue_of_kind meta bad_kind) (* test decoding an ill-formed array metadata with an expected error message.*) let decode_bad_array_metadata ~str ~msg = - assert_raises (Metadata.Parse_error msg) (fun () -> ArrayMetadata.decode str) + assert_raises (Metadata.Parse_error msg) (fun () -> Metadata.Array.decode str) let test_encode_decode_fill_value fv = let str = Format.sprintf {|{ @@ -157,7 +156,7 @@ let test_encode_decode_fill_value fv = assert_equal ~printer:Fun.id (flatten_fstring str) - (ArrayMetadata.encode @@ ArrayMetadata.decode str) + (Metadata.Array.encode @@ Metadata.Array.decode str) let test_decode_encode_chunk_key name sep (key, exp_encode, exp_null) = let str = Format.sprintf {|{ @@ -173,10 +172,10 @@ let test_decode_encode_chunk_key name sep (key, exp_encode, exp_null) = "chunk_key_encoding": {"name": %s, "configuration": {"separator": %s}}}|} name sep in - let meta = ArrayMetadata.decode str in - assert_equal ~printer:Fun.id exp_encode @@ ArrayMetadata.chunk_key meta key; - assert_equal ~printer:Fun.id exp_null @@ ArrayMetadata.chunk_key meta [||]; - assert_equal ~printer:Fun.id (flatten_fstring str) @@ ArrayMetadata.encode meta + let meta = Metadata.Array.decode str in + assert_equal ~printer:Fun.id exp_encode @@ Metadata.Array.chunk_key meta key; + assert_equal ~printer:Fun.id exp_null @@ Metadata.Array.chunk_key meta [||]; + assert_equal ~printer:Fun.id (flatten_fstring str) @@ Metadata.Array.encode meta let array = [ "array metadata" >:: (fun _ -> @@ -426,16 +425,16 @@ let array = [ "chunk_grid": {"name": "regular", "configuration": {"chunk_shape": [10, 10]}}, "chunk_key_encoding": {"name": "v2"}}|} in - let meta = ArrayMetadata.decode str in + let meta = Metadata.Array.decode str in (* we except it to use the default "." separator. *) assert_equal - ~printer:Fun.id "2.0.1" @@ ArrayMetadata.chunk_key meta [|2; 0; 1|]; + ~printer:Fun.id "2.0.1" @@ Metadata.Array.chunk_key meta [|2; 0; 1|]; (* we expect the default (unspecified) config seperator to be dropped when serializing the metadata to JSON format. *) assert_equal ~printer:Fun.id Yojson.Safe.(from_string str |> to_string) @@ - ArrayMetadata.encode meta; + Metadata.Array.encode meta; (* test if the decoding fails if chunk key encoding contains unknown * separator or name. *) diff --git a/zarr/test/test_node.ml b/zarr/test/test_node.ml index effb2a11..55e9cb54 100644 --- a/zarr/test/test_node.ml +++ b/zarr/test/test_node.ml @@ -1,188 +1,188 @@ open OUnit2 -open Zarr.Node +open Zarr let group_node = [ "group node tests" >:: (fun _ -> - let n = GroupNode.(root / "somename") in + let n = Node.Group.(root / "somename") in (* test node invariants *) List.iter (fun x -> assert_raises Zarr.Node.Node_invariant @@ fun () -> - GroupNode.create n x) + Node.Group.create n x) [""; "na/me"; "...."; "__name"]; (* creation from string path *) - let r = GroupNode.of_path "/" in - assert_equal ~printer:GroupNode.show GroupNode.root r; + let r = Node.Group.of_path "/" in + assert_equal ~printer:Node.Group.show Node.Group.root r; List.iter (fun x -> assert_raises Zarr.Node.Node_invariant @@ fun () -> - GroupNode.of_path x) + Node.Group.of_path x) [""; "na/meas"; "/some/..."; "/root/__name"; "/sd/"]; (* node name tests *) - let n = GroupNode.of_path "/some/dir/moredirs/path/pname" in - assert_equal "pname" @@ GroupNode.name n; - assert_equal "" @@ GroupNode.name GroupNode.root; + let n = Node.Group.of_path "/some/dir/moredirs/path/pname" in + assert_equal "pname" @@ Node.Group.name n; + assert_equal "" @@ Node.Group.name Node.Group.root; (* parent tests *) - assert_equal None @@ GroupNode.parent GroupNode.root; - match GroupNode.parent n with + assert_equal None @@ Node.Group.parent Node.Group.root; + match Node.Group.parent n with | None -> assert_failure "A non-root node must have a parent."; | Some p -> - assert_equal "/some/dir/moredirs/path" @@ GroupNode.show p; + assert_equal "/some/dir/moredirs/path" @@ Node.Group.show p; (* equality tests *) - assert_equal ~printer:GroupNode.show GroupNode.root GroupNode.root; + assert_equal ~printer:Node.Group.show Node.Group.root Node.Group.root; assert_bool "root node cannot be equal to its child" @@ - not GroupNode.(root = n); + not Node.Group.(root = n); assert_bool "non-root node cannot have root as child" @@ - not GroupNode.(n = root); + not Node.Group.(n = root); (* ancestory tests *) - assert_equal [] @@ GroupNode.ancestors GroupNode.root; + assert_equal [] @@ Node.Group.ancestors Node.Group.root; assert_equal ~printer:[%show: string list] ["/"; "/some"; "/some/dir"; "/some/dir/moredirs" ;"/some/dir/moredirs/path"] - (GroupNode.ancestors n |> List.map GroupNode.show); - let exp_parents = GroupNode.ancestors n in + (Node.Group.ancestors n |> List.map Node.Group.show); + let exp_parents = Node.Group.ancestors n in let r, l = List.fold_left_map (fun acc _ -> - match GroupNode.parent acc with + match Node.Group.parent acc with | Some acc' -> acc', acc' | None -> acc, acc) n exp_parents in assert_equal - ~printer:[%show: GroupNode.t list] + ~printer:[%show: Node.Group.t list] exp_parents @@ List.rev l; - assert_equal ~printer:GroupNode.show r GroupNode.root; + assert_equal ~printer:Node.Group.show r Node.Group.root; (* child node tests *) - let p = GroupNode.parent n |> Option.get in + let p = Node.Group.parent n |> Option.get in assert_equal ~printer:string_of_bool true @@ - GroupNode.is_child_group p n; + Node.Group.is_child_group p n; assert_equal ~printer:string_of_bool false @@ - GroupNode.is_child_group n GroupNode.root; + Node.Group.is_child_group n Node.Group.root; assert_equal ~printer:string_of_bool false @@ - GroupNode.is_child_group GroupNode.root GroupNode.root; + Node.Group.is_child_group Node.Group.root Node.Group.root; (* rename tests *) assert_raises (Zarr.Node.Cannot_rename_root) - (fun () -> GroupNode.rename GroupNode.root "somename"); + (fun () -> Node.Group.rename Node.Group.root "somename"); assert_raises (Zarr.Node.Node_invariant) - (fun () -> GroupNode.rename n "?illegal/"); - let n' = GroupNode.rename n "newname" in - assert_bool "" GroupNode.(name n' <> name n); + (fun () -> Node.Group.rename n "?illegal/"); + let n' = Node.Group.rename n "newname" in + assert_bool "" Node.Group.(name n' <> name n); (* stringify tests *) assert_equal - ~printer:Fun.id "" @@ GroupNode.to_key GroupNode.root; + ~printer:Fun.id "" @@ Node.Group.to_key Node.Group.root; assert_equal ~printer:Fun.id "some/dir/moredirs/path/pname" @@ - GroupNode.to_key n; + Node.Group.to_key n; assert_equal ~printer:Fun.id "zarr.json" @@ - GroupNode.to_metakey GroupNode.root; + Node.Group.to_metakey Node.Group.root; assert_equal ~printer:Fun.id ("some/dir/moredirs/path/pname/zarr.json") @@ - GroupNode.to_metakey n) + Node.Group.to_metakey n) ] let array_node = [ "array node tests" >:: (fun _ -> - let _ = ArrayNode.(GroupNode.root / "somename") in + let _ = Node.Array.(Node.Group.root / "somename") in (* test node invariants *) List.iter (fun x -> assert_raises Zarr.Node.Node_invariant @@ fun () -> - ArrayNode.create GroupNode.root x) + Node.Array.create Node.Group.root x) [""; "na/me"; "...."; "__name"]; (* creation from string path *) List.iter (fun x -> assert_raises Zarr.Node.Node_invariant @@ fun () -> - ArrayNode.of_path x) + Node.Array.of_path x) ["/"; ""; "na/meas"; "/some/..."; "/root/__name"; "/sd/"]; (* node name tests *) let s = "/some/dir/moredirs/path/pname" in - let n = ArrayNode.of_path s in - assert_equal "pname" @@ ArrayNode.name n; - assert_equal ~printer:Fun.id s @@ ArrayNode.show n; + let n = Node.Array.of_path s in + assert_equal "pname" @@ Node.Array.name n; + assert_equal ~printer:Fun.id s @@ Node.Array.show n; (* parent tests *) assert_equal - ~printer:GroupNode.show - GroupNode.root @@ - Option.get @@ ArrayNode.parent @@ ArrayNode.of_path "/nodename"; - assert_equal None ArrayNode.(parent root); + ~printer:Node.Group.show + Node.Group.root @@ + Option.get @@ Node.Array.parent @@ Node.Array.of_path "/nodename"; + assert_equal None Node.Array.(parent root); (* equality tests *) - let n' = ArrayNode.of_path s in - assert_equal ~printer:ArrayNode.show n n'; - assert_equal true ArrayNode.(n = n'); + let n' = Node.Array.of_path s in + assert_equal ~printer:Node.Array.show n n'; + assert_equal true Node.Array.(n = n'); assert_equal false @@ - ArrayNode.(n = ArrayNode.of_path (s ^ "/more")); + Node.Array.(n = Node.Array.of_path (s ^ "/more")); (* ancestory tests *) - assert_equal [] ArrayNode.(ancestors root); + assert_equal [] Node.Array.(ancestors root); assert_equal ~printer:[%show: string list] ["/"; "/some"; "/some/dir"; "/some/dir/moredirs" ;"/some/dir/moredirs/path"] - (ArrayNode.ancestors n - |> List.map GroupNode.show + (Node.Array.ancestors n + |> List.map Node.Group.show |> List.fast_sort String.compare); - let m = ArrayNode.of_path "/some" in - assert_equal false ArrayNode.(is_parent root GroupNode.root); - assert_equal true @@ ArrayNode.is_parent m GroupNode.root; + let m = Node.Array.of_path "/some" in + assert_equal false Node.Array.(is_parent root Node.Group.root); + assert_equal true @@ Node.Array.is_parent m Node.Group.root; (* rename tests *) assert_raises (Zarr.Node.Cannot_rename_root) - (fun () -> ArrayNode.rename ArrayNode.root "somename"); + (fun () -> Node.Array.rename Node.Array.root "somename"); assert_raises (Zarr.Node.Node_invariant) - (fun () -> ArrayNode.rename n "?illegal/"); - let n' = ArrayNode.rename n "newname" in - assert_bool "" ArrayNode.(name n' <> name n); + (fun () -> Node.Array.rename n "?illegal/"); + let n' = Node.Array.rename n "newname" in + assert_bool "" Node.Array.(name n' <> name n); (* stringify tests *) assert_equal ~printer:Fun.id "some/dir/moredirs/path/pname" @@ - ArrayNode.to_key n; - assert_equal ~printer:Fun.id "" ArrayNode.(to_key root); - assert_equal ~printer:Fun.id "/" ArrayNode.(to_path root); + Node.Array.to_key n; + assert_equal ~printer:Fun.id "" Node.Array.(to_key root); + assert_equal ~printer:Fun.id "/" Node.Array.(to_path root); - assert_equal ~printer:Fun.id "zarr.json" ArrayNode.(to_metakey root); + assert_equal ~printer:Fun.id "zarr.json" Node.Array.(to_metakey root); assert_equal ~printer:Fun.id ("some/dir/moredirs/path/pname/zarr.json") @@ - ArrayNode.to_metakey n) + Node.Array.to_metakey n) ] let tests = group_node @ array_node