Client: replace (e)printfs with Cli_entries.{error,warning,message} equivalent

This commit is contained in:
Guillem Rieu 2016-11-22 17:28:25 +01:00 committed by Benjamin Canou
parent 3c2453f00d
commit a48d8c0026
6 changed files with 53 additions and 56 deletions

View File

@ -128,8 +128,8 @@ let parse_args ?version usage dispatcher =
~current:(ref 0) Sys.argv args (anon dispatch) (usage base_args) ;
Lwt.return ()
with Sys_error msg ->
Printf.eprintf "Error: can't read the configuration file: %s\n%!" msg;
exit 1
Cli_entries.error
"Error: can't read the configuration file: %s\n%!" msg
end else begin
try
(* parse once again with contextual options *)
@ -139,9 +139,8 @@ let parse_args ?version usage dispatcher =
file_group#write config_file#get ;
Lwt.return ()
with Sys_error msg ->
Printf.eprintf
"Warning: can't create the default configuration file: %s\n%!" msg ;
Lwt.return ()
Cli_entries.warning
"Warning: can't create the default configuration file: %s\n%!" msg
end) >>= fun () ->
begin match dispatch `End with
| `Res res ->
@ -161,7 +160,7 @@ let preparse name argv =
None
with Found s -> Some s
let preparse_args () : Node_rpc_services.Blocks.block =
let preparse_args () : Node_rpc_services.Blocks.block Lwt.t =
begin
match preparse "-base-dir" Sys.argv with
| None -> ()
@ -174,11 +173,13 @@ let preparse_args () : Node_rpc_services.Blocks.block =
end ;
begin
if Sys.file_exists config_file#get then try
file_group#read config_file#get ;
(file_group#read config_file#get ;
Lwt.return ())
with Sys_error msg ->
Printf.eprintf "Error: can't read the configuration file: %s\n%!" msg;
exit 1
end ;
Cli_entries.error
"Error: can't read the configuration file: %s\n%!" msg
else Lwt.return ()
end >>= fun () ->
begin
match preparse "-addr" Sys.argv with
| None -> ()
@ -186,17 +187,20 @@ let preparse_args () : Node_rpc_services.Blocks.block =
end ;
begin
match preparse "-port" Sys.argv with
| None -> ()
| None -> Lwt.return ()
| Some port ->
try incoming_port#set (int_of_string port)
try
incoming_port#set (int_of_string port) ;
Lwt.return ()
with _ ->
Printf.eprintf "Error: can't parse the -port option: %S.\n%!" port ;
exit 1 end ;
Cli_entries.error
"Error: can't parse the -port option: %S.\n%!" port
end >>= fun () ->
match preparse "-block" Sys.argv with
| None -> `Prevalidation
| None -> Lwt.return `Prevalidation
| Some x ->
match Node_rpc_services.Blocks.parse_block x with
| Error _ ->
Printf.eprintf "Error: can't parse the -block option: %S.\n%!" x ;
exit 1
| Ok b -> b
Cli_entries.error
"Error: can't parse the -block option: %S.\n%!" x
| Ok b -> Lwt.return b

View File

@ -272,12 +272,12 @@ let list url () =
Format.pp_print_list
(fun ppf (n,t) -> display ppf ([ n ], tpath @ [ n ], t))
in
Format.printf "@ @[<v 2>Available services:@ @ %a@]@."
display (args, args, tree) ;
Cli_entries.message "@ @[<v 2>Available services:@ @ %a@]@."
display (args, args, tree) >>= fun () ->
if !collected_args <> [] then
Format.printf "@,@[<v 2>Dynamic parameter description:@ @ %a@]@."
(Format.pp_print_list display_arg) !collected_args ;
return ()
Cli_entries.message "@,@[<v 2>Dynamic parameter description:@ @ %a@]@."
(Format.pp_print_list display_arg) !collected_args
else Lwt.return ()
let schema url () =
@ -285,14 +285,12 @@ let schema url () =
let open RPC.Description in
Client_node_rpcs.describe ~recurse:false args >>= function
| Static { service = Some { input ; output } } ->
Printf.printf "Input schema:\n%s\nOutput schema:\n%s\n%!"
Cli_entries.message "Input schema:\n%s\nOutput schema:\n%s\n%!"
(Data_encoding.Json.to_string (Json_schema.to_json input))
(Data_encoding.Json.to_string (Json_schema.to_json output));
return ()
(Data_encoding.Json.to_string (Json_schema.to_json output))
| _ ->
Printf.printf
"No service found at this URL (but this is a valid prefix)\n%!" ;
return ()
Cli_entries.message
"No service found at this URL (but this is a valid prefix)\n%!"
let fill_in schema =
let open Json_schema in
@ -311,13 +309,11 @@ let call url () =
error "%s" msg
| Ok json ->
Client_node_rpcs.get_json args json >>= fun json ->
Printf.printf "Output:\n%s\n%!" (Data_encoding.Json.to_string json) ;
return ()
Cli_entries.message "Output:\n%s\n%!" (Data_encoding.Json.to_string json)
end
| _ ->
Printf.printf
"No service found at this URL (but this is a valid prefix)\n%!" ;
return ()
Cli_entries.message
"No service found at this URL (but this is a valid prefix)\n%!"
let () =
let open Cli_entries in

View File

@ -179,6 +179,5 @@ let commands () =
@@ RawContractAlias.alias_param
@@ stop)
(fun (_, contract) () ->
Format.printf "%a\n%!" Contract.pp contract ;
Lwt.return ()) ;
Cli_entries.message "%a\n%!" Contract.pp contract) ;
]

View File

@ -207,8 +207,7 @@ let commands () =
@@ stop)
(fun (_, program) () ->
Program.to_source program >>= fun source ->
Format.printf "%s\n" source ;
Lwt.return ()) ;
Cli_entries.message "%s\n" source) ;
command
~group: "programs"
~desc: "ask the node to run a program"
@ -225,7 +224,7 @@ let commands () =
if !trace_stack then
Client_proto_rpcs.Helpers.trace_code (block ()) program (storage, input) >>= function
| Ok (storage, output, trace) ->
Format.printf "@[<v 0>@[<v 2>storage@,%a@]@,@[<v 2>output@,%a@]@,@[<v 2>trace@,%a@]@]@."
Cli_entries.message "@[<v 0>@[<v 2>storage@,%a@]@,@[<v 2>output@,%a@]@,@[<v 2>trace@,%a@]@]@."
(print_ir (fun _ -> false)) storage
(print_ir (fun _ -> false)) output
(Format.pp_print_list
@ -235,18 +234,16 @@ let commands () =
loc gas
(Format.pp_print_list (print_ir (fun _ -> false)))
stack))
trace ;
Lwt.return ()
trace
| Error errs ->
pp_print_error Format.err_formatter errs ;
error "error running program"
else
Client_proto_rpcs.Helpers.run_code (block ()) program (storage, input) >>= function
| Ok (storage, output) ->
Format.printf "@[<v 0>@[<v 2>storage@,%a@]@,@[<v 2>output@,%a@]@]@."
Cli_entries.message "@[<v 0>@[<v 2>storage@,%a@]@,@[<v 2>output@,%a@]@]@."
(print_ir (fun _ -> false)) storage
(print_ir (fun _ -> false)) output ;
Lwt.return ()
(print_ir (fun _ -> false)) output
| Error errs ->
pp_print_error Format.err_formatter errs ;
error "error running program") ;
@ -267,10 +264,10 @@ let commands () =
print_program
(fun l -> List.mem_assoc l type_map)
Format.std_formatter program ;
Format.printf "@." ;
List.iter
Cli_entries.message "@." >>= fun () ->
Lwt_list.iter_s
(fun (loc, (before, after)) ->
Format.printf
Cli_entries.message
"%3d@[<v 0> : [ @[<v 0>%a ]@]@,-> [ @[<v 0>%a ]@]@]@."
loc
(Format.pp_print_list (print_ir (fun _ -> false)))
@ -278,8 +275,8 @@ let commands () =
(Format.pp_print_list (print_ir (fun _ -> false)))
after)
(List.sort compare type_map)
end ;
Lwt.return ()
end
else Lwt.return ()
| Error errs ->
pp_print_error Format.err_formatter errs ;
error "ill-typed program") ;

View File

@ -68,15 +68,16 @@ let reveal_block_nonces ?force block_hashes =
| Error _ ->
Lwt.fail Not_found)
(fun _ ->
Format.eprintf "Cannot find block %a in the chain. (ignoring)@."
Block_hash.pp_short hash ;
Cli_entries.warning
"Cannot find block %a in the chain. (ignoring)@."
Block_hash.pp_short hash >>= fun () ->
Lwt.return_none))
block_hashes >>= fun block_infos ->
map_filter_s (fun (bi : Client_mining_blocks.block_info) ->
Client_proto_nonces.find bi.hash >>= function
| None ->
Format.eprintf "Cannot find nonces for block %a (ignoring)@."
Block_hash.pp_short bi.hash ;
Cli_entries.warning "Cannot find nonces for block %a (ignoring)@."
Block_hash.pp_short bi.hash >>= fun () ->
return None
| Some nonce ->
return (Some (bi.hash, (bi.level.level, nonce))))
@ -93,8 +94,8 @@ let reveal_nonces ?force () =
Client_proto_nonces.find bi.hash >>= function
| None -> return None
| Some nonce ->
Format.eprintf "Found nonce for %a (level: %a)@."
Block_hash.pp_short bi.hash Level.pp bi.level ;
Cli_entries.warning "Found nonce for %a (level: %a)@."
Block_hash.pp_short bi.hash Level.pp bi.level >>= fun () ->
return (Some (bi.hash, (bi.level.level, nonce))))
block_infos >>=? fun blocks ->
do_reveal ?force block blocks

View File

@ -38,7 +38,7 @@ let main () =
Sodium.Random.stir () ;
catch
(fun () ->
let block = Client_config.preparse_args () in
Client_config.preparse_args () >>= fun block ->
Lwt.catch
(fun () ->
Client_node_rpcs.Blocks.protocol block)