balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
src/client/client_config.ml
View File

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

28
src/client/client_generic_rpcs.ml
View File

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

3
src/client/embedded/bootstrap/client_proto_contracts.ml
View File

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

23
src/client/embedded/bootstrap/client_proto_programs.ml
View File

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

13
src/client/embedded/bootstrap/mining/client_mining_main.ml
View File

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

2
src/client_main.ml
View File

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