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 = type ('a, 'ctx) arg =
| Arg : { doc : string ; | Arg : { doc : string ;
parameter : string ; parameter : string * char option ;
placeholder : string ; placeholder : string ;
kind : ('p, 'ctx) parameter } -> kind : ('p, 'ctx) parameter } ->
('p option, 'ctx) arg ('p option, 'ctx) arg
| DefArg : { doc : string ; | DefArg : { doc : string ;
parameter : string ; parameter : string * char option ;
placeholder : string ; placeholder : string ;
kind : ('p, 'ctx) parameter ; kind : ('p, 'ctx) parameter ;
default : string } -> ('p, 'ctx) arg default : string } -> ('p, 'ctx) arg
| Switch : { doc : string ; | Switch : { doc : string ;
parameter : string } -> parameter : string * char option } ->
(bool, 'ctx) arg (bool, 'ctx) arg
type ('a, 'arg) args = 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 += Unknown_option : string * 'ctx command -> error
type error += Option_expected_argument : string * 'ctx command option -> error type error += Option_expected_argument : string * 'ctx command option -> error
type error += Bad_option_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 type error += Extra_arguments : string list * 'ctx command -> error
let trim s = (* config-file wokaround *) let trim s = (* config-file wokaround *)
@ -96,18 +97,25 @@ let print_desc ppf doc =
| Some doc -> | Some doc ->
Format.fprintf ppf "%s@{<full>@\n @[<hov 0>%a@]@}" short Format.pp_print_text 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 print_options_detailed (type ctx) =
let help_option : type a.Format.formatter -> (a, ctx) arg -> unit = let help_option : type a.Format.formatter -> (a, ctx) arg -> unit =
fun ppf -> function fun ppf -> function
| Arg { parameter ; placeholder ; doc ; _ } -> | Arg { parameter ; placeholder ; doc ; _ } ->
Format.fprintf ppf "@{<opt>%s <%s>@}: %a" Format.fprintf ppf "@{<opt>%a <%s>@}: %a"
parameter placeholder print_desc doc ; print_parameter parameter placeholder
print_desc doc ;
| DefArg { parameter ; placeholder ; doc ; default ; _ } -> | DefArg { parameter ; placeholder ; doc ; default ; _ } ->
Format.fprintf ppf "@{<opt>%s <%s>@}: %a" Format.fprintf ppf "@{<opt>%a <%s>@}: %a"
parameter placeholder print_desc (doc ^ "\nDefaults to `" ^ default ^ "`.") print_parameter parameter placeholder
print_desc (doc ^ "\nDefaults to `" ^ default ^ "`.")
| Switch { parameter ; doc } -> | Switch { parameter ; doc } ->
Format.fprintf ppf "@{<opt>%s@}: %a" Format.fprintf ppf "@{<opt>%a@}: %a"
parameter print_desc doc in print_parameter parameter
print_desc doc in
let rec help : type b. Format.formatter -> (b, ctx) args -> unit = let rec help : type b. Format.formatter -> (b, ctx) args -> unit =
fun ppf -> function fun ppf -> function
| NoArgs -> () | NoArgs -> ()
@ -128,11 +136,14 @@ let print_options_brief (type ctx) =
type a. Format.formatter -> (a, ctx) arg -> unit = type a. Format.formatter -> (a, ctx) arg -> unit =
fun ppf -> function fun ppf -> function
| DefArg { parameter ; placeholder ; _ } -> | DefArg { parameter ; placeholder ; _ } ->
Format.fprintf ppf "[@{<opt>%s <%s>@}]" parameter placeholder Format.fprintf ppf "[@{<opt>%a <%s>@}]"
print_parameter parameter placeholder
| Arg { 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 ; _ } -> | 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 = in let rec help : type b. Format.formatter -> (b, ctx) args -> unit =
fun ppf -> function fun ppf -> function
| NoArgs -> () | NoArgs -> ()
@ -503,9 +514,9 @@ let usage_internal ppf ~executable_name ~global_options ?(highlights=[]) command
@{<command>@{<commandline>\ @{<command>@{<commandline>\
%s [@{<opt>global options@}] command @{<opt>[command options]@}@}@}@,\ %s [@{<opt>global options@}] command @{<opt>[command options]@}@}@}@,\
@{<command>@{<commandline>\ @{<command>@{<commandline>\
%s @{<opt>-help@} (for global options)@}@}@,\ %s @{<opt>--help@} (for global options)@}@}@,\
@{<command>@{<commandline>\ @{<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@}@,\ @{<title>To browse the documentation@}@,\
@{<list>\ @{<list>\
@ -522,42 +533,39 @@ let usage_internal ppf ~executable_name ~global_options ?(highlights=[]) command
(fun ppf () -> if by_group <> [] then Format.fprintf ppf "@,@,") () (fun ppf () -> if by_group <> [] then Format.fprintf ppf "@,@,") ()
print_groups by_group print_groups by_group
let arg ~doc ~parameter ~placeholder kind = let arg ~doc ?short ~long ~placeholder kind =
Arg { doc ; Arg { doc ;
parameter ; parameter = (long, short) ;
placeholder ; placeholder ;
kind } kind }
let default_arg ~doc ~parameter ~placeholder ~default kind = let default_arg ~doc ?short ~long ~placeholder ~default kind =
DefArg { doc ; DefArg { doc ;
placeholder ; placeholder ;
parameter ; parameter = (long, short) ;
kind ; kind ;
default } default }
let switch ~doc ~parameter = let switch ~doc ?short ~long () =
Switch { doc ; parameter } Switch { doc ; parameter = (long, short) }
let parse_arg : 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 -> fun ?command spec args_dict ctx ->
match spec with match spec with
| Arg { parameter ; kind = { converter ; _ } ; _ } -> | Arg { parameter = (long, _) ; kind = { converter ; _ } ; _ } ->
begin begin match TzString.Map.find long args_dict with
try | exception Not_found -> return None
begin | [] -> return None
match TzString.Map.find parameter args_dict with | [ s ] ->
| None -> return None (trace
| Some s -> (Bad_option_argument ("--" ^ long, command))
(trace (converter ctx s)) >>|? fun x ->
(Bad_option_argument (parameter, command)) Some x
(converter ctx s)) >>|? fun x -> | _ :: _ ->
Some x fail (Multiple_occurences ("--" ^ long, command))
end
with Not_found ->
return None
end end
| DefArg { parameter ; kind = { converter ; _ } ; default ; _ } -> | DefArg { parameter = (long, _) ; kind = { converter ; _ } ; default ; _ } ->
converter ctx default >>= fun default -> converter ctx default >>= fun default ->
begin match default with begin match default with
| Ok x -> return x | Ok x -> return x
@ -565,22 +573,28 @@ let parse_arg :
invalid_arg invalid_arg
(Format.sprintf (Format.sprintf
"Value provided as default for '%s' could not be parsed by converter function." "Value provided as default for '%s' could not be parsed by converter function."
parameter) end >>=? fun default -> long) end >>=? fun default ->
begin try begin match TzString.Map.find long args_dict with
match TzString.Map.find parameter args_dict with | exception Not_found -> return default
| None -> return default | [] -> return default
| Some s -> | [ s ] ->
trace (trace
(Bad_option_argument (parameter, command)) (Bad_option_argument (long, command))
(converter ctx s) (converter ctx s))
with Not_found -> return default | _ :: _ ->
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 end
| Switch { parameter ; _ } ->
return (TzString.Map.mem parameter args_dict)
(* Argument parsing *) (* Argument parsing *)
let rec parse_args : 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 -> fun ?command spec args_dict ctx ->
match spec with match spec with
| NoArgs -> return () | NoArgs -> return ()
@ -592,18 +606,21 @@ let rec parse_args :
let empty_args_dict = TzString.Map.empty let empty_args_dict = TzString.Map.empty
let rec make_arities_dict : let rec make_arities_dict :
type a b. int TzString.Map.t -> (a, b) args -> int TzString.Map.t = type a b. (a, b) args -> (int * string) TzString.Map.t -> (int * string) TzString.Map.t =
fun acc -> function fun args acc -> match args with
| NoArgs -> acc | NoArgs -> acc
| AddArg (arg, rest) -> | AddArg (arg, rest) ->
let recur parameter num = let recur (long, short) num =
make_arities_dict (TzString.Map.add parameter num acc) rest in (match short with
begin | None -> acc
match arg with | Some c -> TzString.Map.add ("-" ^ String.make 1 c) (num, long) acc) |>
| Arg { parameter ; _ } -> recur parameter 1 TzString.Map.add ("-" ^ long) (num, long) |>
| DefArg { parameter ; _ } -> recur parameter 1 TzString.Map.add ("--" ^ long) (num, long) |>
| Switch { parameter ; _ } -> recur parameter 0 make_arities_dict rest in
end 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 type error += Help : 'a command option -> error
@ -611,8 +628,10 @@ let check_help_flag ?command = function
| ("-help" | "--help") :: _ -> fail (Help command) | ("-help" | "--help") :: _ -> fail (Help command)
| _ -> return () | _ -> return ()
(* ignore_autocomplete is a hack to have the initial arguments get parsed let add_occurrence long value acc =
even if autocomplete command is running *) 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 make_args_dict_consume ?command spec args =
let rec make_args_dict completing arities acc args = let rec make_args_dict completing arities acc args =
check_help_flag ?command args >>=? fun () -> check_help_flag ?command args >>=? fun () ->
@ -620,12 +639,14 @@ let make_args_dict_consume ?command spec args =
| [] -> return (acc, []) | [] -> return (acc, [])
| arg :: tl -> | arg :: tl ->
if TzString.Map.mem arg arities 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 () -> check_help_flag ?command tl >>=? fun () ->
match arity, tl with 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' -> | 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 -> | 1, [] when completing ->
return (acc, []) return (acc, [])
| 1, [] -> | 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") raise (Failure "cli_entries: Arguments with arity not equal to 1 or 0 not supported")
else return (acc, args) 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 make_args_dict_filter ?command spec args =
let rec make_args_dict arities (dict, other_args) 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) | [] -> return (dict, other_args)
| arg :: tl -> | arg :: tl ->
if TzString.Map.mem arg arities 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 () -> check_help_flag ?command tl >>=? fun () ->
match arity, tl with match arity, tl with
| 0, tl -> make_args_dict arities (TzString.Map.add arg None dict, other_args) tl | 0, tl -> make_args_dict arities (add_occurrence long "" dict, other_args) tl
| 1, value :: tl' -> make_args_dict arities (TzString.Map.add arg (Some value) 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)) | 1, [] -> fail (Option_expected_argument (arg, command))
| _, _ -> | _, _ ->
raise (Failure "cli_entries: Arguments with arity not equal to 1 or 0 not supported") 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 else make_args_dict arities (dict, arg :: other_args) tl
in make_args_dict in make_args_dict
(make_arities_dict TzString.Map.empty spec) (make_arities_dict spec TzString.Map.empty)
(TzString.Map.empty, []) (TzString.Map.empty, [])
args >>|? fun (dict, remaining) -> args >>|? fun (dict, remaining) ->
(dict, List.rev remaining) (dict, List.rev remaining)
@ -924,14 +945,19 @@ let find_command tree initial_arguments =
fail (Command_not_found (List.rev acc, [])) fail (Command_not_found (List.rev acc, []))
in traverse tree initial_arguments [] in traverse tree initial_arguments []
let get_arg : type a ctx. (a, ctx) arg -> string = function let get_arg
| Arg { parameter ; _ } -> parameter : type a ctx. (a, ctx) arg -> string list
| DefArg { parameter ; _ } -> parameter = fun arg ->
| Switch { parameter ; _ } -> parameter 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 let rec list_args : type arg ctx. (arg, ctx) args -> string list = function
| NoArgs -> [] | NoArgs -> []
| AddArg (arg, args) -> (get_arg arg) :: (list_args args) | AddArg (arg, args) -> get_arg arg @ list_args args
let complete_func autocomplete cctxt = let complete_func autocomplete cctxt =
match autocomplete with match autocomplete with
@ -960,18 +986,18 @@ let rec remaining_spec :
fun seen -> function fun seen -> function
| NoArgs -> [] | NoArgs -> []
| AddArg (arg, rest) -> | AddArg (arg, rest) ->
let parameter = get_arg_parameter arg in let (long, _) = get_arg_parameter arg in
if StringSet.mem parameter seen if StringSet.mem long seen
then (remaining_spec seen rest) then remaining_spec seen rest
else parameter :: (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 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 = let rec complete_spec : type a. string -> (a, ctx) args -> string list tzresult Lwt.t =
fun name -> function fun name -> function
| NoArgs -> return [] | NoArgs -> return []
| AddArg (arg, rest) -> | AddArg (arg, rest) ->
if (get_arg_parameter arg) = name if fst (get_arg_parameter arg) = name
then complete_arg ctx arg then complete_arg ctx arg
else complete_spec name rest in else complete_spec name rest in
let rec help args ind seen = let rec help args ind seen =
@ -985,17 +1011,16 @@ let complete_options (type ctx) continuation args args_spec ind (ctx : ctx) =
| arg :: tl -> | arg :: tl ->
if TzString.Map.mem arg arities if TzString.Map.mem arg arities
then then
let seen = StringSet.add arg seen in let arity, long = TzString.Map.find arg arities in
begin let seen = StringSet.add long seen in
match TzString.Map.find arg arities, tl with match arity, tl with
| 0, args when ind = 0 -> | 0, args when ind = 0 ->
continuation args 0 >>|? fun cont_args -> continuation args 0 >>|? fun cont_args ->
remaining_spec seen args_spec @ cont_args remaining_spec seen args_spec @ cont_args
| 0, args -> help args (ind - 1) seen | 0, args -> help args (ind - 1) seen
| 1, _ when ind = 1 -> complete_spec arg args_spec | 1, _ when ind = 1 -> complete_spec arg args_spec
| 1, _ :: tl -> help tl (ind - 2) seen | 1, _ :: tl -> help tl (ind - 2) seen
| _ -> Pervasives.failwith "cli_entries internal error, invalid arity" | _ -> Pervasives.failwith "cli_entries internal error, invalid arity"
end
else continuation args ind else continuation args ind
in help args ind StringSet.empty 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 -> then complete_next_tree cctxt tree >>|? fun command_completions ->
begin begin
let (Argument { spec ; _ }) = global_options in let (Argument { spec ; _ }) = global_options in
remaining_spec StringSet.empty spec @ command_completions list_args spec @ command_completions
end end
else else
match ind 0 args with 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\ 1. Shows command mnemonics with short descriptions.\n\
2. Show commands and arguments with short descriptions\n\ 2. Show commands and arguments with short descriptions\n\
3. Show everything" 3. Show everything"
~parameter:"-verbosity" ~long:"verbosity"
~short:'v'
~placeholder:"0|1|2|3" ~placeholder:"0|1|2|3"
(parameter (parameter
~autocomplete: (fun _ -> return [ "0" ; "1" ; "2" ; "3" ]) ~autocomplete: (fun _ -> return [ "0" ; "1" ; "2" ; "3" ])
@ -1116,7 +1142,7 @@ let add_manual ~executable_name ~global_options format ppf commands =
(default_arg (default_arg
~doc:"the manual's output format" ~doc:"the manual's output format"
~placeholder: "plain|colors|html" ~placeholder: "plain|colors|html"
~parameter: "-format" ~long: "format"
~default: ~default:
(match format with (match format with
| Ansi -> "colors" | Ansi -> "colors"
@ -1167,6 +1193,10 @@ let pp_cli_errors ppf ~executable_name ~global_options ~default errs =
Format.fprintf ppf Format.fprintf ppf
"Wrong value for command line option @{<opt>%s@}." arg ; "Wrong value for command line option @{<opt>%s@}." arg ;
Option.unopt_map ~f:(fun command -> [ Ex command ]) ~default:[] command 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 ] -> | No_manual_entry [ keyword ] ->
Format.fprintf ppf Format.fprintf ppf
"No manual entry that match @{<hilight>%s@}." "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."]. *) ["lowercase short description\nOptional longer description."]. *)
type ('a, 'ctx) arg type ('a, 'ctx) arg
(** [arg ~doc ~parameter converter] creates an argument to a command. (** [arg ~doc ~long ?short converter] creates an argument to a command.
The [~parameter] argument should begin with a [-]. 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. *) If the argument is not provided, [None] is returned. *)
val arg : val arg :
doc:string -> doc:string ->
parameter:string -> ?short:char ->
long:string ->
placeholder:string -> placeholder:string ->
('a, 'ctx) parameter -> ('a, 'ctx) parameter ->
('a option, 'ctx) arg ('a option, 'ctx) arg
(** Create an argument that will contain the [~default] value if it is not provided. (** Create an argument that will contain the [~default] value if it is not provided. *)
see arg *)
val default_arg : val default_arg :
doc:string -> doc:string ->
parameter:string -> ?short:char ->
long:string ->
placeholder:string -> placeholder:string ->
default:string -> default:string ->
('a, 'ctx) parameter -> ('a, 'ctx) parameter ->
@ -75,7 +77,11 @@ val default_arg :
(** Create a boolean switch. (** Create a boolean switch.
The value will be set to [true] if the switch is provided and [false] if it is not. *) 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 (bool, 'ctx) arg
(** {2 Groups of Optional Arguments} *) (** {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 with Not_found -> raise Version_not_found
let force_switch ?(doc = "Silence any warnings and some checks.") () = 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) *) (* Command-line only args (not in config file) *)
let base_dir_arg () = let base_dir_arg () =
arg arg
~parameter:"-base-dir" ~long:"base-dir"
~short:'d'
~placeholder:"path" ~placeholder:"path"
~doc:("client data directory\n\ ~doc:("client data directory\n\
The directory where the Tezos client will store all its data.\n\ The directory where the Tezos client will store all its data.\n\
@ -151,42 +152,51 @@ let base_dir_arg () =
(string_parameter ()) (string_parameter ())
let config_file_arg () = let config_file_arg () =
arg arg
~parameter:"-config-file" ~long:"config-file"
~short:'c'
~placeholder:"path" ~placeholder:"path"
~doc:"configuration file" ~doc:"configuration file"
(string_parameter ()) (string_parameter ())
let timings_switch () = let timings_switch () =
switch switch
~parameter:"-timings" ~long:"timings"
~short:'t'
~doc:"show RPC request times" ~doc:"show RPC request times"
()
let block_arg () = let block_arg () =
default_arg default_arg
~parameter:"-block" ~long:"block"
~short:'b'
~placeholder:"hash|tag" ~placeholder:"hash|tag"
~doc:"block on which to apply contextual commands" ~doc:"block on which to apply contextual commands"
~default:(Block_services.to_string default_cli_args.block) ~default:(Block_services.to_string default_cli_args.block)
(block_parameter ()) (block_parameter ())
let protocol_arg () = let protocol_arg () =
arg arg
~parameter:"-protocol" ~long:"protocol"
~short:'p'
~placeholder:"hash" ~placeholder:"hash"
~doc:"use commands of a specific protocol" ~doc:"use commands of a specific protocol"
(protocol_parameter ()) (protocol_parameter ())
let log_requests_switch () = let log_requests_switch () =
switch switch
~parameter:"-log-requests" ~long:"log-requests"
~short:'l'
~doc:"log all requests to the node" ~doc:"log all requests to the node"
()
(* Command-line args which can be set in config file as well *) (* Command-line args which can be set in config file as well *)
let addr_arg () = let addr_arg () =
arg arg
~parameter:"-addr" ~long:"addr"
~short:'A'
~placeholder:"IP addr|host" ~placeholder:"IP addr|host"
~doc:"IP address of the node" ~doc:"IP address of the node"
(string_parameter ()) (string_parameter ())
let port_arg () = let port_arg () =
arg arg
~parameter:"-port" ~long:"port"
~short:'P'
~placeholder:"number" ~placeholder:"number"
~doc:"RPC port of the node" ~doc:"RPC port of the node"
(parameter (parameter
@ -196,8 +206,10 @@ let port_arg () =
fail (Invalid_port_arg x))) fail (Invalid_port_arg x)))
let tls_switch () = let tls_switch () =
switch switch
~parameter:"-tls" ~long:"tls"
~short:'S'
~doc:"use TLS to connect to node." ~doc:"use TLS to connect to node."
()
let read_config_file config_file = let read_config_file config_file =
Lwt_utils_unix.Json.read_file config_file >>=? fun cfg_json -> 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." The command will always fail if the file already exists."
(args1 (args1
(default_arg (default_arg
~parameter:"-file" ~long:"output"
~short:'o'
~placeholder:"path" ~placeholder:"path"
~doc:"path at which to create the file" ~doc:"path at which to create the file"
~default:(cfg.base_dir // default_config_file_name) ~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 = let output_arg =
arg arg
~doc:"Write output of debug command to file" ~doc:"Write output of debug command to file"
~parameter:"-file" ~long:"output"
~short:'o'
~placeholder:"path" ~placeholder:"path"
@@ parameter (fun _ str -> return str) in @@ parameter (fun _ str -> return str) in
let output_to_ppf = function let output_to_ppf = function

4
src/lib_client_base/client_helpers.ml
View File

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

11
src/lib_client_base/client_keys.ml
View File

@ -287,8 +287,9 @@ let commands () =
let open Cli_entries in let open Cli_entries in
let show_private_switch = let show_private_switch =
switch switch
~parameter:"-show-secret" ~long:"show-secret"
~doc:"show the private key" in ~short:'S'
~doc:"show the private key" () in
[ [
command ~group command ~group
~desc: "List supported signing schemes.\n\ ~desc: "List supported signing schemes.\n\
@ -324,7 +325,11 @@ let commands () =
command ~group ~desc: "Generate (unencrypted) keys including the given string." command ~group ~desc: "Generate (unencrypted) keys including the given string."
(args2 (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 ())) (force_switch ()))
(prefixes [ "gen" ; "vanity" ; "keys" ] (prefixes [ "gen" ; "vanity" ; "keys" ]
@@ Public_key_hash.fresh_alias_param @@ 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 = let init_arg =
default_arg default_arg
~parameter:"-init" ~long:"init"
~placeholder:"data" ~placeholder:"data"
~doc:"initial value of the contract's storage" ~doc:"initial value of the contract's storage"
~default:"Unit" ~default:"Unit"
@ -68,7 +68,7 @@ let init_arg =
let arg_arg = let arg_arg =
default_arg default_arg
~parameter:"-arg" ~long:"arg"
~placeholder:"data" ~placeholder:"data"
~doc:"argument passed to the contract's script, if needed" ~doc:"argument passed to the contract's script, if needed"
~default:"Unit" ~default:"Unit"
@ -76,7 +76,7 @@ let arg_arg =
let delegate_arg = let delegate_arg =
arg arg
~parameter:"-delegate" ~long:"delegate"
~placeholder:"identity" ~placeholder:"identity"
~doc:"delegate of the contract\n\ ~doc:"delegate of the contract\n\
Must be a known identity." Must be a known identity."
@ -84,7 +84,7 @@ let delegate_arg =
let source_arg = let source_arg =
arg arg
~parameter:"-source" ~long:"source"
~placeholder:"identity" ~placeholder:"identity"
~doc:"source of the bonds to be paid\n\ ~doc:"source of the bonds to be paid\n\
Must be a known identity." Must be a known identity."
@ -92,21 +92,25 @@ let source_arg =
let spendable_switch = let spendable_switch =
switch switch
~parameter:"-spendable" ~long:"spendable"
~doc:"allow the manager to spend the contract's tokens" ~doc:"allow the manager to spend the contract's tokens"
()
let force_switch = let force_switch =
switch switch
~parameter:"-force" ~long:"force"
~short:'f'
~doc:"disables the node's injection checks\n\ ~doc:"disables the node's injection checks\n\
Force the injection of branch-invalid operation or force \ Force the injection of branch-invalid operation or force \
\ the injection of block without a fitness greater than the \ \ the injection of block without a fitness greater than the \
\ current head." \ current head."
()
let delegatable_switch = let delegatable_switch =
switch switch
~parameter:"-delegatable" ~long:"delegatable"
~doc:"allow future delegate change" ~doc:"allow future delegate change"
()
let tez_format = let tez_format =
"Text format: `D,DDD,DDD.DDD,DDD`.\n\ "Text format: `D,DDD,DDD.DDD,DDD`.\n\
@ -122,7 +126,8 @@ let tez_parameter param =
| None -> fail (Bad_tez_arg (param, s))) | None -> fail (Bad_tez_arg (param, s)))
let tez_arg ~default ~parameter ~doc = 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 = let tez_param ~name ~desc next =
Cli_entries.param Cli_entries.param
@ -134,12 +139,12 @@ let tez_param ~name ~desc next =
let fee_arg = let fee_arg =
tez_arg tez_arg
~default:"0.05" ~default:"0.05"
~parameter:"-fee" ~parameter:"fee"
~doc:"fee in \xEA\x9C\xA9 to pay to the baker" ~doc:"fee in \xEA\x9C\xA9 to pay to the baker"
let max_priority_arg = let max_priority_arg =
arg arg
~parameter:"-max-priority" ~long:"max-priority"
~placeholder:"slot" ~placeholder:"slot"
~doc:"maximum allowed baking slot" ~doc:"maximum allowed baking slot"
(parameter (fun _ s -> (parameter (fun _ s ->
@ -148,12 +153,14 @@ let max_priority_arg =
let free_baking_switch = let free_baking_switch =
switch switch
~parameter:"-free-baking" ~long:"free-baking"
?short:None
~doc:"only consider free baking slots" ~doc:"only consider free baking slots"
()
let endorsement_delay_arg = let endorsement_delay_arg =
default_arg default_arg
~parameter:"-endorsement-delay" ~long:"endorsement-delay"
~placeholder:"seconds" ~placeholder:"seconds"
~doc:"delay before endorsing blocks\n\ ~doc:"delay before endorsing blocks\n\
Delay between notifications of new blocks from the node and \ Delay between notifications of new blocks from the node and \
@ -165,23 +172,28 @@ let endorsement_delay_arg =
let no_print_source_flag = let no_print_source_flag =
switch switch
~parameter:"-no-print-source" ~long:"no-print-source"
~short:'q'
~doc:"don't print the source code\n\ ~doc:"don't print the source code\n\
If an error is encountered, the client will print the \ If an error is encountered, the client will print the \
contract's source code by default.\n\ contract's source code by default.\n\
This option disables this behaviour." This option disables this behaviour."
()
module Daemon = struct module Daemon = struct
let baking_switch = let baking_switch =
switch switch
~parameter:"-baking" ~long:"baking"
~doc:"run the baking daemon" ~short:'B'
~doc:"run the baking daemon" ()
let endorsement_switch = let endorsement_switch =
switch switch
~parameter:"-endorsement" ~long:"endorsement"
~doc:"run the endorsement daemon" ~short:'E'
~doc:"run the endorsement daemon" ()
let denunciation_switch = let denunciation_switch =
switch switch
~parameter:"-denunciation" ~long:"denunciation"
~doc:"run the denunciation daemon" ~short:'D'
~doc:"run the denunciation daemon" ()
end 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 open Cli_entries in
let show_types_switch = let show_types_switch =
switch switch
~parameter:"-details" ~long:"-details"
~doc:"show the types of each instruction" in ~short:'v'
~doc:"show the types of each instruction"
() in
let emacs_mode_switch = let emacs_mode_switch =
switch switch
~parameter:"-emacs" ~long:"-emacs"
~doc:"output in `michelson-mode.el` compatible format" in ?short:None
~doc:"output in `michelson-mode.el` compatible format"
() in
let trace_stack_switch = let trace_stack_switch =
switch switch
~parameter:"-trace-stack" ~long:"trace-stack"
~doc:"show the stack after each step" in ~doc:"show the stack after each step"
() in
let amount_arg = let amount_arg =
Client_proto_args.tez_arg Client_proto_args.tez_arg
~parameter:"-amount" ~parameter:"amount"
~doc:"amount of the transfer in \xEA\x9C\xA9" ~doc:"amount of the transfer in \xEA\x9C\xA9"
~default:"0.05" in ~default:"0.05" in
let data_parameter = let data_parameter =

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

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