Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Generalize list and list_prefix for FilesystemStore #66

Merged
merged 2 commits into from
Sep 1, 2024
Merged

Generalize list and list_prefix for FilesystemStore #66

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
c62ceb4
Generalize list and list_prefix for FilesystemStore.
zoj613 Aug 31, 2024
02b7028
Improve list_dir implementation for FilesystemStore.
zoj613 Sep 1, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
55 changes: 18 additions & 37 deletions zarr-eio/src/storage.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -56,33 +56,24 @@ module FilesystemStore = struct
let file_offset = Eio.File.seek flow (Optint.Int63.of_int ofs) `Set in
Eio.File.pwrite_all flow ~file_offset [Cstruct.of_string ~allocator str]

let list t =
let rec aux acc dir =
List.fold_left
(fun a x ->
match Eio.Path.(dir / x) with
| p when Eio.Path.is_directory p -> aux a p
| p -> (fspath_to_key t p) :: a) acc (Eio.Path.read_dir dir)
in aux [] t.root
let rec walk t acc dir =
List.fold_left
(fun a x ->
match Eio.Path.(dir / x) with
| p when Eio.Path.is_directory p -> walk t a p
| p -> (fspath_to_key t p) :: a) acc (Eio.Path.read_dir dir)

let list t = walk t [] t.root

let list_prefix t prefix =
walk t [] (key_to_fspath t prefix)

let is_member t key =
Eio.Path.is_file @@ key_to_fspath t key

let erase t key =
Eio.Path.unlink @@ key_to_fspath t key

let list_prefix t prefix =
let rec aux acc dir =
let xs = Eio.Path.read_dir dir in
List.fold_left
(fun a x ->
match Eio.Path.(dir / x) with
| p when Eio.Path.is_directory p -> aux a p
| p ->
let key = fspath_to_key t p in
if String.starts_with ~prefix key then key :: a else a) acc xs
in aux [] t.root

let erase_prefix t pre =
(* if prefix points to the root of the store, only delete sub-dirs and files.*)
let prefix = key_to_fspath t pre in
Expand All @@ -91,23 +82,13 @@ module FilesystemStore = struct
else Eio.Path.rmtree ~missing_ok:true prefix

let list_dir t prefix =
let module S = Zarr.Util.StrSet in
let n = String.length prefix in
let rec aux acc dir =
List.fold_left
(fun ((l, r) as a) x ->
match Eio.Path.(dir / x) with
| p when Eio.Path.is_directory p -> aux a p
| p ->
let key = fspath_to_key t p in
let pred = String.starts_with ~prefix key in
match key with
| k when pred && String.contains_from k n '/' ->
S.add String.(sub k 0 @@ 1 + index_from k n '/') l, r
| k when pred -> l, k :: r
| _ -> a) acc (Eio.Path.read_dir dir) in
let prefs, keys = aux (S.empty, []) t.root in
keys, S.elements prefs
let dir = key_to_fspath t prefix in
List.partition_map
(fun x ->
match Eio.Path.(dir / x) with
| p when Eio.Path.is_directory p ->
Either.right @@ (fspath_to_key t p) ^ "/"
| p -> Either.left @@ fspath_to_key t p) (Eio.Path.read_dir dir)
end

module U = Zarr.Util
Expand Down
68 changes: 24 additions & 44 deletions zarr-lwt/src/storage.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -89,61 +89,41 @@ module FilesystemStore = struct
let* () = Lwt_io.set_position oc @@ Int64.of_int ofs in
Lwt_io.write oc value) rvs

let list t =
let rec filter_concat acc dir =
Lwt_stream.fold_s
(fun x a ->
if x = "." || x = ".." then Lwt.return a else
match Filename.concat dir x with
| p when Sys.is_directory p -> filter_concat a p
| p -> Lwt.return @@ fspath_to_key t p :: a)
(Lwt_unix.files_of_directory dir) acc
in filter_concat [] @@ key_to_fspath t ""
let rec walk t acc dir =
Lwt_stream.fold_s
(fun x a ->
if x = "." || x = ".." then Lwt.return a else
match Filename.concat dir x with
| p when Sys.is_directory p -> walk t a p
| p -> Lwt.return @@ fspath_to_key t p :: a)
(Lwt_unix.files_of_directory dir) acc

let list t = walk t [] (key_to_fspath t "")

let list_prefix t prefix =
walk t [] (key_to_fspath t prefix)

let is_member t key =
Lwt_unix.file_exists @@ key_to_fspath t key

let erase t key =
Lwt_unix.unlink @@ key_to_fspath t key

let list_prefix t prefix =
let rec filter_concat acc dir =
Lwt_stream.fold_s
(fun x a ->
if x = "." || x = ".." then Lwt.return a else
match Filename.concat dir x with
| p when Sys.is_directory p -> filter_concat a p
| p ->
let key = fspath_to_key t p in
if String.starts_with ~prefix key
then Lwt.return @@ key :: a else Lwt.return a)
(Lwt_unix.files_of_directory dir) acc
in filter_concat [] @@ key_to_fspath t ""

let erase_prefix t pre =
list_prefix t pre >>= Lwt_list.iter_s @@ erase t

let list_dir t prefix =
let module S = Zarr.Util.StrSet in
let n = String.length prefix in
let rec filter_concat acc dir =
Lwt_stream.fold_s
(fun x ((l, r) as a) ->
if x = "." || x = ".." then Lwt.return a else
match Filename.concat dir x with
| p when Sys.is_directory p -> filter_concat a p
| p ->
let key = fspath_to_key t p in
let pred = String.starts_with ~prefix key in
match key with
| k when pred && String.contains_from k n '/' ->
Lwt.return (S.add String.(sub k 0 @@ 1 + index_from k n '/') l, r)
| k when pred -> Lwt.return (l, k :: r)
| _ -> Lwt.return a)
(Lwt_unix.files_of_directory dir) acc
in
let+ y, x = filter_concat (S.empty, []) @@ key_to_fspath t "" in
x, S.elements y
let dir = key_to_fspath t prefix in
let+ files =
Lwt_stream.to_list @@ Lwt_stream.filter
(fun x -> if x = "." || x = ".." then false else true)
(Lwt_unix.files_of_directory dir) in
List.partition_map
(fun x ->
match Filename.concat dir x with
| p when Sys.is_directory p ->
Either.right @@ (fspath_to_key t p) ^ "/"
| p -> Either.left @@ fspath_to_key t p) files
end

module U = Zarr.Util
Expand Down
61 changes: 17 additions & 44 deletions zarr-sync/src/storage.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -59,18 +59,6 @@ module FilesystemStore = struct
Out_channel.seek oc @@ Int64.of_int rs;
Out_channel.output_string oc value) rvs; Out_channel.flush oc)

let list t =
let rec aux acc dir =
match Sys.readdir dir with
| [||] -> acc
| xs ->
List.concat_map
(fun x ->
match Filename.concat dir x with
| p when Sys.is_directory p -> aux acc p
| p -> (fspath_to_key t p) :: acc) @@ Array.to_list xs
in aux [] @@ key_to_fspath t ""

let is_member t key = Sys.file_exists @@ key_to_fspath t key

let erase t key = Sys.remove @@ key_to_fspath t key
Expand All @@ -82,44 +70,29 @@ module FilesystemStore = struct
(key_to_fspath t key)
(fun ic -> In_channel.length ic |> Int64.to_int)

let rec walk t acc dir =
List.fold_left
(fun a x ->
match Filename.concat dir x with
| p when Sys.is_directory p -> walk t a p
| p -> (fspath_to_key t p) :: a) acc (Array.to_list @@ Sys.readdir dir)

let list t = walk t [] (key_to_fspath t "")

let list_prefix t prefix =
let rec aux acc dir =
match Sys.readdir dir with
| [||] -> acc
| xs ->
List.concat_map
(fun x ->
match Filename.concat dir x with
| p when Sys.is_directory p -> aux acc p
| p ->
let k = fspath_to_key t p in
if String.starts_with ~prefix k then k :: acc else acc)
@@ Array.to_list xs
in aux [] @@ key_to_fspath t ""
walk t [] (key_to_fspath t prefix)

let erase_prefix t pre =
List.iter (erase t) @@ list_prefix t pre

let list_dir t prefix =
let module StrSet = Zarr.Util.StrSet in
let n = String.length prefix in
let rec aux acc dir =
let xs = Sys.readdir dir in
List.fold_left
(fun ((l, r) as a) x ->
match Filename.concat dir x with
| p when Sys.is_directory p -> aux a p
| p ->
let key = fspath_to_key t p in
let pred = String.starts_with ~prefix key in
match key with
| k when pred && String.contains_from k n '/' ->
StrSet.add String.(sub k 0 @@ 1 + index_from k n '/') l, r
| k when pred -> l, k :: r
| _ -> a) acc (Array.to_list xs)
in
let prefs, keys = aux (StrSet.empty, []) @@ key_to_fspath t "" in
keys, StrSet.elements prefs
let dir = key_to_fspath t prefix in
List.partition_map
(fun x ->
match Filename.concat dir x with
| p when Sys.is_directory p ->
Either.right @@ (fspath_to_key t p) ^ "/"
| p -> Either.left @@ fspath_to_key t p) (Array.to_list @@ Sys.readdir dir)
end

module U = Zarr.Util
Expand Down
9 changes: 5 additions & 4 deletions zarr-sync/test/test_sync.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -107,23 +107,24 @@ let test_storage
(Zarr.Storage.Invalid_data_type)
(fun () -> write_array store anode slice badarray);

let child = GroupNode.of_path "/some/child" in
let child = GroupNode.of_path "/some/child/group" in
create_group store child;
let arrays, groups = find_child_nodes store gnode in
assert_equal
~printer:string_of_list ["/arrnode"] (List.map ArrayNode.to_path arrays);
assert_equal
~printer:string_of_list ["/some"] (List.map GroupNode.to_path groups);

let c = find_child_nodes store @@ GroupNode.(root / "fakegroup") in
assert_equal ([], []) c;
assert_equal ([], []) @@ find_child_nodes store child;
assert_equal ([], []) @@ find_child_nodes store GroupNode.(root / "fakegroup");

let ac, gc = find_all_nodes store in
let got =
List.fast_sort String.compare @@
List.map ArrayNode.show ac @ List.map GroupNode.show gc in
assert_equal
~printer:string_of_list ["/"; "/arrnode"; "/some"; "/some/child"] got;
~printer:string_of_list
["/"; "/arrnode"; "/some"; "/some/child"; "/some/child/group"] got;

let nshape = [|25; 32; 10|] in
reshape store anode nshape;
Expand Down
10 changes: 5 additions & 5 deletions zarr/src/storage/memory.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -68,17 +68,17 @@ module Make (Deferred : Types.Deferred) = struct
else Deferred.return_unit

let list_dir t prefix =
let m = Atomic.get t in
let module S = Util.StrSet in
let+ xs = list t in
let n = String.length prefix in
let prefs, keys =
List.fold_left
(fun ((l, r) as a) key ->
StrMap.fold
(fun key _ ((l, r) as a) ->
let pred = String.starts_with ~prefix key in
match key with
| k when pred && String.contains_from k n '/' ->
let l' = S.add String.(sub k 0 @@ 1 + index_from k n '/') l in l', r
| k when pred -> l, k :: r
| _ -> a) (S.empty, []) xs
in keys, S.elements prefs
| _ -> a) m (S.empty, [])
in Deferred.return (keys, S.elements prefs)
end
19 changes: 12 additions & 7 deletions zarr/src/storage/storage.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -59,13 +59,18 @@ module Make (Io : Types.IO) = struct
Util.to_string @@ Util.member "node_type" @@ from_string s

let find_child_nodes t node =
let* _, gp = list_dir t @@ GroupNode.to_prefix node in
Deferred.fold_left
(fun (l, r) pre ->
let+ nt = node_type t @@ pre ^ "zarr.json" in
let p = "/" ^ String.(length pre - 1 |> sub pre 0) in
if nt = "array" then ArrayNode.of_path p :: l, r
else l, GroupNode.of_path p :: r) ([], []) gp
let prefix = GroupNode.to_prefix node in
let res = [], [] in
is_member t @@ prefix ^ "zarr.json" >>= function
| false -> Deferred.return res
| true ->
let* _, ps = list_dir t prefix in
Deferred.fold_left
(fun (l, r) pre ->
let+ nt = node_type t @@ pre ^ "zarr.json" in
let p = "/" ^ String.(length pre - 1 |> sub pre 0) in
if nt = "array" then ArrayNode.of_path p :: l, r
else l, GroupNode.of_path p :: r) res ps

let find_all_nodes t =
let* keys = list t in
Expand Down
Loading