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

Client: add --long and -s(hort) options

Browse Source
This commit is contained in:
Benjamin Canou 2018-02-13 23:50:24 +01:00
parent 3729e4f3ce
commit d983f601a6
10 changed files with 217 additions and 143 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

216
src/lib_base/cli_entries.ml
View File

@ -18,17 +18,17 @@ let parameter ?autocomplete converter =
type ('a, 'ctx) arg =
| Arg : { doc : string ;
parameter : string ;
parameter : string * char option ;
placeholder : string ;
kind : ('p, 'ctx) parameter } ->
('p option, 'ctx) arg
| DefArg : { doc : string ;
parameter : string ;
parameter : string * char option ;
placeholder : string ;
kind : ('p, 'ctx) parameter ;
default : string } -> ('p, 'ctx) arg
| Switch : { doc : string ;
parameter : string } ->
parameter : string * char option } ->
(bool, 'ctx) arg
type ('a, 'arg) args =
@ -77,6 +77,7 @@ type error += Command_not_found : string list * 'ctx command list -> error
type error += Unknown_option : string * 'ctx command -> error
type error += Option_expected_argument : string * 'ctx command option -> error
type error += Bad_option_argument : string * 'ctx command option -> error
type error += Multiple_occurences : string * 'ctx command option -> error
type error += Extra_arguments : string list * 'ctx command -> error
let trim s = (* config-file wokaround *)
@ -96,18 +97,25 @@ let print_desc ppf doc =
| Some doc ->
Format.fprintf ppf "%s@{<full>@\n @[<hov 0>%a@]@}" short Format.pp_print_text doc
let print_parameter ppf = function
| long, None -> Format.fprintf ppf "--%s" long
| long, Some short -> Format.fprintf ppf "-%c --%s" short long
let print_options_detailed (type ctx) =
let help_option : type a.Format.formatter -> (a, ctx) arg -> unit =
fun ppf -> function
| Arg { parameter ; placeholder ; doc ; _ } ->
Format.fprintf ppf "@{<opt>%s <%s>@}: %a"
parameter placeholder print_desc doc ;
Format.fprintf ppf "@{<opt>%a <%s>@}: %a"
print_parameter parameter placeholder
print_desc doc ;
| DefArg { parameter ; placeholder ; doc ; default ; _ } ->
Format.fprintf ppf "@{<opt>%s <%s>@}: %a"
parameter placeholder print_desc (doc ^ "\nDefaults to `" ^ default ^ "`.")
Format.fprintf ppf "@{<opt>%a <%s>@}: %a"
print_parameter parameter placeholder
print_desc (doc ^ "\nDefaults to `" ^ default ^ "`.")
| Switch { parameter ; doc } ->
Format.fprintf ppf "@{<opt>%s@}: %a"
parameter print_desc doc in
Format.fprintf ppf "@{<opt>%a@}: %a"
print_parameter parameter
print_desc doc in
let rec help : type b. Format.formatter -> (b, ctx) args -> unit =
fun ppf -> function
| NoArgs -> ()
@ -128,11 +136,14 @@ let print_options_brief (type ctx) =
type a. Format.formatter -> (a, ctx) arg -> unit =
fun ppf -> function
| DefArg { parameter ; placeholder ; _ } ->
Format.fprintf ppf "[@{<opt>%s <%s>@}]" parameter placeholder
Format.fprintf ppf "[@{<opt>%a <%s>@}]"
print_parameter parameter placeholder
| Arg { parameter ; placeholder ; _ } ->
Format.fprintf ppf "[@{<opt>%s <%s>@}]" parameter placeholder
Format.fprintf ppf "[@{<opt>%a <%s>@}]"
print_parameter parameter placeholder
| Switch { parameter ; _ } ->
Format.fprintf ppf "[@{<opt>%s@}]" parameter
Format.fprintf ppf "[@{<opt>%a@}]"
print_parameter parameter
in let rec help : type b. Format.formatter -> (b, ctx) args -> unit =
fun ppf -> function
| NoArgs -> ()
@ -503,9 +514,9 @@ let usage_internal ppf ~executable_name ~global_options ?(highlights=[]) command
@{<command>@{<commandline>\
%s [@{<opt>global options@}] command @{<opt>[command options]@}@}@}@,\
@{<command>@{<commandline>\
%s @{<opt>-help@} (for global options)@}@}@,\
%s @{<opt>--help@} (for global options)@}@}@,\
@{<command>@{<commandline>\
%s [@{<opt>global options@}] command @{<opt>-help@} (for command options)@}@}\
%s [@{<opt>global options@}] command @{<opt>--help@} (for command options)@}@}\
@}@,@,\
@{<title>To browse the documentation@}@,\
@{<list>\
@ -522,42 +533,39 @@ let usage_internal ppf ~executable_name ~global_options ?(highlights=[]) command
(fun ppf () -> if by_group <> [] then Format.fprintf ppf "@,@,") ()
print_groups by_group
let arg ~doc ~parameter ~placeholder kind =
let arg ~doc ?short ~long ~placeholder kind =
Arg { doc ;
parameter ;
parameter = (long, short) ;
placeholder ;
kind }
let default_arg ~doc ~parameter ~placeholder ~default kind =
let default_arg ~doc ?short ~long ~placeholder ~default kind =
DefArg { doc ;
placeholder ;
parameter ;
parameter = (long, short) ;
kind ;
default }
let switch ~doc ~parameter =
Switch { doc ; parameter }
let switch ~doc ?short ~long () =
Switch { doc ; parameter = (long, short) }
let parse_arg :
type a ctx. ?command:_ command -> (a, ctx) arg -> string option TzString.Map.t -> ctx -> a tzresult Lwt.t =
type a ctx. ?command:_ command -> (a, ctx) arg -> string list TzString.Map.t -> ctx -> a tzresult Lwt.t =
fun ?command spec args_dict ctx ->
match spec with
| Arg { parameter ; kind = { converter ; _ } ; _ } ->
begin
try
begin
match TzString.Map.find parameter args_dict with
| None -> return None
| Some s ->
(trace
(Bad_option_argument (parameter, command))
(converter ctx s)) >>|? fun x ->
Some x
end
with Not_found ->
return None
| Arg { parameter = (long, _) ; kind = { converter ; _ } ; _ } ->
begin match TzString.Map.find long args_dict with
| exception Not_found -> return None
| [] -> return None
| [ s ] ->
(trace
(Bad_option_argument ("--" ^ long, command))
(converter ctx s)) >>|? fun x ->
Some x
| _ :: _ ->
fail (Multiple_occurences ("--" ^ long, command))
end
| DefArg { parameter ; kind = { converter ; _ } ; default ; _ } ->
| DefArg { parameter = (long, _) ; kind = { converter ; _ } ; default ; _ } ->
converter ctx default >>= fun default ->
begin match default with
| Ok x -> return x
@ -565,22 +573,28 @@ let parse_arg :
invalid_arg
(Format.sprintf
"Value provided as default for '%s' could not be parsed by converter function."
parameter) end >>=? fun default ->
begin try
match TzString.Map.find parameter args_dict with
| None -> return default
| Some s ->
trace
(Bad_option_argument (parameter, command))
(converter ctx s)
with Not_found -> return default
long) end >>=? fun default ->
begin match TzString.Map.find long args_dict with
| exception Not_found -> return default
| [] -> return default
| [ s ] ->
(trace
(Bad_option_argument (long, command))
(converter ctx s))
| _ :: _ ->
fail (Multiple_occurences (long, command))
end
| Switch { parameter = (long, _) ; _ } ->
begin match TzString.Map.find long args_dict with
| exception Not_found -> return false
| [] -> return false
| [ _ ] -> return true
| _ :: _ -> fail (Multiple_occurences (long, command))
end
| Switch { parameter ; _ } ->
return (TzString.Map.mem parameter args_dict)
(* Argument parsing *)
let rec parse_args :
type a ctx. ?command:_ command -> (a, ctx) args -> string option TzString.Map.t -> ctx -> a tzresult Lwt.t =
type a ctx. ?command:_ command -> (a, ctx) args -> string list TzString.Map.t -> ctx -> a tzresult Lwt.t =
fun ?command spec args_dict ctx ->
match spec with
| NoArgs -> return ()
@ -592,18 +606,21 @@ let rec parse_args :
let empty_args_dict = TzString.Map.empty
let rec make_arities_dict :
type a b. int TzString.Map.t -> (a, b) args -> int TzString.Map.t =
fun acc -> function
type a b. (a, b) args -> (int * string) TzString.Map.t -> (int * string) TzString.Map.t =
fun args acc -> match args with
| NoArgs -> acc
| AddArg (arg, rest) ->
let recur parameter num =
make_arities_dict (TzString.Map.add parameter num acc) rest in
begin
match arg with
| Arg { parameter ; _ } -> recur parameter 1
| DefArg { parameter ; _ } -> recur parameter 1
| Switch { parameter ; _ } -> recur parameter 0
end
let recur (long, short) num =
(match short with
| None -> acc
| Some c -> TzString.Map.add ("-" ^ String.make 1 c) (num, long) acc) |>
TzString.Map.add ("-" ^ long) (num, long) |>
TzString.Map.add ("--" ^ long) (num, long) |>
make_arities_dict rest in
match arg with
| Arg { parameter ; _ } -> recur parameter 1
| DefArg { parameter ; _ } -> recur parameter 1
| Switch { parameter ; _ } -> recur parameter 0
type error += Help : 'a command option -> error
@ -611,8 +628,10 @@ let check_help_flag ?command = function
| ("-help" | "--help") :: _ -> fail (Help command)
| _ -> return ()
(* ignore_autocomplete is a hack to have the initial arguments get parsed
even if autocomplete command is running *)
let add_occurrence long value acc =
try TzString.Map.add long (TzString.Map.find long acc) acc
with Not_found -> TzString.Map.add long [ value ] acc
let make_args_dict_consume ?command spec args =
let rec make_args_dict completing arities acc args =
check_help_flag ?command args >>=? fun () ->
@ -620,12 +639,14 @@ let make_args_dict_consume ?command spec args =
| [] -> return (acc, [])
| arg :: tl ->
if TzString.Map.mem arg arities
then let arity = TzString.Map.find arg arities in
then
let arity, long = TzString.Map.find arg arities in
check_help_flag ?command tl >>=? fun () ->
match arity, tl with
| 0, tl' -> make_args_dict completing arities (TzString.Map.add arg None acc) tl'
| 0, tl' ->
make_args_dict completing arities (add_occurrence long "" acc) tl'
| 1, value :: tl' ->
make_args_dict completing arities (TzString.Map.add arg (Some value) acc) tl'
make_args_dict completing arities (add_occurrence long value acc) tl'
| 1, [] when completing ->
return (acc, [])
| 1, [] ->
@ -633,7 +654,7 @@ let make_args_dict_consume ?command spec args =
| _, _ ->
raise (Failure "cli_entries: Arguments with arity not equal to 1 or 0 not supported")
else return (acc, args)
in make_args_dict false (make_arities_dict TzString.Map.empty spec) TzString.Map.empty args
in make_args_dict false (make_arities_dict spec TzString.Map.empty) TzString.Map.empty args
let make_args_dict_filter ?command spec args =
let rec make_args_dict arities (dict, other_args) args =
@ -642,17 +663,17 @@ let make_args_dict_filter ?command spec args =
| [] -> return (dict, other_args)
| arg :: tl ->
if TzString.Map.mem arg arities
then let arity = TzString.Map.find arg arities in
then let arity, long = TzString.Map.find arg arities in
check_help_flag ?command tl >>=? fun () ->
match arity, tl with
| 0, tl -> make_args_dict arities (TzString.Map.add arg None dict, other_args) tl
| 1, value :: tl' -> make_args_dict arities (TzString.Map.add arg (Some value) dict, other_args) tl'
| 0, tl -> make_args_dict arities (add_occurrence long "" dict, other_args) tl
| 1, value :: tl' -> make_args_dict arities (add_occurrence long value dict, other_args) tl'
| 1, [] -> fail (Option_expected_argument (arg, command))
| _, _ ->
raise (Failure "cli_entries: Arguments with arity not equal to 1 or 0 not supported")
else make_args_dict arities (dict, arg :: other_args) tl
in make_args_dict
(make_arities_dict TzString.Map.empty spec)
(make_arities_dict spec TzString.Map.empty)
(TzString.Map.empty, [])
args >>|? fun (dict, remaining) ->
(dict, List.rev remaining)
@ -924,14 +945,19 @@ let find_command tree initial_arguments =
fail (Command_not_found (List.rev acc, []))
in traverse tree initial_arguments []
let get_arg : type a ctx. (a, ctx) arg -> string = function
| Arg { parameter ; _ } -> parameter
| DefArg { parameter ; _ } -> parameter
| Switch { parameter ; _ } -> parameter
let get_arg
: type a ctx. (a, ctx) arg -> string list
= fun arg ->
let long, short =
match arg with
| Arg { parameter ; _ } -> parameter
| DefArg { parameter ; _ } -> parameter
| Switch { parameter ; _ } -> parameter in
("--" ^ long) :: match short with None -> [] | Some c -> [ "-" ^ String.make 1 c ]
let rec list_args : type arg ctx. (arg, ctx) args -> string list = function
| NoArgs -> []
| AddArg (arg, args) -> (get_arg arg) :: (list_args args)
| AddArg (arg, args) -> get_arg arg @ list_args args
let complete_func autocomplete cctxt =
match autocomplete with
@ -960,18 +986,18 @@ let rec remaining_spec :
fun seen -> function
| NoArgs -> []
| AddArg (arg, rest) ->
let parameter = get_arg_parameter arg in
if StringSet.mem parameter seen
then (remaining_spec seen rest)
else parameter :: (remaining_spec seen rest)
let (long, _) = get_arg_parameter arg in
if StringSet.mem long seen
then remaining_spec seen rest
else get_arg arg @ remaining_spec seen rest
let complete_options (type ctx) continuation args args_spec ind (ctx : ctx) =
let arities = make_arities_dict TzString.Map.empty args_spec in
let arities = make_arities_dict args_spec TzString.Map.empty in
let rec complete_spec : type a. string -> (a, ctx) args -> string list tzresult Lwt.t =
fun name -> function
| NoArgs -> return []
| AddArg (arg, rest) ->
if (get_arg_parameter arg) = name
if fst (get_arg_parameter arg) = name
then complete_arg ctx arg
else complete_spec name rest in
let rec help args ind seen =
@ -985,17 +1011,16 @@ let complete_options (type ctx) continuation args args_spec ind (ctx : ctx) =
| arg :: tl ->
if TzString.Map.mem arg arities
then
let seen = StringSet.add arg seen in
begin
match TzString.Map.find arg arities, tl with
| 0, args when ind = 0 ->
continuation args 0 >>|? fun cont_args ->
remaining_spec seen args_spec @ cont_args
| 0, args -> help args (ind - 1) seen
| 1, _ when ind = 1 -> complete_spec arg args_spec
| 1, _ :: tl -> help tl (ind - 2) seen
| _ -> Pervasives.failwith "cli_entries internal error, invalid arity"
end
let arity, long = TzString.Map.find arg arities in
let seen = StringSet.add long seen in
match arity, tl with
| 0, args when ind = 0 ->
continuation args 0 >>|? fun cont_args ->
remaining_spec seen args_spec @ cont_args
| 0, args -> help args (ind - 1) seen
| 1, _ when ind = 1 -> complete_spec arg args_spec
| 1, _ :: tl -> help tl (ind - 2) seen
| _ -> Pervasives.failwith "cli_entries internal error, invalid arity"
else continuation args ind
in help args ind StringSet.empty
@ -1047,7 +1072,7 @@ let autocompletion ~script ~cur_arg ~prev_arg ~args ~global_options commands cct
then complete_next_tree cctxt tree >>|? fun command_completions ->
begin
let (Argument { spec ; _ }) = global_options in
remaining_spec StringSet.empty spec @ command_completions
list_args spec @ command_completions
end
else
match ind 0 args with
@ -1103,7 +1128,8 @@ let add_manual ~executable_name ~global_options format ppf commands =
1. Shows command mnemonics with short descriptions.\n\
2. Show commands and arguments with short descriptions\n\
3. Show everything"
~parameter:"-verbosity"
~long:"verbosity"
~short:'v'
~placeholder:"0|1|2|3"
(parameter
~autocomplete: (fun _ -> return [ "0" ; "1" ; "2" ; "3" ])
@ -1116,7 +1142,7 @@ let add_manual ~executable_name ~global_options format ppf commands =
(default_arg
~doc:"the manual's output format"
~placeholder: "plain|colors|html"
~parameter: "-format"
~long: "format"
~default:
(match format with
| Ansi -> "colors"
@ -1167,6 +1193,10 @@ let pp_cli_errors ppf ~executable_name ~global_options ~default errs =
Format.fprintf ppf
"Wrong value for command line option @{<opt>%s@}." arg ;
Option.unopt_map ~f:(fun command -> [ Ex command ]) ~default:[] command
| Multiple_occurences (arg, command) ->
Format.fprintf ppf
"Command line option @{<opt>%s@} appears multiple times." arg ;
Option.unopt_map ~f:(fun command -> [ Ex command ]) ~default:[] command
| No_manual_entry [ keyword ] ->
Format.fprintf ppf
"No manual entry that match @{<hilight>%s@}."

20
src/lib_base/cli_entries.mli
View File

@ -53,21 +53,23 @@ val parameter :
["lowercase short description\nOptional longer description."]. *)
type ('a, 'ctx) arg
(** [arg ~doc ~parameter converter] creates an argument to a command.
The [~parameter] argument should begin with a [-].
(** [arg ~doc ~long ?short converter] creates an argument to a command.
The [~long] argument is the long format, without the double dashes.
The [?short] argument is the optional one letter shortcut.
If the argument is not provided, [None] is returned. *)
val arg :
doc:string ->
parameter:string ->
?short:char ->
long:string ->
placeholder:string ->
('a, 'ctx) parameter ->
('a option, 'ctx) arg
(** Create an argument that will contain the [~default] value if it is not provided.
see arg *)
(** Create an argument that will contain the [~default] value if it is not provided. *)
val default_arg :
doc:string ->
parameter:string ->
?short:char ->
long:string ->
placeholder:string ->
default:string ->
('a, 'ctx) parameter ->
@ -75,7 +77,11 @@ val default_arg :
(** Create a boolean switch.
The value will be set to [true] if the switch is provided and [false] if it is not. *)
val switch : doc:string -> parameter:string ->
val switch :
doc:string ->
?short:char ->
long:string ->
unit ->
(bool, 'ctx) arg
(** {2 Groups of Optional Arguments} *)

2
src/lib_client_base/client_commands.ml
View File

@ -192,4 +192,4 @@ let commands_for_version version =
with Not_found -> raise Version_not_found
let force_switch ?(doc = "Silence any warnings and some checks.") () =
Cli_entries.switch ~parameter:"-force" ~doc
Cli_entries.switch ~long:"force" ~short:'f' ~doc ()

33
src/lib_client_base/client_config.ml
View File

@ -143,7 +143,8 @@ let protocol_parameter () =
(* Command-line only args (not in config file) *)
let base_dir_arg () =
arg
~parameter:"-base-dir"
~long:"base-dir"
~short:'d'
~placeholder:"path"
~doc:("client data directory\n\
The directory where the Tezos client will store all its data.\n\
@ -151,42 +152,51 @@ let base_dir_arg () =
(string_parameter ())
let config_file_arg () =
arg
~parameter:"-config-file"
~long:"config-file"
~short:'c'
~placeholder:"path"
~doc:"configuration file"
(string_parameter ())
let timings_switch () =
switch
~parameter:"-timings"
~long:"timings"
~short:'t'
~doc:"show RPC request times"
()
let block_arg () =
default_arg
~parameter:"-block"
~long:"block"
~short:'b'
~placeholder:"hash|tag"
~doc:"block on which to apply contextual commands"
~default:(Block_services.to_string default_cli_args.block)
(block_parameter ())
let protocol_arg () =
arg
~parameter:"-protocol"
~long:"protocol"
~short:'p'
~placeholder:"hash"
~doc:"use commands of a specific protocol"
(protocol_parameter ())
let log_requests_switch () =
switch
~parameter:"-log-requests"
~long:"log-requests"
~short:'l'
~doc:"log all requests to the node"
()
(* Command-line args which can be set in config file as well *)
let addr_arg () =
arg
~parameter:"-addr"
~long:"addr"
~short:'A'
~placeholder:"IP addr|host"
~doc:"IP address of the node"
(string_parameter ())
let port_arg () =
arg
~parameter:"-port"
~long:"port"
~short:'P'
~placeholder:"number"
~doc:"RPC port of the node"
(parameter
@ -196,8 +206,10 @@ let port_arg () =
fail (Invalid_port_arg x)))
let tls_switch () =
switch
~parameter:"-tls"
~long:"tls"
~short:'S'
~doc:"use TLS to connect to node."
()
let read_config_file config_file =
Lwt_utils_unix.Json.read_file config_file >>=? fun cfg_json ->
@ -258,7 +270,8 @@ let commands config_file cfg =
The command will always fail if the file already exists."
(args1
(default_arg
~parameter:"-file"
~long:"output"
~short:'o'
~placeholder:"path"
~doc:"path at which to create the file"
~default:(cfg.base_dir // default_config_file_name)

3
src/lib_client_base/client_debug.ml
View File

@ -102,7 +102,8 @@ let commands () =
let output_arg =
arg
~doc:"Write output of debug command to file"
~parameter:"-file"
~long:"output"
~short:'o'
~placeholder:"path"
@@ parameter (fun _ str -> return str) in
let output_to_ppf = function

4
src/lib_client_base/client_helpers.ml
View File

@ -9,8 +9,10 @@
let unique_switch =
Cli_entries.switch
~parameter:"-unique"
~long:"unique"
~short:'u'
~doc:"Fail when there is more than one possible completion."
()
let commands () = Cli_entries.[
command

11
src/lib_client_base/client_keys.ml
View File

@ -287,8 +287,9 @@ let commands () =
let open Cli_entries in
let show_private_switch =
switch
~parameter:"-show-secret"
~doc:"show the private key" in
~long:"show-secret"
~short:'S'
~doc:"show the private key" () in
[
command ~group
~desc: "List supported signing schemes.\n\
@ -324,7 +325,11 @@ let commands () =
command ~group ~desc: "Generate (unencrypted) keys including the given string."
(args2
(switch ~doc:"the key must begin with tz1[word]" ~parameter:"-prefix")
(switch
~long:"prefix"
~short:'P'
~doc:"the key must begin with tz1[word]"
())
(force_switch ()))
(prefixes [ "gen" ; "vanity" ; "keys" ]
@@ Public_key_hash.fresh_alias_param

50
src/proto_alpha/lib_client/client_proto_args.ml
View File

@ -60,7 +60,7 @@ let string_parameter =
let init_arg =
default_arg
~parameter:"-init"
~long:"init"
~placeholder:"data"
~doc:"initial value of the contract's storage"
~default:"Unit"
@ -68,7 +68,7 @@ let init_arg =
let arg_arg =
default_arg
~parameter:"-arg"
~long:"arg"
~placeholder:"data"
~doc:"argument passed to the contract's script, if needed"
~default:"Unit"
@ -76,7 +76,7 @@ let arg_arg =
let delegate_arg =
arg
~parameter:"-delegate"
~long:"delegate"
~placeholder:"identity"
~doc:"delegate of the contract\n\
Must be a known identity."
@ -84,7 +84,7 @@ let delegate_arg =
let source_arg =
arg
~parameter:"-source"
~long:"source"
~placeholder:"identity"
~doc:"source of the bonds to be paid\n\
Must be a known identity."
@ -92,21 +92,25 @@ let source_arg =
let spendable_switch =
switch
~parameter:"-spendable"
~long:"spendable"
~doc:"allow the manager to spend the contract's tokens"
()
let force_switch =
switch
~parameter:"-force"
~long:"force"
~short:'f'
~doc:"disables the node's injection checks\n\
Force the injection of branch-invalid operation or force \
\ the injection of block without a fitness greater than the \
\ current head."
()
let delegatable_switch =
switch
~parameter:"-delegatable"
~long:"delegatable"
~doc:"allow future delegate change"
()
let tez_format =
"Text format: `D,DDD,DDD.DDD,DDD`.\n\
@ -122,7 +126,8 @@ let tez_parameter param =
| None -> fail (Bad_tez_arg (param, s)))
let tez_arg ~default ~parameter ~doc =
default_arg ~parameter ~placeholder:"amount" ~doc ~default (tez_parameter parameter)
default_arg ~long:parameter ~placeholder:"amount" ~doc ~default
(tez_parameter ("--" ^ parameter))
let tez_param ~name ~desc next =
Cli_entries.param
@ -134,12 +139,12 @@ let tez_param ~name ~desc next =
let fee_arg =
tez_arg
~default:"0.05"
~parameter:"-fee"
~parameter:"fee"
~doc:"fee in \xEA\x9C\xA9 to pay to the baker"
let max_priority_arg =
arg
~parameter:"-max-priority"
~long:"max-priority"
~placeholder:"slot"
~doc:"maximum allowed baking slot"
(parameter (fun _ s ->
@ -148,12 +153,14 @@ let max_priority_arg =
let free_baking_switch =
switch
~parameter:"-free-baking"
~long:"free-baking"
?short:None
~doc:"only consider free baking slots"
()
let endorsement_delay_arg =
default_arg
~parameter:"-endorsement-delay"
~long:"endorsement-delay"
~placeholder:"seconds"
~doc:"delay before endorsing blocks\n\
Delay between notifications of new blocks from the node and \
@ -165,23 +172,28 @@ let endorsement_delay_arg =
let no_print_source_flag =
switch
~parameter:"-no-print-source"
~long:"no-print-source"
~short:'q'
~doc:"don't print the source code\n\
If an error is encountered, the client will print the \
contract's source code by default.\n\
This option disables this behaviour."
()
module Daemon = struct
let baking_switch =
switch
~parameter:"-baking"
~doc:"run the baking daemon"
~long:"baking"
~short:'B'
~doc:"run the baking daemon" ()
let endorsement_switch =
switch
~parameter:"-endorsement"
~doc:"run the endorsement daemon"
~long:"endorsement"
~short:'E'
~doc:"run the endorsement daemon" ()
let denunciation_switch =
switch
~parameter:"-denunciation"
~doc:"run the denunciation daemon"
~long:"denunciation"
~short:'D'
~doc:"run the denunciation daemon" ()
end

19
src/proto_alpha/lib_client/client_proto_programs_commands.ml
View File

@ -21,19 +21,24 @@ let commands () =
let open Cli_entries in
let show_types_switch =
switch
~parameter:"-details"
~doc:"show the types of each instruction" in
~long:"-details"
~short:'v'
~doc:"show the types of each instruction"
() in
let emacs_mode_switch =
switch
~parameter:"-emacs"
~doc:"output in `michelson-mode.el` compatible format" in
~long:"-emacs"
?short:None
~doc:"output in `michelson-mode.el` compatible format"
() in
let trace_stack_switch =
switch
~parameter:"-trace-stack"
~doc:"show the stack after each step" in
~long:"trace-stack"
~doc:"show the stack after each step"
() in
let amount_arg =
Client_proto_args.tez_arg
~parameter:"-amount"
~parameter:"amount"
~doc:"amount of the transfer in \xEA\x9C\xA9"
~default:"0.05" in
let data_parameter =

2
src/proto_genesis/lib_client/client_proto_main.ml
View File

@ -39,7 +39,7 @@ let commands () =
let args =
args1
(arg
~parameter:"-timestamp"
~long:"timestamp"
~placeholder:"date"
~doc:"Set the timestamp of the block (and initial time of the chain)"
(parameter (fun _ t ->