Alpha: fix Storage_functors.Indexed_data_storage.fold

This commit is contained in:
Benjamin Canou 2018-03-29 17:37:34 +02:00 committed by Grégoire Henry
parent 27486e500a
commit ba09cdf883

View File

@ -215,24 +215,17 @@ module Make_indexed_data_storage
let clear s = let clear s =
C.remove_rec s [] >>= fun t -> C.remove_rec s [] >>= fun t ->
Lwt.return (C.project t) Lwt.return (C.project t)
let fold s ~init ~f =
let fold_keys s ~init ~f =
let rec dig i path acc = let rec dig i path acc =
if Compare.Int.(i <= 1) then if Compare.Int.(i <= 1) then
C.fold s path ~init:acc ~f:begin fun k acc -> C.fold s path ~init:acc ~f:begin fun k acc ->
match k with match k with
| `Dir _ -> Lwt.return acc | `Dir _ -> Lwt.return acc
| `Key file -> | `Key file ->
C.get_option s file >>= function match I.of_path file with
| None -> Lwt.return acc | None -> assert false
| Some b -> | Some path -> f path acc
match V.of_bytes b with
| Error _ ->
(* Silently ignore unparsable data *)
Lwt.return acc
| Ok v ->
match I.of_path file with
| None -> assert false
| Some path -> f path v acc
end end
else else
C.fold s path ~init:acc ~f:begin fun k acc -> C.fold s path ~init:acc ~f:begin fun k acc ->
@ -242,17 +235,17 @@ module Make_indexed_data_storage
end in end in
dig I.path_length [] init dig I.path_length [] init
let fold s ~init ~f =
let f path acc =
get s path >>= function
| Error _ ->
(* FIXME: silently ignore unparsable data *)
Lwt.return acc
| Ok v ->
f path v acc in
fold_keys s ~init ~f
let bindings s = let bindings s =
fold s ~init:[] ~f:(fun p v acc -> Lwt.return ((p,v) :: acc)) fold s ~init:[] ~f:(fun p v acc -> Lwt.return ((p,v) :: acc))
let fold_keys s ~init ~f =
C.fold s [] ~init
~f:(fun p acc ->
match p with
| `Dir _ -> Lwt.return acc
| `Key p ->
match I.of_path p with
| None -> assert false
| Some path -> f path acc)
let keys s = let keys s =
fold_keys s ~init:[] ~f:(fun p acc -> Lwt.return (p :: acc)) fold_keys s ~init:[] ~f:(fun p acc -> Lwt.return (p :: acc))