Shell: improve Utils

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
+let unopt ~default = function
-  | None -> x
+  | 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)
+    (Format.pp_print_list ~pp_sep:Format.pp_print_newline
-    (split ' ' description)
+       (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

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

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

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 pos = unopt ~default:0 pos in
-  let len = unopt (maxlen - pos) len in
+  let len = unopt ~default:(maxlen - pos) len in
   assert (0 <= pos && pos < maxlen) ;
   assert (len <= maxlen - pos) ;
   let rec loop pos len =

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 timestamp = Utils.unopt ~default:(Time.now ()) time in
-      let net_id = Utils.unopt bi.net net_id in
+      let net_id = Utils.unopt ~default:bi.net net_id in
-      let predecessor = Utils.unopt bi.hash pred in
+      let predecessor = Utils.unopt ~default:bi.hash pred in
       let res =
         Store.Block.to_bytes {
           shell = { net_id ; predecessor ; timestamp ; fitness ; operations } ;

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"

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 {

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 store = unopt ~default:default_cfg.store store in
-         let context = unopt default_cfg.context context in
+         let context = unopt ~default:default_cfg.context context in
-         let protocol = unopt default_cfg.protocol protocol 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 peers_cache = unopt ~default:default_cfg.peers_cache peers_cache in
-         let log_output = unopt default_cfg.log_output (map_option log_of_string log_output) in
+         let log_output = unopt ~default:default_cfg.log_output (map_option log_of_string log_output) in
-         let min_connections = unopt default_cfg.min_connections min_connections in
+         let min_connections = unopt ~default:default_cfg.min_connections min_connections in
-         let max_connections = unopt default_cfg.max_connections max_connections in
+         let max_connections = unopt ~default:default_cfg.max_connections max_connections in
-         let expected_connections = unopt default_cfg.expected_connections expected_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 base_dir = Utils.(unopt ~default:(unopt ~default:default_cfg.base_dir base_dir) sandbox) in
-    let config_file = Utils.(unopt ((unopt base_dir sandbox) // "config")) config_file 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 ;
+        min_connections = Utils.unopt ~default:cfg.min_connections min_connections ;
-        max_connections = Utils.unopt cfg.max_connections max_connections ;
+        max_connections = Utils.unopt ~default:cfg.max_connections max_connections ;
-        expected_connections = Utils.unopt cfg.expected_connections expected_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 ; *)

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

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 ;

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
         )