Skip to content

Commit

Permalink
Merge pull request #2201 from metanivek/classify_volumes
Browse files Browse the repository at this point in the history
  • Loading branch information
metanivek authored Feb 27, 2023
2 parents 2601b96 + b91dfe5 commit eddf517
Show file tree
Hide file tree
Showing 3 changed files with 90 additions and 63 deletions.
75 changes: 43 additions & 32 deletions src/irmin-pack/layout.ml
Original file line number Diff line number Diff line change
Expand Up @@ -98,35 +98,46 @@ let is_number s =
acc && is_digit)
true l

type classification =
[ `Branch
| `Control
| `Dict
| `Gc_result of int
| `Mapping of int
| `Prefix of int
| `Reachable of int
| `Sorted of int
| `Suffix of int
| `V1_or_v2_pack ]
[@@deriving irmin]

let classify_filename s : classification option =
match String.split_on_char '.' s with
| [ "store"; "pack" ] -> Some `V1_or_v2_pack
| [ "store"; "branches" ] -> Some `Branch
| [ "store"; "control" ] -> Some `Control
| [ "store"; "dict" ] -> Some `Dict
| [ "store"; g; "out" ] when is_number g ->
Some (`Gc_result (int_of_string g))
| [ "store"; g; "reachable" ] when is_number g ->
Some (`Reachable (int_of_string g))
| [ "store"; g; "sorted" ] when is_number g ->
Some (`Sorted (int_of_string g))
| [ "store"; g; "mapping" ] when is_number g ->
Some (`Mapping (int_of_string g))
| [ "store"; g; "prefix" ] when is_number g ->
Some (`Prefix (int_of_string g))
| [ "store"; g; "suffix" ] when is_number g ->
Some (`Suffix (int_of_string g))
| _ -> None
module Classification = struct
module Upper = struct
type t =
[ `Branch
| `Control
| `Dict
| `Gc_result of int
| `Mapping of int
| `Prefix of int
| `Reachable of int
| `Sorted of int
| `Suffix of int
| `V1_or_v2_pack
| `Unknown ]
[@@deriving irmin]

let v s : t =
match String.split_on_char '.' s with
| [ "store"; "pack" ] -> `V1_or_v2_pack
| [ "store"; "branches" ] -> `Branch
| [ "store"; "control" ] -> `Control
| [ "store"; "dict" ] -> `Dict
| [ "store"; g; "out" ] when is_number g -> `Gc_result (int_of_string g)
| [ "store"; g; "reachable" ] when is_number g ->
`Reachable (int_of_string g)
| [ "store"; g; "sorted" ] when is_number g -> `Sorted (int_of_string g)
| [ "store"; g; "mapping" ] when is_number g -> `Mapping (int_of_string g)
| [ "store"; g; "prefix" ] when is_number g -> `Prefix (int_of_string g)
| [ "store"; g; "suffix" ] when is_number g -> `Suffix (int_of_string g)
| _ -> `Unknown
end

module Volume = struct
type t = [ `Mapping | `Data | `Control | `Unknown ] [@@deriving irmin]

let v s : t =
match String.split_on_char '.' s with
| [ "volume"; "control" ] -> `Control
| [ "volume"; "mapping" ] -> `Mapping
| [ "volume"; "data" ] -> `Data
| _ -> `Unknown
end
end
10 changes: 5 additions & 5 deletions src/irmin-pack/unix/file_manager.ml
Original file line number Diff line number Diff line change
Expand Up @@ -260,12 +260,12 @@ struct
let to_remove =
List.filter
(fun filename ->
match Irmin_pack.Layout.classify_filename filename with
| None | Some (`Branch | `Control | `Dict | `V1_or_v2_pack) -> false
| Some (`Prefix g | `Mapping g) -> g <> generation
| Some (`Suffix idx) ->
match Irmin_pack.Layout.Classification.Upper.v filename with
| `Unknown | `Branch | `Control | `Dict | `V1_or_v2_pack -> false
| `Prefix g | `Mapping g -> g <> generation
| `Suffix idx ->
idx < chunk_start_idx || idx > chunk_start_idx + chunk_num
| Some (`Reachable _ | `Sorted _ | `Gc_result _) -> true)
| `Reachable _ | `Sorted _ | `Gc_result _ -> true)
files
in
List.iter
Expand Down
68 changes: 42 additions & 26 deletions test/irmin-pack/test_pack.ml
Original file line number Diff line number Diff line change
Expand Up @@ -496,38 +496,54 @@ module Branch = struct
end

module Layout = struct
let test_classify_filename () =
let test_classify_upper_filename () =
let module V1_and_v2 = Irmin_pack.Layout.V1_and_v2 in
let module V4 = Irmin_pack.Layout.V4 in
let c =
Alcotest.(
check (option (testable_repr Irmin_pack.Layout.classification_t)))
""
in
let classif = Irmin_pack.Layout.classify_filename in
c (Some `V1_or_v2_pack) (V1_and_v2.pack ~root:"" |> classif);
c (Some `Branch) (V4.branch ~root:"" |> classif);
c (Some `Control) (V4.control ~root:"" |> classif);
c (Some `Dict) (V4.dict ~root:"" |> classif);
c (Some (`Gc_result 0)) (V4.gc_result ~generation:0 ~root:"" |> classif);
c (Some (`Reachable 1)) (V4.reachable ~generation:1 ~root:"" |> classif);
c (Some (`Sorted 10)) (V4.sorted ~generation:10 ~root:"" |> classif);
c (Some (`Mapping 100)) (V4.mapping ~generation:100 ~root:"" |> classif);
c (Some (`Prefix 1000)) (V4.prefix ~generation:1000 ~root:"" |> classif);
c (Some (`Suffix 42)) (V4.suffix_chunk ~chunk_idx:42 ~root:"" |> classif);
c None (V4.prefix ~generation:(-1) ~root:"" |> classif);
c None (classif "store.toto");
c None (classif "store.");
c None (classif "store");
c None (classif "store.00.prefix");
c None (classif "store.01.prefix");
c None (classif "./store.0.prefix");
let module Classification = Irmin_pack.Layout.Classification.Upper in
let c = Alcotest.(check (testable_repr Classification.t)) "" in
let classif = Classification.v in
c `V1_or_v2_pack (V1_and_v2.pack ~root:"" |> classif);
c `Branch (V4.branch ~root:"" |> classif);
c `Control (V4.control ~root:"" |> classif);
c `Dict (V4.dict ~root:"" |> classif);
c (`Gc_result 0) (V4.gc_result ~generation:0 ~root:"" |> classif);
c (`Reachable 1) (V4.reachable ~generation:1 ~root:"" |> classif);
c (`Sorted 10) (V4.sorted ~generation:10 ~root:"" |> classif);
c (`Mapping 100) (V4.mapping ~generation:100 ~root:"" |> classif);
c (`Prefix 1000) (V4.prefix ~generation:1000 ~root:"" |> classif);
c (`Suffix 42) (V4.suffix_chunk ~chunk_idx:42 ~root:"" |> classif);
c `Unknown (V4.prefix ~generation:(-1) ~root:"" |> classif);
c `Unknown (classif "store.toto");
c `Unknown (classif "store.");
c `Unknown (classif "store");
c `Unknown (classif "store.00.prefix");
c `Unknown (classif "store.01.prefix");
c `Unknown (classif "./store.0.prefix");
Lwt.return_unit

let test_classify_volume_filename () =
let module V1_and_v2 = Irmin_pack.Layout.V1_and_v2 in
let module V5 = Irmin_pack.Layout.V5.Volume in
let module Classification = Irmin_pack.Layout.Classification.Volume in
let c = Alcotest.(check (testable_repr Classification.t)) "" in
let classif = Classification.v in
c `Control (V5.control ~root:"" |> classif);
c `Mapping (V5.mapping ~root:"" |> classif);
c `Data (V5.data ~root:"" |> classif);
c `Unknown (classif "store.toto");
c `Unknown (classif "store.");
c `Unknown (classif "store");
c `Unknown (classif "store.00.prefix");
c `Unknown (classif "store.01.prefix");
c `Unknown (classif "./store.0.prefix");
Lwt.return_unit

let tests =
[
Alcotest_lwt.test_case "classify_filename" `Quick (fun _switch ->
test_classify_filename);
Alcotest_lwt.test_case "classify upper files" `Quick (fun _switch ->
test_classify_upper_filename);
Alcotest_lwt.test_case "classify volume files" `Quick (fun _switch ->
test_classify_volume_filename);
]
end

Expand Down

0 comments on commit eddf517

Please sign in to comment.