diff --git a/src/minutils/utils.ml b/src/minutils/utils.ml index bf6f36792..db569c68c 100644 --- a/src/minutils/utils.ml +++ b/src/minutils/utils.ml @@ -9,13 +9,16 @@ module StringMap = Map.Make (String) -let split delim ?(limit = max_int) path = +let split delim ?(dup = true) ?(limit = max_int) path = let l = String.length path in let rec do_slashes acc limit i = if i >= l then List.rev acc else if String.get path i = delim then - do_slashes acc limit (i + 1) + if dup then + do_slashes acc limit (i + 1) + else + do_split acc limit (i + 1) else do_split acc limit i and do_split acc limit i = @@ -55,8 +58,8 @@ let iter_option ~f = function | None -> () | Some x -> f x -let unopt x = function - | None -> x +let unopt ~default = function + | None -> default | Some x -> x let unopt_map ~f ~default = function @@ -85,8 +88,16 @@ let list_sub l n = list_rev_sub l n |> List.rev let display_paragraph ppf description = Format.fprintf ppf "@[%a@]" - (fun ppf words -> List.iter (Format.fprintf ppf "%s@ ") words) - (split ' ' description) + (Format.pp_print_list ~pp_sep:Format.pp_print_newline + (fun ppf line -> + Format.pp_print_list ~pp_sep:Format.pp_print_space + (fun ppf w -> + (* replace   by real spaces... *) + Format.fprintf ppf "%s@ " + (Stringext.replace_all ~pattern:"\xC2\xA0" ~with_:" " w)) + ppf + (split ' ' line))) + (split ~dup:false '\n' description) let rec remove_elem_from_list nb = function | [] -> [] @@ -128,6 +139,8 @@ let rec (--) i j = if j < i then acc else loop (j :: acc) (pred j) in loop [] j +let rec repeat n x = if n <= 0 then [] else x :: repeat (pred n) x + let take_n_unsorted n l = let rec loop acc n = function | [] -> l diff --git a/src/minutils/utils.mli b/src/minutils/utils.mli index 0b3ec0f00..c22b03aa8 100644 --- a/src/minutils/utils.mli +++ b/src/minutils/utils.mli @@ -16,12 +16,12 @@ val split_path: string -> string list (** Splits a string on a delimier character, grouping multiple delimiters, and ignoring delimiters at the beginning and end of string, if [limit] is passed, stops after [limit] split(s). *) -val split: char -> ?limit: int -> string -> string list +val split: char -> ?dup:bool -> ?limit: int -> string -> string list val map_option: f:('a -> 'b) -> 'a option -> 'b option val apply_option: f:('a -> 'b option) -> 'a option -> 'b option val iter_option: f:('a -> unit) -> 'a option -> unit -val unopt: 'a -> 'a option -> 'a +val unopt: default:'a -> 'a option -> 'a val unopt_map: f:('a -> 'b) -> default:'b -> 'a option -> 'b val unopt_list: 'a option list -> 'a list val first_some: 'a option -> 'a option -> 'a option @@ -51,6 +51,8 @@ val (<<) : ('b -> 'c) -> ('a -> 'b) -> 'a -> 'c (** Sequence: [i--j] is the sequence [i;i+1;...;j-1;j] *) val (--) : int -> int -> int list +val repeat: int -> 'a -> 'a list + (** [take_n n l] returns the [n] first elements of [n]. When [compare] is provided, it returns the [n] greatest element of [l]. *) val take_n: ?compare:('a -> 'a -> int) -> int -> 'a list -> 'a list diff --git a/src/node/net/p2p_connection_pool_types.ml b/src/node/net/p2p_connection_pool_types.ml index 2e2bcd5f9..2d48bed66 100644 --- a/src/node/net/p2p_connection_pool_types.ml +++ b/src/node/net/p2p_connection_pool_types.ml @@ -451,7 +451,7 @@ module Gid_info = struct let enc = Data_encoding.list (encoding metadata_encoding) in Data_encoding_ezjsonm.read_file path >|= map_option ~f:(Data_encoding.Json.destruct enc) >|= - unopt [] + unopt ~default:[] let save path metadata_encoding peers = let open Data_encoding in diff --git a/src/node/net/p2p_io_scheduler.ml b/src/node/net/p2p_io_scheduler.ml index 0a0acb087..14c00b357 100644 --- a/src/node/net/p2p_io_scheduler.ml +++ b/src/node/net/p2p_io_scheduler.ml @@ -147,7 +147,7 @@ module Scheduler(IO : IO) = struct canceler = Canceler.create () ; worker = Lwt.return_unit ; counter = Moving_average.create ~init:0 ~alpha ; - max_speed ; quota = unopt 0 max_speed ; + max_speed ; quota = unopt ~default:0 max_speed ; quota_updated = Lwt_condition.create () ; readys = Lwt_condition.create () ; readys_high = Queue.create () ; @@ -358,9 +358,9 @@ let write_now { write_queue } msg = Lwt_pipe.push_now write_queue msg let read_from conn ?pos ?len buf msg = let maxlen = MBytes.length buf in - let pos = unopt 0 pos in + let pos = unopt ~default:0 pos in assert (0 <= pos && pos < maxlen) ; - let len = unopt (maxlen - pos) len in + let len = unopt ~default:(maxlen - pos) len in assert (len <= maxlen - pos) ; match msg with | Ok msg -> @@ -400,8 +400,8 @@ let read conn ?pos ?len buf = let read_full conn ?pos ?len buf = let maxlen = MBytes.length buf in - let pos = unopt 0 pos in - let len = unopt (maxlen - pos) len in + let pos = unopt ~default:0 pos in + let len = unopt ~default:(maxlen - pos) len in assert (0 <= pos && pos < maxlen) ; assert (len <= maxlen - pos) ; let rec loop pos len = diff --git a/src/node/shell/node_rpc.ml b/src/node/shell/node_rpc.ml index d555bcbdd..6082a6a5a 100644 --- a/src/node/shell/node_rpc.ml +++ b/src/node/shell/node_rpc.ml @@ -394,9 +394,9 @@ let build_rpc_directory node = let dir = let implementation (net_id, pred, time, fitness, operations, header) = Node.RPC.block_info node (`Head 0) >>= fun bi -> - let timestamp = Utils.unopt (Time.now ()) time in - let net_id = Utils.unopt bi.net net_id in - let predecessor = Utils.unopt bi.hash pred in + let timestamp = Utils.unopt ~default:(Time.now ()) time in + let net_id = Utils.unopt ~default:bi.net net_id in + let predecessor = Utils.unopt ~default:bi.hash pred in let res = Store.Block.to_bytes { shell = { net_id ; predecessor ; timestamp ; fitness ; operations } ; diff --git a/src/node/shell/node_rpc_services.ml b/src/node/shell/node_rpc_services.ml index ba6be7dcb..393b3ad49 100644 --- a/src/node/shell/node_rpc_services.ml +++ b/src/node/shell/node_rpc_services.ml @@ -524,7 +524,7 @@ let inject_block = (fun (block, blocking, force) -> (block, Some blocking, force)) (fun (block, blocking, force) -> - (block, Utils.unopt true blocking, force)) + (block, Utils.unopt ~default:true blocking, force)) (obj3 (req "data" bytes) (opt "blocking" @@ -557,7 +557,7 @@ let inject_operation = ~input: (conv (fun (block, blocking, force) -> (block, Some blocking, force)) - (fun (block, blocking, force) -> (block, unopt true blocking, force)) + (fun (block, blocking, force) -> (block, unopt ~default:true blocking, force)) (obj3 (req "signedOperationContents" (describe ~title: "Tezos signed operation (hex encoded)" @@ -611,7 +611,7 @@ let inject_protocol = ~input: (conv (fun (proto, blocking, force) -> (rpc_of_proto proto, Some blocking, force)) - (fun (proto, blocking, force) -> (proto_of_rpc proto, unopt true blocking, force)) + (fun (proto, blocking, force) -> (proto_of_rpc proto, unopt ~default:true blocking, force)) (obj3 (req "protocol" (describe ~title: "Tezos protocol" diff --git a/src/node/shell/state.ml b/src/node/shell/state.ml index 2a11aa2a2..584dde856 100644 --- a/src/node/shell/state.ml +++ b/src/node/shell/state.ml @@ -699,7 +699,8 @@ module Valid_block = struct (* TODO check coherency: test_protocol. *) Lwt.return res | None -> - let test_protocol = Utils.unopt genesis.protocol test_protocol in + let test_protocol = + Utils.unopt ~default:genesis.protocol test_protocol in Context.create_genesis_context vstate.index genesis test_protocol >>= fun _context -> Block.db_store vstate.block_db genesis.block { diff --git a/src/node_main.ml b/src/node_main.ml index 84cfdb75e..f9a0543f8 100644 --- a/src/node_main.ml +++ b/src/node_main.ml @@ -207,19 +207,19 @@ module Cfg_file = struct (rpc_addr, cors_origins, cors_headers), log_output) -> let open Utils in - let store = unopt default_cfg.store store in - let context = unopt default_cfg.context context in - let protocol = unopt default_cfg.protocol protocol in + let store = unopt ~default:default_cfg.store store in + let context = unopt ~default:default_cfg.context context in + let protocol = unopt ~default:default_cfg.protocol protocol in let net_addr = map_option sockaddr_of_string_exn net_addr in - let net_addr, net_port = unopt (default_cfg.net_addr, default_cfg.net_port) net_addr in + let net_addr, net_port = unopt ~default:(default_cfg.net_addr, default_cfg.net_port) net_addr in let rpc_addr = map_option sockaddr_of_string_exn rpc_addr in - let peers = unopt [] peers in + let peers = unopt ~default:[] peers in let peers = ListLabels.map peers ~f:sockaddr_of_string_exn in - let peers_cache = unopt default_cfg.peers_cache peers_cache in - let log_output = unopt default_cfg.log_output (map_option log_of_string log_output) in - let min_connections = unopt default_cfg.min_connections min_connections in - let max_connections = unopt default_cfg.max_connections max_connections in - let expected_connections = unopt default_cfg.expected_connections expected_connections in + let peers_cache = unopt ~default:default_cfg.peers_cache peers_cache in + let log_output = unopt ~default:default_cfg.log_output (map_option log_of_string log_output) in + let min_connections = unopt ~default:default_cfg.min_connections min_connections in + let max_connections = unopt ~default:default_cfg.max_connections max_connections in + let expected_connections = unopt ~default:default_cfg.expected_connections expected_connections in (* let local_discovery = map_option local_discovery ~f:mcast_params_of_string in *) { default_cfg with store ; context ; protocol ; @@ -320,8 +320,8 @@ module Cmdline = struct (* local_discovery *) peers closed rpc_addr tls cors_origins cors_headers reset_cfg update_cfg = - let base_dir = Utils.(unopt (unopt default_cfg.base_dir base_dir) sandbox) in - let config_file = Utils.(unopt ((unopt base_dir sandbox) // "config")) config_file in + let base_dir = Utils.(unopt ~default:(unopt ~default:default_cfg.base_dir base_dir) sandbox) in + let config_file = Utils.(unopt ~default:((unopt ~default:base_dir sandbox) // "config")) config_file in let no_config () = warn "Found no config file at %s" config_file; warn "Using factory defaults"; @@ -355,9 +355,9 @@ module Cmdline = struct sandbox = Utils.first_some sandbox cfg.sandbox ; sandbox_param = Utils.first_some sandbox_param cfg.sandbox_param ; log_level = Utils.first_some log_level cfg.log_level ; - min_connections = Utils.unopt cfg.min_connections min_connections ; - max_connections = Utils.unopt cfg.max_connections max_connections ; - expected_connections = Utils.unopt cfg.expected_connections expected_connections ; + min_connections = Utils.unopt ~default:cfg.min_connections min_connections ; + max_connections = Utils.unopt ~default:cfg.max_connections max_connections ; + expected_connections = Utils.unopt ~default:cfg.expected_connections expected_connections ; net_addr = (match net_saddr with None -> cfg.net_addr | Some (addr, _) -> addr) ; net_port = (match net_saddr with None -> cfg.net_port | Some (_, port) -> port) ; (* local_discovery = Utils.first_some local_discovery cfg.local_discovery ; *) diff --git a/src/utils/error_monad.ml b/src/utils/error_monad.ml index 8ff3375ae..45d84349d 100644 --- a/src/utils/error_monad.ml +++ b/src/utils/error_monad.ml @@ -74,7 +74,7 @@ module Make() = struct category ; from_error ; encoding_case ; - pp = Utils.unopt (json_pp encoding) pp } :: !error_kinds + pp = Utils.unopt ~default:(json_pp encoding) pp } :: !error_kinds let register_wrapped_error_kind category ~id ~title ~description ?pp diff --git a/test/test_p2p_connection_pool.ml b/test/test_p2p_connection_pool.ml index bf3e8b20c..1435f2ec9 100644 --- a/test/test_p2p_connection_pool.ml +++ b/test/test_p2p_connection_pool.ml @@ -158,7 +158,7 @@ let make_net points repeat n = let addr = ref Ipaddr.V6.localhost let port = ref (1024 + Random.int 8192) let clients = ref 10 -let repeat = ref 5 +let repeat_connections = ref 5 let spec = Arg.[ @@ -169,7 +169,8 @@ let spec = Arg.[ "--clients", Set_int clients, " Number of concurrent clients." ; - "--repeat", Set_int repeat, " Number of connections/disconnections." ; + "--repeat", Set_int repeat_connections, + " Number of connections/disconnections." ; "-v", Unit (fun () -> Lwt_log_core.(add_rule "p2p.connection-pool" Info)), " Log up to info msgs" ; @@ -186,7 +187,7 @@ let main () = Arg.parse spec anon_fun usage_msg ; let ports = !port -- (!port + !clients - 1) in let points = List.map (fun port -> !addr, port) ports in - Lwt_list.iter_p (make_net points !repeat) (0 -- (!clients - 1)) + Lwt_list.iter_p (make_net points !repeat_connections) (0 -- (!clients - 1)) let () = Sys.catch_break true ; diff --git a/test/test_state.ml b/test/test_state.ml index 4c9c01c2a..c23aab57d 100644 --- a/test/test_state.ml +++ b/test/test_state.ml @@ -39,7 +39,7 @@ let incr_fitness fitness = | [ _ ; fitness ] -> Pervasives.( Data_encoding.Binary.of_bytes Data_encoding.int64 fitness - |> Utils.unopt 0L + |> Utils.unopt ~default:0L |> Int64.succ |> Data_encoding.Binary.to_bytes Data_encoding.int64 )