diff --git a/src/bin_client/main_client.ml b/src/bin_client/main_client.ml index 32c5fc0fa254676aed39eb9337a1ad8872e7504f..14c29a94a569abb3466b63ce8bff955eaaa9d59b 100644 --- a/src/bin_client/main_client.ml +++ b/src/bin_client/main_client.ml @@ -151,7 +151,7 @@ let select_commands ctxt {chain; block; protocol; _} = check_network ctxt >>= fun network -> get_commands_for_version ctxt network chain block protocol - >>|? fun (_, commands_for_version) -> + >|=? fun (_, commands_for_version) -> Client_rpc_commands.commands @ Tezos_signer_backends_unix.Ledger.commands () @ Client_keys_commands.commands network diff --git a/src/lib_clic/clic.ml b/src/lib_clic/clic.ml index e717ca18d9190b85f78b10fb527a35d61b092433..20ec7206631b0832b153f087243b99a1f0f1b2a6 100644 --- a/src/lib_clic/clic.ml +++ b/src/lib_clic/clic.ml @@ -55,7 +55,7 @@ let compose_parameters {converter = c1; autocomplete = a1'} } let map_parameter ~f {converter; autocomplete} = - {converter = (fun ctx s -> converter ctx s >>|? f); autocomplete} + {converter = (fun ctx s -> converter ctx s >|=? f); autocomplete} type label = {long : string; short : char option} @@ -846,7 +846,7 @@ let parse_arg : return_none | Some [s] -> trace (Bad_option_argument ("--" ^ long, command)) (converter ctx s) - >>|? fun x -> Some x + >|=? fun x -> Some x | Some (_ :: _) -> fail (Multiple_occurrences ("--" ^ long, command)) ) | DefArg {label = {long; short = _}; kind = {converter; _}; default; _} -> ( @@ -895,7 +895,7 @@ let rec parse_args : | AddArg (arg, rest) -> parse_arg ?command arg args_dict ctx >>=? fun arg -> - parse_args ?command rest args_dict ctx >>|? fun rest -> (arg, rest) + parse_args ?command rest args_dict ctx >|=? fun rest -> (arg, rest) let empty_args_dict = TzString.Map.empty @@ -1024,7 +1024,7 @@ let make_args_dict_filter ?command spec args = (make_arities_dict spec TzString.Map.empty) (TzString.Map.empty, []) args - >>|? fun (dict, remaining) -> (dict, List.rev remaining) + >|=? fun (dict, remaining) -> (dict, List.rev remaining) let ( >> ) arg1 arg2 = AddArg (arg1, arg2) @@ -1732,7 +1732,7 @@ let find_command tree initial_arguments = then fail (Help (Some command)) else make_args_dict_filter ~command spec remaining - >>|? fun (dict, remaining) -> + >|=? fun (dict, remaining) -> (command, dict, List.rev_append acc remaining) | (TPrefix {stop = Some cmd; _}, []) -> return (cmd, empty_args_dict, initial_arguments) @@ -1830,7 +1830,7 @@ let complete_options (type ctx) continuation args args_spec ind (ctx : ctx) = match args with | _ when ind = 0 -> continuation args 0 - >>|? fun cont_args -> cont_args @ remaining_spec seen args_spec + >|=? fun cont_args -> cont_args @ remaining_spec seen args_spec | [] -> Stdlib.failwith "cli_entries internal autocomplete error" | arg :: tl -> @@ -1840,7 +1840,7 @@ let complete_options (type ctx) continuation args args_spec ind (ctx : ctx) = match (arity, tl) with | (0, args) when ind = 0 -> continuation args 0 - >>|? fun cont_args -> remaining_spec seen args_spec @ cont_args + >|=? fun cont_args -> remaining_spec seen args_spec @ cont_args | (0, args) -> help args (ind - 1) seen | (1, _) when ind = 1 -> @@ -1864,7 +1864,7 @@ let complete_next_tree cctxt = function @ List.map fst prefix ) | TSeq (command, autocomplete) -> complete_func autocomplete cctxt - >>|? fun completions -> completions @ list_command_args command + >|=? fun completions -> completions @ list_command_args command | TParam {autocomplete; _} -> complete_func autocomplete cctxt | TStop command -> @@ -1904,7 +1904,7 @@ let autocompletion ~script ~cur_arg ~prev_arg ~args ~global_options commands in ( if prev_arg = script then complete_next_tree cctxt tree - >>|? fun command_completions -> + >|=? fun command_completions -> let (Argument {spec; _}) = global_options in list_args spec @ command_completions else @@ -1919,7 +1919,7 @@ let autocompletion ~script ~cur_arg ~prev_arg ~args ~global_options commands spec index cctxt ) - >>|? fun completions -> + >|=? fun completions -> List.filter (fun completion -> Re.Str.(string_match (regexp_string cur_arg) completion 0)) diff --git a/src/lib_client_base/client_keys.ml b/src/lib_client_base/client_keys.ml index 65cc823287a68bf28746da19c1b7baa7032cf308..2004b0f2496371203c7d985ac272864c6775e574 100644 --- a/src/lib_client_base/client_keys.ml +++ b/src/lib_client_base/client_keys.ml @@ -288,7 +288,7 @@ let sign cctxt ?watermark sk_uri buf = let append cctxt ?watermark loc buf = sign cctxt ?watermark loc buf - >>|? fun signature -> Signature.concat buf signature + >|=? fun signature -> Signature.concat buf signature let check ?watermark pk_uri signature buf = public_key pk_uri diff --git a/src/lib_error_monad/error_monad.ml b/src/lib_error_monad/error_monad.ml index 31e23872e7e505c6dd2b0377714f6b80035b6878..f103a8b3b3d9011d96bb9cb151d9155451639be6 100644 --- a/src/lib_error_monad/error_monad.ml +++ b/src/lib_error_monad/error_monad.ml @@ -2,7 +2,7 @@ (* *) (* Open Source License *) (* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) -(* Copyright (c) 2019 Nomadic Labs *) +(* Copyright (c) 2020 Nomadic Labs *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining a *) (* copy of this software and associated documentation files (the "Software"),*) diff --git a/src/lib_error_monad/error_monad.mli b/src/lib_error_monad/error_monad.mli index 8ab19ed755e14244d425605041c290e2de47d5f8..aa1a589ae8c67913404356ff31c52fd07b891251 100644 --- a/src/lib_error_monad/error_monad.mli +++ b/src/lib_error_monad/error_monad.mli @@ -2,6 +2,7 @@ (* *) (* Open Source License *) (* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* Copyright (c) 2020 Nomadic Labs *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining a *) (* copy of this software and associated documentation files (the "Software"),*) @@ -31,7 +32,7 @@ type error_category = | `Temporary (** Errors that may not happen in a later context *) | `Permanent (** Errors that will happen no matter the context *) ] -include Sig.CORE +include Sig.CORE with type error = Core.error include Sig.EXT with type error := error diff --git a/src/lib_error_monad/monad.ml b/src/lib_error_monad/monad.ml index f9e28edf769e704a3426b02425392c2d7a098797..cab4df91a6d9d671b5b9e47b1662597db56e420e 100644 --- a/src/lib_error_monad/monad.ml +++ b/src/lib_error_monad/monad.ml @@ -24,4 +24,6 @@ (* *) (*****************************************************************************) +type error = Core.error = .. + include Monad_maker.Make (Core) diff --git a/src/lib_error_monad/monad.mli b/src/lib_error_monad/monad.mli index 49a353ec27f967d09f4c5e5b1e6cfa79deb6c6c1..fb5a160a980a395eaeeda21dd6e051c50b6b66da 100644 --- a/src/lib_error_monad/monad.mli +++ b/src/lib_error_monad/monad.mli @@ -24,4 +24,6 @@ (* *) (*****************************************************************************) +type error = Core.error = .. + include Sig.MONAD with type error := Core.error diff --git a/src/lib_error_monad/monad_maker.ml b/src/lib_error_monad/monad_maker.ml index d0f4a5ed1cde43306491a938c72ce9a053af5ebd..e7493d06483d85ebda45dc9bb8e8ac5e3d0e20d1 100644 --- a/src/lib_error_monad/monad_maker.ml +++ b/src/lib_error_monad/monad_maker.ml @@ -126,7 +126,7 @@ struct let ( >|?= ) v f = match v with Error _ as e -> Lwt.return e | Ok v -> f v >>= Lwt.return_ok - let ( >>|? ) v f = v >>=? fun v -> Lwt.return_ok (f v) + let ( >|=? ) v f = v >>=? fun v -> Lwt.return_ok (f v) let ( >|= ) = Lwt.( >|= ) @@ -412,16 +412,42 @@ struct | h :: t -> fold_right_s f t init >>=? fun acc -> f h acc - let rec join = function + let join_p = Lwt.join + + let all_p = Lwt.all + + let both_p = Lwt.both + + let rec join_e = function | [] -> - return_unit - | t :: ts -> ( - t - >>= function - | Error _ as err -> - join ts >>=? fun () -> Lwt.return err - | Ok () -> - join ts ) + ok_unit + | t :: ts -> + t >>? fun () -> join_e ts + + let all_e ts = + let rec aux acc = function + | [] -> + Ok (List.rev acc) + | t :: ts -> + t >>? fun v -> aux (v :: acc) ts + in + aux [] ts + + let both_e a b = + match (a, b) with + | (Ok a, Ok b) -> + Ok (a, b) + | (Error err, Ok _) | (Ok _, Error err) -> + Error err + | (Error erra, Error errb) -> + (* Improve this once we improved the support for parallel traces *) + ignore errb ; Error erra + + let join_ep ts = all_p ts >|= join_e + + let all_ep ts = all_p ts >|= all_e + + let both_ep a b = both_p a b >|= fun (a, b) -> both_e a b let record_trace err result = match result with Ok _ as res -> res | Error errs -> Error (err :: errs) diff --git a/src/lib_error_monad/sig.ml b/src/lib_error_monad/sig.ml index 0eb0e5685512bc0a4830149ea70abd0b51429777..33772468ef79761a134f97bd7b977d3dbf3bf480 100644 --- a/src/lib_error_monad/sig.ml +++ b/src/lib_error_monad/sig.ml @@ -223,10 +223,6 @@ module type MONAD = sig - the next character is [=] for Lwt or [?] for Error - the next character (if present) is [=] for Lwt or [?] for Error, it is only used for operator that are within both monads. - - There is an exception to this pattern: [>>|?]. It is a combined map - operator and it should be [>|=?] according to the pattern. This is kept - as-is for backwards compatibility. *) (** Lwt's bind reexported. Following Lwt's convention, in this operator and @@ -249,7 +245,7 @@ module type MONAD = sig 'a tzresult Lwt.t -> ('a -> 'b tzresult Lwt.t) -> 'b tzresult Lwt.t (** Combined map operator. *) - val ( >>|? ) : 'a tzresult Lwt.t -> ('a -> 'b) -> 'b tzresult Lwt.t + val ( >|=? ) : 'a tzresult Lwt.t -> ('a -> 'b) -> 'b tzresult Lwt.t (** Injecting bind operator. This is for transitioning from the simple Error monad to the combined Error-Lwt monad. @@ -393,6 +389,25 @@ module type MONAD = sig val fold_right_s : ('a -> 'b -> 'b tzresult Lwt.t) -> 'a list -> 'b -> 'b tzresult Lwt.t - (** A {!Lwt.join} in the monad *) - val join : unit tzresult Lwt.t list -> unit tzresult Lwt.t + (** A few aliases for Lwt functions *) + val join_p : unit Lwt.t list -> unit Lwt.t + + val all_p : 'a Lwt.t list -> 'a list Lwt.t + + val both_p : 'a Lwt.t -> 'b Lwt.t -> ('a * 'b) Lwt.t + + (** Similar functions in the error monad *) + val join_e : unit tzresult list -> unit tzresult + + val all_e : 'a tzresult list -> 'a list tzresult + + val both_e : 'a tzresult -> 'b tzresult -> ('a * 'b) tzresult + + (** Similar functions in the combined monad *) + val join_ep : unit tzresult Lwt.t list -> unit tzresult Lwt.t + + val all_ep : 'a tzresult Lwt.t list -> 'a list tzresult Lwt.t + + val both_ep : + 'a tzresult Lwt.t -> 'b tzresult Lwt.t -> ('a * 'b) tzresult Lwt.t end diff --git a/src/lib_error_monad/tezos-error-monad.opam b/src/lib_error_monad/tezos-error-monad.opam index 53fa48272cb35f4c3f632dc9d717d7bbdad576f3..c4dba5058c0852d73f323aadd1a02db16a945874 100644 --- a/src/lib_error_monad/tezos-error-monad.opam +++ b/src/lib_error_monad/tezos-error-monad.opam @@ -8,6 +8,7 @@ license: "MIT" depends: [ "tezos-tooling" { with-test } "dune" { >= "1.11" } + "ocaml" { >= "4.07" } "tezos-stdlib" "data-encoding" { = "0.2" } "lwt" diff --git a/src/lib_p2p/test/process.ml b/src/lib_p2p/test/process.ml index 7a4bdb1d85f4622acca09499461fabd770501153..3c57ddd8a3b5124fb9ebcd18a8d810200ad9fb2d 100644 --- a/src/lib_p2p/test/process.ml +++ b/src/lib_p2p/test/process.ml @@ -188,24 +188,24 @@ let wait_all processes = lwt_log_error "Early error!" >>= fun () -> List.iter Lwt.cancel remaining ; - join remaining + join_ep remaining >>= fun _ -> failwith "A process finished with error %d !" n | Some ([Exn (Signaled n)], remaining) -> lwt_log_error "Early error!" >>= fun () -> List.iter Lwt.cancel remaining ; - join remaining + join_ep remaining >>= fun _ -> failwith "A process was killed by a SIG%s !" (signal_name n) | Some ([Exn (Stopped n)], remaining) -> lwt_log_error "Early error!" >>= fun () -> List.iter Lwt.cancel remaining ; - join remaining + join_ep remaining >>= fun _ -> failwith "A process was stopped by a SIG%s !" (signal_name n) | Some (err, remaining) -> lwt_log_error "@[Unexpected error!@,%a@]" pp_print_error err >>= fun () -> List.iter Lwt.cancel remaining ; - join remaining + join_ep remaining >>= fun _ -> failwith "A process finished with an unexpected error !" diff --git a/src/lib_p2p/test/test_p2p_io_scheduler.ml b/src/lib_p2p/test/test_p2p_io_scheduler.ml index 2672f7b6d84df9522174af340045b72d6f1cb42d..09d10f8e14ab243b66d16e606dfb54916cd1b7f6 100644 --- a/src/lib_p2p/test/test_p2p_io_scheduler.ml +++ b/src/lib_p2p/test/test_p2p_io_scheduler.ml @@ -115,7 +115,7 @@ let server ?(display_client_stat = true) ?max_download_speed ?read_queue_size accept_n main_socket n >>=? fun conns -> let conns = List.map (P2p_io_scheduler.register sched) conns in - Lwt.join (List.map receive conns) + Lwt_list.iter_p receive conns >>= fun () -> iter_p P2p_io_scheduler.close conns >>=? fun () -> diff --git a/src/lib_protocol_environment/environment_V0.ml b/src/lib_protocol_environment/environment_V0.ml index dc9cffd533d45534b48ee282576f05e16849d346..23136f2315e478b5c93e3d959cf19cd381891db6 100644 --- a/src/lib_protocol_environment/environment_V0.ml +++ b/src/lib_protocol_environment/environment_V0.ml @@ -538,6 +538,8 @@ struct include Error_core include Tezos_error_monad.Monad_maker.Make (Error_core) + + let ( >>|? ) = ( >|=? ) (* for backward compatibility *) end let () = diff --git a/src/lib_shell/bench/bench_tool.ml b/src/lib_shell/bench/bench_tool.ml index 36b58bb379ecc3c1244633fdbcb0d586ba632c9f..52ea0dfbf8a1d19635535c1b333c72059db1b3cb 100644 --- a/src/lib_shell/bench/bench_tool.ml +++ b/src/lib_shell/bench/bench_tool.ml @@ -243,7 +243,7 @@ let step gen_state blk : Block.t tzresult Lwt.t = in (* Nonce *) Alpha_services.Helpers.current_level ~offset:1l Block.rpc_ctxt blk - >>|? (function + >|=? (function | Level.{expected_commitment = true; cycle; level; _} -> if_debug (fun () -> Format.printf "[DEBUG] Committing a nonce\n%!") ; @@ -277,7 +277,7 @@ let step gen_state blk : Block.t tzresult Lwt.t = (* Revelations *) (* TODO debug cycle *) Alpha_services.Helpers.current_level ~offset:1l Incremental.rpc_ctxt inc - >>|? (function + >|=? (function | {cycle; level; _} -> ( if_debug (fun () -> Format.printf "[DEBUG] Current cycle : %a\n%!" Cycle.pp cycle) ; diff --git a/src/lib_signer_backends/unix/with_ledger.ml b/src/lib_signer_backends/unix/with_ledger.ml index 0fdd1212ceef30aeab8223441f25ddc57a671bee..e0036acae38f605d2eb40d9c2da9d78410442f3b 100644 --- a/src/lib_signer_backends/unix/with_ledger.ml +++ b/src/lib_signer_backends/unix/with_ledger.ml @@ -179,7 +179,7 @@ module Ledger_commands = struct ~main_chain_id ~main_hwm ~test_hwm) ) - >>|? fun pk -> + >|=? fun pk -> match curve with | Ed25519 | Bip32_ed25519 -> let pk = Cstruct.to_bytes pk in @@ -239,7 +239,7 @@ module Ledger_commands = struct let open Ledgerwallet_tezos.Version in if version.major < 2 then wrap_ledger_cmd (fun pp -> Ledgerwallet_tezos.get_authorized_key ~pp hid) - >>|? fun path -> `Legacy_path path + >|=? fun path -> `Legacy_path path else wrap_ledger_cmd (fun pp -> Ledgerwallet_tezos.get_authorized_path_and_curve ~pp hid) diff --git a/src/lib_stdlib/test/test_lwt_pipe.ml b/src/lib_stdlib/test/test_lwt_pipe.ml index 41c27084ae0491ab7b02e3555eac64e78892be02..842c38ebceb6782cb68bc0778f4c739b45877ce5 100644 --- a/src/lib_stdlib/test/test_lwt_pipe.ml +++ b/src/lib_stdlib/test/test_lwt_pipe.ml @@ -42,8 +42,8 @@ let rec gen acc f = function 0 -> acc | n -> gen (f () :: acc) f (pred n) let run qsize nbp nbc p c = let q = Lwt_pipe.create ~size:(qsize, fun () -> qsize) () in let producers = gen [] (fun () -> producer q p) nbp in - let consumers = gen [] (fun () -> consumer q c) nbc in - Lwt.join producers <&> Lwt.join consumers + let consumers_and_producers = gen producers (fun () -> consumer q c) nbc in + Lwt.join consumers_and_producers let main () = let qsize = ref 10 in diff --git a/src/lib_storage/context_dump.ml b/src/lib_storage/context_dump.ml index a2d853369d199cf89084848cd7a300e9777c07cb..32656ded1b594ed8c54d9841ef34734ab6478492 100644 --- a/src/lib_storage/context_dump.ml +++ b/src/lib_storage/context_dump.ml @@ -455,7 +455,7 @@ module Make (I : Dump_interface) = struct Buffer.add_bytes buf b let get_mbytes rbuf = - get_int64 rbuf >>|? Int64.to_int + get_int64 rbuf >|=? Int64.to_int >>=? fun l -> let b = Bytes.create l in read_mbytes rbuf b >>=? fun () -> return b @@ -464,7 +464,7 @@ module Make (I : Dump_interface) = struct let get_command rbuf = get_mbytes rbuf - >>|? fun bytes -> Data_encoding.Binary.of_bytes_exn command_encoding bytes + >|=? fun bytes -> Data_encoding.Binary.of_bytes_exn command_encoding bytes let set_root buf block_header info parents block_data = let root = Root {block_header; info; parents; block_data} in @@ -523,7 +523,7 @@ module Make (I : Dump_interface) = struct let read_snapshot_metadata rbuf = get_mbytes rbuf - >>|? fun bytes -> + >|=? fun bytes -> Data_encoding.(Binary.of_bytes_exn snapshot_metadata_encoding) bytes let check_version v = diff --git a/src/proto_004_Pt24m4xi/lib_client/client_proto_context.ml b/src/proto_004_Pt24m4xi/lib_client/client_proto_context.ml index 17fbb49634b1db4d546badcff52c02bb442fe897..6471228c7b89f0f0b5b2ef611cd970775471d89c 100644 --- a/src/proto_004_Pt24m4xi/lib_client/client_proto_context.ml +++ b/src/proto_004_Pt24m4xi/lib_client/client_proto_context.ml @@ -79,7 +79,7 @@ let list_contract_labels (cctxt : #Alpha_client_context.full) ~chain ~block = let h_b58 = Contract.to_b58check h in return (nm, h_b58, kind)) contracts - >>|? List.rev + >|=? List.rev let get_manager (cctxt : #Alpha_client_context.full) ~chain ~block source = Client_proto_contracts.get_manager cctxt ~chain ~block source diff --git a/src/proto_005_PsBabyM1/lib_client/client_proto_context.ml b/src/proto_005_PsBabyM1/lib_client/client_proto_context.ml index 46b35a1830997f9b2c81eef125f9c2d42a0a4f17..64b5ef586c36a5139982cdbbac694bdcaaf50186 100644 --- a/src/proto_005_PsBabyM1/lib_client/client_proto_context.ml +++ b/src/proto_005_PsBabyM1/lib_client/client_proto_context.ml @@ -83,7 +83,7 @@ let list_contract_labels cctxt ~chain ~block = let h_b58 = Contract.to_b58check h in return (nm, h_b58, kind)) contracts - >>|? List.rev + >|=? List.rev type period_info = { current_period_kind : Voting_period.kind; diff --git a/src/proto_006_PsCARTHA/lib_client/client_proto_context.ml b/src/proto_006_PsCARTHA/lib_client/client_proto_context.ml index ece0796c6f127e43c1ac5c7cc616aa17a3d1b4fd..6d47e8b8d074fa38502235676d3d0f0b3596f9fe 100644 --- a/src/proto_006_PsCARTHA/lib_client/client_proto_context.ml +++ b/src/proto_006_PsCARTHA/lib_client/client_proto_context.ml @@ -191,7 +191,7 @@ let list_contract_labels cctxt ~chain ~block = let h_b58 = Contract.to_b58check h in return (nm, h_b58, kind)) contracts - >>|? List.rev + >|=? List.rev let message_added_contract (cctxt : #full) name = cctxt#message "Contract memorized as %s." name diff --git a/src/proto_006_PsCARTHA/lib_protocol/test/helpers/assert.ml b/src/proto_006_PsCARTHA/lib_protocol/test/helpers/assert.ml index b36644df4fdda402a89470eea46636e2f7aff6a7..56d92a5158604de48ab167af4027b3f7ebeb08b8 100644 --- a/src/proto_006_PsCARTHA/lib_protocol/test/helpers/assert.ml +++ b/src/proto_006_PsCARTHA/lib_protocol/test/helpers/assert.ml @@ -123,7 +123,7 @@ let print_balances ctxt id = Contract.balance ~kind:Fees ctxt id >>=? fun fees -> Contract.balance ~kind:Rewards ctxt id - >>|? fun rewards -> + >|=? fun rewards -> Format.printf "\nMain: %s\nDeposit: %s\nFees: %s\nRewards: %s\n" (Alpha_context.Tez.to_string main) diff --git a/src/proto_006_PsCARTHA/lib_protocol/test/helpers/block.ml b/src/proto_006_PsCARTHA/lib_protocol/test/helpers/block.ml index 11de707be2430fb693e114a2a3682dceacd38d26..f66c04e03ba3f5b8badc21745769bd1835f26ee3 100644 --- a/src/proto_006_PsCARTHA/lib_protocol/test/helpers/block.ml +++ b/src/proto_006_PsCARTHA/lib_protocol/test/helpers/block.ml @@ -196,7 +196,7 @@ module Forge = struct assert false ) >>=? fun fitness -> Alpha_services.Helpers.current_level ~offset:1l rpc_ctxt pred - >>|? (function + >|=? (function | {expected_commitment = true; _} -> Some (fst (Proto_Nonce.generate ())) | {expected_commitment = false; _} -> @@ -392,7 +392,7 @@ let apply header ?(operations = []) pred = Main.finalize_block vstate >>=? fun (validation, _result) -> return validation.context) >|= Environment.wrap_error - >>|? fun context -> + >|=? fun context -> let hash = Block_header.hash header in {hash; header; operations; context} diff --git a/src/proto_alpha/lib_client/client_proto_context.ml b/src/proto_alpha/lib_client/client_proto_context.ml index ece0796c6f127e43c1ac5c7cc616aa17a3d1b4fd..6d47e8b8d074fa38502235676d3d0f0b3596f9fe 100644 --- a/src/proto_alpha/lib_client/client_proto_context.ml +++ b/src/proto_alpha/lib_client/client_proto_context.ml @@ -191,7 +191,7 @@ let list_contract_labels cctxt ~chain ~block = let h_b58 = Contract.to_b58check h in return (nm, h_b58, kind)) contracts - >>|? List.rev + >|=? List.rev let message_added_contract (cctxt : #full) name = cctxt#message "Contract memorized as %s." name diff --git a/src/proto_alpha/lib_protocol/test/helpers/assert.ml b/src/proto_alpha/lib_protocol/test/helpers/assert.ml index b36644df4fdda402a89470eea46636e2f7aff6a7..56d92a5158604de48ab167af4027b3f7ebeb08b8 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/assert.ml +++ b/src/proto_alpha/lib_protocol/test/helpers/assert.ml @@ -123,7 +123,7 @@ let print_balances ctxt id = Contract.balance ~kind:Fees ctxt id >>=? fun fees -> Contract.balance ~kind:Rewards ctxt id - >>|? fun rewards -> + >|=? fun rewards -> Format.printf "\nMain: %s\nDeposit: %s\nFees: %s\nRewards: %s\n" (Alpha_context.Tez.to_string main) diff --git a/src/proto_alpha/lib_protocol/test/helpers/block.ml b/src/proto_alpha/lib_protocol/test/helpers/block.ml index b64a4fc6910e45fce1812ec22cb00ab77ef1eb35..77c79e43848f5f6ec409a066a41a3091c7aadefe 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/block.ml +++ b/src/proto_alpha/lib_protocol/test/helpers/block.ml @@ -196,7 +196,7 @@ module Forge = struct assert false ) >>=? fun fitness -> Alpha_services.Helpers.current_level ~offset:1l rpc_ctxt pred - >>|? (function + >|=? (function | {expected_commitment = true; _} -> Some (fst (Proto_Nonce.generate ())) | {expected_commitment = false; _} -> @@ -392,7 +392,7 @@ let apply header ?(operations = []) pred = Main.finalize_block vstate >>=? fun (validation, _result) -> return validation.context) >|= Environment.wrap_error - >>|? fun context -> + >|=? fun context -> let hash = Block_header.hash header in {hash; header; operations; context}