From f772c3f46158483220b82c4a03c343dc3708951e Mon Sep 17 00:00:00 2001 From: Victor Allombert Date: Mon, 28 Jul 2025 16:25:34 +0200 Subject: [PATCH] Devtools/yes-wallet: fold that actually folds --- devtools/yes_wallet/get_delegates_022_PsRiotum.ml | 9 ++++++--- devtools/yes_wallet/get_delegates_023_PtSeouLo.ml | 9 ++++++--- devtools/yes_wallet/get_delegates_alpha.ml | 10 +++++++--- devtools/yes_wallet/sigs.ml | 2 +- devtools/yes_wallet/yes_wallet_lib.ml | 4 ++-- 5 files changed, 22 insertions(+), 12 deletions(-) diff --git a/devtools/yes_wallet/get_delegates_022_PsRiotum.ml b/devtools/yes_wallet/get_delegates_022_PsRiotum.ml index b75db3fbe12b..c9c0136bfa5f 100644 --- a/devtools/yes_wallet/get_delegates_022_PsRiotum.ml +++ b/devtools/yes_wallet/get_delegates_022_PsRiotum.ml @@ -53,9 +53,12 @@ module Get_delegates = struct |> Lwt.map Environment.wrap_tzresult let fold context ~init ~f = - let open Lwt_syntax in - let* l = list context in - Lwt_list.fold_left_s f init l + Storage.Contract.fold + (Alpha_context.Internal_for_tests.to_raw context) + ~order:`Undefined + ~init + ~f:(fun (contract : Contract_repr.t) v -> + f (Obj.magic contract : contract) v) let balance ctxt t = get_balance ctxt t |> Lwt.map Environment.wrap_tzresult diff --git a/devtools/yes_wallet/get_delegates_023_PtSeouLo.ml b/devtools/yes_wallet/get_delegates_023_PtSeouLo.ml index 2e1a567f286b..4e0bc191beb4 100644 --- a/devtools/yes_wallet/get_delegates_023_PtSeouLo.ml +++ b/devtools/yes_wallet/get_delegates_023_PtSeouLo.ml @@ -63,9 +63,12 @@ module Get_delegates = struct |> Lwt.map Environment.wrap_tzresult let fold context ~init ~f = - let open Lwt_syntax in - let* l = list context in - Lwt_list.fold_left_s f init l + Storage.Contract.fold + (Alpha_context.Internal_for_tests.to_raw context) + ~order:`Undefined + ~init + ~f:(fun (contract : Contract_repr.t) v -> + f (Obj.magic contract : contract) v) let balance ctxt t = get_balance ctxt t |> Lwt.map Environment.wrap_tzresult diff --git a/devtools/yes_wallet/get_delegates_alpha.ml b/devtools/yes_wallet/get_delegates_alpha.ml index 43267f076344..a96639a9c527 100644 --- a/devtools/yes_wallet/get_delegates_alpha.ml +++ b/devtools/yes_wallet/get_delegates_alpha.ml @@ -62,10 +62,14 @@ module Get_delegates = struct Alpha_context.Contract.get_manager_key context public_key_hash |> Lwt.map Environment.wrap_tzresult + (* FIXME: Expose and use the fold through Internal_for_tests. *) let fold context ~init ~f = - let open Lwt_syntax in - let* l = list context in - Lwt_list.fold_left_s f init l + Storage.Contract.fold + (Alpha_context.Internal_for_tests.to_raw context) + ~order:`Undefined + ~init + ~f:(fun (contract : Contract_repr.t) v -> + f (Obj.magic contract : contract) v) let balance ctxt t = get_balance ctxt t |> Lwt.map Environment.wrap_tzresult diff --git a/devtools/yes_wallet/sigs.ml b/devtools/yes_wallet/sigs.ml index ec9705a9aca5..f040d18577d1 100644 --- a/devtools/yes_wallet/sigs.ml +++ b/devtools/yes_wallet/sigs.ml @@ -97,7 +97,7 @@ module type PROTOCOL = sig Signature.public_key_hash -> Signature.public_key tzresult Lwt.t - val fold : context -> init:'a -> f:('a -> contract -> 'a Lwt.t) -> 'a Lwt.t + val fold : context -> init:'a -> f:(contract -> 'a -> 'a Lwt.t) -> 'a Lwt.t val balance : context -> contract -> Tez.t tzresult Lwt.t diff --git a/devtools/yes_wallet/yes_wallet_lib.ml b/devtools/yes_wallet/yes_wallet_lib.ml index 175856ec420c..b2119b772152 100644 --- a/devtools/yes_wallet/yes_wallet_lib.ml +++ b/devtools/yes_wallet/yes_wallet_lib.ml @@ -343,7 +343,7 @@ let get_contracts (module P : Sigs.PROTOCOL) ?dump_contracts context }, 0, 0 )) - ~f:(fun acc contract -> + ~f:(fun contract acc -> let*? contract_list_acc, total_info_acc, nb_account, nb_failures = acc in @@ -603,7 +603,7 @@ let get_rich_accounts (module P : Sigs.PROTOCOL) context let* accounts = Lwt.catch (fun () -> - P.Contract.fold context ~init:(Ok []) ~f:(fun acc contract -> + P.Contract.fold context ~init:(Ok []) ~f:(fun contract acc -> let*? acc in let* balance = P.Contract.balance context contract in if balance >= min_threshold_tz then -- GitLab