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

src/lib_base/cli_entries.ml

@@ -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"
+          Format.fprintf ppf "@{<opt>%a <%s>@}: %a"
-            parameter placeholder print_desc doc ;
+            print_parameter parameter placeholder
+            print_desc doc ;
       | 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 } ->
-          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 =
     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 =
+let switch ~doc ?short ~long () =
-  Switch { doc ; parameter }
+  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 ; _  } ; _ } ->
+    | 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
-              | Some s ->
               (trace
-                     (Bad_option_argument (parameter, command))
+                 (Bad_option_argument ("--" ^ long, command))
                  (converter ctx s)) >>|? fun x ->
               Some x
+          | _ :: _ ->
+              fail (Multiple_occurences ("--" ^ long, command))
         end
-          with Not_found ->
+    | DefArg { parameter = (long, _) ; kind = { converter ; _ } ; default ; _ } ->
-            return None
-        end
-    | DefArg { parameter ; 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 ->
+                   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
-    | 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 =
+  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
     | 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
+           | 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
-        end
 
 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
+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 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
+          | 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))
           | _, _ ->
               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
+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
+      | 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
+        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 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,9 +1011,9 @@ 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
+          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 ->
               continuation args 0 >>|? fun cont_args ->
               remaining_spec seen args_spec @ cont_args
@@ -995,7 +1021,6 @@ let complete_options (type ctx) continuation args args_spec ind (ctx : ctx) =
           | 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
         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@}."

src/lib_base/cli_entries.mli

@@ -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.
+(** [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. *)
 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.
+(** Create an argument that will contain the [~default] value if it is not provided. *)
-    see arg *)
 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} *)

src/lib_client_base/client_commands.ml

@@ -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 ()

src/lib_client_base/client_config.ml

@@ -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)

src/lib_client_base/client_debug.ml

@@ -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

src/lib_client_base/client_helpers.ml

@@ -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

src/lib_client_base/client_keys.ml

@@ -287,8 +287,9 @@ let commands () =
   let open Cli_entries in
   let show_private_switch =
     switch
-      ~parameter:"-show-secret"
+      ~long:"show-secret"
-      ~doc:"show the private key" in
+      ~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

src/proto_alpha/lib_client/client_proto_args.ml

@@ -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"
+      ~long:"baking"
-      ~doc:"run the baking daemon"
+      ~short:'B'
+      ~doc:"run the baking daemon" ()
   let endorsement_switch =
     switch
-      ~parameter:"-endorsement"
+      ~long:"endorsement"
-      ~doc:"run the endorsement daemon"
+      ~short:'E'
+      ~doc:"run the endorsement daemon" ()
   let denunciation_switch =
     switch
-      ~parameter:"-denunciation"
+      ~long:"denunciation"
-      ~doc:"run the denunciation daemon"
+      ~short:'D'
+      ~doc:"run the denunciation daemon" ()
 end

src/proto_alpha/lib_client/client_proto_programs_commands.ml

@@ -21,19 +21,24 @@ let commands () =
   let open Cli_entries in
   let show_types_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 =
     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 =
     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 =
     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 =

src/proto_genesis/lib_client/client_proto_main.ml

@@ -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 ->