CLI: New argument parsing and help messages

src/client/client_config.ml

@@ -9,6 +9,33 @@
 
 (* Tezos Command line interface - Configuration and Arguments Parsing *)
 
+type error += Invalid_block_argument of string
+type error += Invalid_port_arg of string
+let () =
+  register_error_kind
+    `Branch
+    ~id: "badBlocksArgument"
+    ~title: "Bad Blocks Argument"
+    ~description: "Blocks argument could not be parsed"
+    ~pp:
+      (fun ppf s ->
+         Format.fprintf ppf "Value provided for -block flag (%s) could not be parsed" s)
+    Data_encoding.(obj1 (req "value" string))
+    (function Invalid_block_argument s -> Some s | _ -> None)
+    (fun s -> Invalid_block_argument s) ;
+  register_error_kind
+    `Branch
+    ~id: "invalidPortArgument"
+    ~title: "Bad Port Argument"
+    ~description: "Port argument could not be parsed"
+    ~pp:
+      (fun ppf s ->
+         Format.fprintf ppf "Value provided for -port flag (%s) could not be parsed" s)
+    Data_encoding.(obj1 (req "value" string))
+    (function Invalid_port_arg s -> Some s | _ -> None)
+    (fun s -> Invalid_port_arg s)
+
+
 let (//) = Filename.concat
 
 module Cfg_file = struct
@@ -64,31 +91,104 @@ module Cfg_file = struct
 
 end
 
-exception Found of string
+type cli_args = {
+  block: Node_rpc_services.Blocks.block ;
+  print_timings: bool ;
+  log_requests: bool ;
+  force: bool ;
+}
 
-let preparse name argv =
+let default_cli_args = {
-  try
+  block = Client_commands.default_cfg.block ;
-    for i = 0 to Array.length argv - 2 do
+  print_timings = false ;
-      if argv.(i) = name then raise (Found argv.(i+1))
+  log_requests = false ;
-    done ;
+  force = false ;
-    None
+}
-  with Found s -> Some s
 
-let preparse_bool name argv =
+open Cli_entries
-  try
-    for i = 0 to Array.length argv - 1 do
-      if argv.(i) = name then raise (Found "")
-    done ;
-    false
-  with Found _ -> true
 
-let preparse_args argv =
+(* Command-line only args (not in config file) *)
-  let base_dir =
+let base_dir_arg =
-    match preparse "-base-dir" argv with
+  default_arg
-    | None -> Client_commands.default_base_dir
+    ~parameter:"-base-dir"
-    | Some base_dir -> base_dir in
+    ~doc:"The directory where the Tezos client will store all its data."
+    ~default:Client_commands.default_base_dir
+    (fun _ x -> return x)
+let config_file_arg =
+  arg
+    ~parameter:"-config-file"
+    ~doc:"The main configuration file."
+    (fun _ x -> return x)
+let timings_switch =
+  switch
+    ~parameter:"-timings"
+    ~doc:"Show RPC request times if present."
+let force_switch =
+  switch
+    ~parameter:"-force"
+    ~doc:"Show less courtesy than the average user."
+let block_arg =
+  default_arg
+    ~parameter:"-block"
+    ~doc:"The block on which to apply contextual commands."
+    ~default:(Node_rpc_services.Blocks.to_string default_cli_args.block)
+    (fun _ block -> match Node_rpc_services.Blocks.parse_block block with
+       | Error _ ->
+           fail (Invalid_block_argument block)
+       | Ok block -> return block)
+let log_requests_switch =
+  switch
+    ~parameter:"-log-requests"
+    ~doc:"Causes all requests and responses to the node to be logged."
+
+(* Command-line args which can be set in config file as well *)
+let addr_arg =
+  default_arg
+    ~parameter:"-addr"
+    ~doc:"The IP address of the node."
+    ~default:Cfg_file.default.node_addr
+    (fun _ x -> return x)
+let port_arg =
+  default_arg
+    ~parameter:"-port"
+    ~doc:"The RPC port of the node."
+    ~default:(string_of_int Cfg_file.default.node_port)
+    (fun _ x -> try
+        return (int_of_string x)
+      with Failure _ ->
+        fail (Invalid_port_arg x))
+let tls_switch =
+  switch
+    ~parameter:"-tls"
+    ~doc:"Use TLS to connect to node."
+
+let global_options =
+  args9 base_dir_arg
+    config_file_arg
+    force_switch
+    timings_switch
+    block_arg
+    log_requests_switch
+    addr_arg
+    port_arg
+    tls_switch
+
+let parse_config_args (ctx : Client_commands.cfg) argv =
+  parse_initial_options
+    global_options
+    ctx
+    argv >>|?
+  fun ((base_dir,
+        config_file,
+        force,
+        timings,
+        block,
+        log_requests,
+        node_addr,
+        node_port,
+        tls), remaining) ->
   let config_file =
-    match preparse "-config-file" argv with
+    match config_file with
     | None -> base_dir // "config"
     | Some config_file -> config_file in
   let config_dir = Filename.dirname config_file in
@@ -120,31 +220,7 @@ let preparse_args argv =
               "Error: can't parse the configuration file: %s\n%a@."
               config_file (fun ppf exn -> Json_encoding.print_error ppf exn) exn ;
             exit 1 in
-  let tls = cfg.tls || preparse_bool "-tls" argv in
+  let tls = cfg.tls || tls in
-  let node_addr =
-    match preparse "-addr" argv with
-    | None -> cfg.node_addr
-    | Some node_addr -> node_addr in
-  let node_port =
-    match preparse "-port" argv with
-    | None -> cfg.node_port
-    | Some port ->
-        try int_of_string port
-        with _ ->
-          Format.eprintf
-            "Error: can't parse the -port option: %S.@." port ;
-          exit 1 in
-  let block =
-    match preparse "-block" Sys.argv with
-    | None -> Client_commands.default_cfg.block
-    | Some block ->
-        match Node_rpc_services.Blocks.parse_block block with
-        | Error _ ->
-            Format.eprintf
-              "Error: can't parse the -block option: %S.@."
-              block ;
-            exit 1
-        | Ok block -> block in
   let cfg = { cfg with tls ; node_port ; node_addr } in
   if Sys.file_exists base_dir && not (Sys.is_directory base_dir) then begin
     Format.eprintf "Error: %s is not a directory.@." base_dir ;
@@ -157,87 +233,4 @@ let preparse_args argv =
   end ;
   IO.mkdir config_dir ;
   if not (Sys.file_exists config_file) then Cfg_file.write config_file cfg ;
-  (cfg, block)
+  (cfg, { block ; print_timings = timings ; log_requests ; force }, remaining)
-
-(* Entry point *)
-
-type cli_args = {
-  block: Node_rpc_services.Blocks.block ;
-  print_timings: bool ;
-  log_requests: bool ;
-  force: bool ;
-}
-
-let default_cli_args = {
-  block = Client_commands.default_cfg.block ;
-  print_timings = false ;
-  log_requests = false ;
-  force = false ;
-}
-
-exception Bad of Error_monad.error list
-
-let parse_args usage dispatcher argv =
-  (* Init config reference which will be updated as args are parsed *)
-  let parsed_args = ref default_cli_args in
-  (* Command-line only args (not in config file) *)
-  let cli_args = [
-    "-base-dir", Arg.String (fun _ -> ( (* preparsed *) )),
-      "The directory where the Tezos client will store all its data.\n\
-       default: " ^ Client_commands.default_base_dir ;
-    "-config-file", Arg.String (fun _ -> ( (* preparsed *) )),
-      "The main configuration file.\n\
-       default: " ^ Client_commands.default_base_dir // "config" ;
-    "-timings",
-      Arg.Bool (fun x -> parsed_args := { !parsed_args with print_timings = x }),
-      "Show RPC request times.\n\
-       default: " ^ string_of_bool default_cli_args.print_timings ;
-    "-force",
-      Arg.Bool (fun x -> parsed_args := { !parsed_args with force = x }),
-      "Show less courtesy than the average user.\n\
-       default: " ^ string_of_bool default_cli_args.force ;
-    "-block", Arg.String (fun _ -> ( (* preparsed *) )),
-      "The block on which to apply contextual commands.\n\
-       default: " ^ Node_rpc_services.Blocks.to_string default_cli_args.block ;
-    "-log-requests",
-    Arg.Unit (fun () -> parsed_args := { !parsed_args with log_requests = true }),
-    "If set, this flag causes all requests and responses to the node to be logged."
-  ] in
-  (* Command-line args which can be set in config file as well *)
-  let file_args = [
-    (* Network options *)
-    "-addr", Arg.String (fun _ -> ( (* preparsed *) )),
-      "The IP address at which the node's RPC server can be reached.\n\
-       default: " ^ Cfg_file.default.node_addr ;
-    "-port", Arg.Int (fun _ -> ( (* preparsed *) )),
-      "The TCP port at which the node's RPC server can be reached.\n\
-       default: " ^ string_of_int Cfg_file.default.node_port ;
-    "-tls", Arg.Bool (fun _ -> ( (* preparsed *) )),
-      "Use TLS to connect to node.\n\
-       default: " ^ string_of_bool Cfg_file.default.tls ;
-  ] in
-  let all_args = cli_args @ file_args in
-  try
-    let args = ref all_args in
-    let anon dispatch n = match dispatch (`Arg n) with
-      | `Nop -> ()
-      | `Args nargs -> args := nargs @ !args
-      | `Fail err -> raise (Bad err)
-      | `Res _ -> assert false in
-    let dispatch = dispatcher () in
-    Arg.parse_argv_dynamic
-      ~current:(ref 0) argv args (anon dispatch) "\000" ;
-    match dispatch `End with
-    | `Res res -> return (res, !parsed_args)
-    | `Fail err -> Lwt.return (Error err)
-    | `Nop | `Args _ -> assert false
-  with
-  | Bad err -> Lwt.return (Error err)
-  | Arg.Bad msg ->
-      (* FIXME: this is an ugly hack to circumvent [Arg]
-         spuriously printing options at the end of the error
-         message. *)
-      let msg = String.trim (List.hd (Utils.split '\000' msg)) in
-      Error_monad.failwith "%s" msg
-  | Arg.Help _ ->
-      raise (Arg.Help (usage all_args ^ "\n"))

src/client/client_generic_rpcs.ml

@@ -363,36 +363,43 @@ let group =
 let commands = [
 
   command ~desc: "list all understood protocol versions"
+    no_options
     (fixed [ "list" ; "versions" ])
-    (fun cctxt ->
+    (fun () cctxt ->
        Lwt_list.iter_s
          (fun (ver, _) -> cctxt.Client_commands.message "%a" Protocol_hash.pp_short ver)
          (Client_commands.get_versions ()) >>= fun () ->
        return ()) ;
 
   command ~group ~desc: "list available RPCs (low level command for advanced users)"
+    no_options
     (prefixes [ "rpc" ; "list" ] @@ stop)
-    (list "/");
+    (fun () -> (list "/"));
 
   command ~group ~desc: "list available RPCs (low level command for advanced users)"
+    no_options
     (prefixes [ "rpc" ; "list" ] @@ string ~name:"url" ~desc: "the RPC's prefix to be described" @@ stop)
-    list ;
+    (fun () -> list) ;
 
   command ~group ~desc: "get the input and output JSON schemas of an RPC"
+    no_options
     (prefixes [ "rpc" ; "schema" ] @@ string ~name: "url" ~desc: "the RPC's URL" @@ stop)
-    schema ;
+    (fun () -> schema) ;
 
   command ~group ~desc: "get the humanoid readable input and output formats of an RPC"
+    no_options
     (prefixes [ "rpc" ; "format" ] @@ string ~name: "url" ~desc: "the RPC's URL" @@ stop)
-    format ;
+    (fun () -> format) ;
 
   command ~group ~desc: "call an RPC (low level command for advanced users)"
+    no_options
     (prefixes [ "rpc" ; "call" ] @@ string ~name: "url" ~desc: "the RPC's URL" @@ stop)
-    call ;
+    (fun () -> call) ;
 
   command ~group ~desc: "call an RPC (low level command for advanced users)"
+    no_options
     (prefixes [ "rpc" ; "call" ] @@ string ~name: "url" ~desc: "the RPC's URL"
      @@ prefix "with" @@ string ~name:"input" ~desc:"the JSON input to the RPC" @@ stop)
-    call_with_json
+    (fun () -> call_with_json)
 
 ]

src/client/client_helpers.ml

@@ -10,11 +10,10 @@
 open Client_commands
 open Client_config
 
-let unique = ref false
+let unique_switch =
-let unique_arg =
+  Cli_entries.switch
-  "-unique",
+    ~parameter:"-unique"
-  Arg.Set unique,
+    ~doc:"Fail when there is more than one possible completion."
-  "Fail when there is more than one possible completion."
 
 let commands () = Cli_entries.[
     command
@@ -22,27 +21,27 @@ let commands () = Cli_entries.[
               given prefix of Base58Check-encoded hash. This actually \
               works only for blocks, operations, public key and contract \
               identifiers."
-      ~args: [unique_arg]
+      (args1 unique_switch)
       (prefixes [ "complete" ] @@
        string
          ~name: "prefix"
          ~desc: "the prefix of the Base58Check-encoded hash to be completed" @@
        stop)
-      (fun prefix cctxt ->
+      (fun unique prefix cctxt ->
          Client_node_rpcs.complete
            cctxt.rpc_config ~block:cctxt.config.block prefix >>=? fun completions ->
          match completions with
          | [] -> Pervasives.exit 3
-         | _ :: _ :: _ when !unique -> Pervasives.exit 3
+         | _ :: _ :: _ when unique -> Pervasives.exit 3
          | completions ->
              List.iter print_endline completions ;
              return ()) ;
     command
       ~desc: "Wait for the node to be bootstrapped."
-      ~args: []
+      no_options
       (prefixes [ "bootstrapped" ] @@
        stop)
-      (fun cctxt ->
+      (fun () cctxt ->
          Client_node_rpcs.bootstrapped cctxt.rpc_config >>=? fun stream ->
          Lwt_stream.iter_s (function
              | Ok (hash, time) ->

src/client/client_keys.ml

@@ -124,25 +124,26 @@ let group =
 let commands () =
   let open Cli_entries in
   let open Client_commands in
-  let show_private = ref false in
+  let show_private_switch =
-  let show_private_arg =
+    switch
-    "-show-secret",
+      ~parameter:"-show-secret"
-    Arg.Set show_private,
+      ~doc:"Show the private key" in
-    "Show the private key" in
   [
 
     command ~group ~desc: "generate a pair of keys"
+      no_options
       (prefixes [ "gen" ; "keys" ]
        @@ Secret_key.fresh_alias_param
        @@ stop)
-      (fun name cctxt -> gen_keys cctxt name) ;
+      (fun () name cctxt -> gen_keys cctxt name) ;
 
     command ~group ~desc: "add a secret key to the wallet"
+      no_options
       (prefixes [ "add" ; "secret" ; "key" ]
        @@ Secret_key.fresh_alias_param
        @@ Secret_key.source_param
        @@ stop)
-      (fun name sk cctxt ->
+      (fun () name sk cctxt ->
          Public_key.find_opt cctxt name >>=? function
          | None ->
              let pk = Sodium.Sign.secret_key_to_public_key sk in
@@ -159,25 +160,28 @@ let commands () =
              Secret_key.add cctxt name sk) ;
 
     command ~group ~desc: "add a public key to the wallet"
+      no_options
       (prefixes [ "add" ; "public" ; "key" ]
        @@ Public_key.fresh_alias_param
        @@ Public_key.source_param
        @@ stop)
-      (fun name key cctxt ->
+      (fun () name key cctxt ->
          Public_key_hash.add cctxt
            name (Ed25519.Public_key.hash key) >>=? fun () ->
          Public_key.add cctxt name key) ;
 
     command ~group ~desc: "add an ID a public key hash to the wallet"
+      no_options
       (prefixes [ "add" ; "identity" ]
        @@ Public_key_hash.fresh_alias_param
        @@ Public_key_hash.source_param
        @@ stop)
-      (fun name hash cctxt -> Public_key_hash.add cctxt name hash) ;
+      (fun () name hash cctxt -> Public_key_hash.add cctxt name hash) ;
 
     command ~group ~desc: "list all public key hashes and associated keys"
+      no_options
       (fixed [ "list" ; "known" ; "identities" ])
-      (fun cctxt ->
+      (fun () cctxt ->
          list_keys cctxt >>=? fun l ->
          iter_s
            (fun (name, pkh, pkm, pks) ->
@@ -189,11 +193,11 @@ let commands () =
            l) ;
 
     command ~group ~desc: "show the keys associated with an identity"
-      ~args: [ show_private_arg ]
+      (args1 show_private_switch)
       (prefixes [ "show" ; "identity"]
        @@ Public_key_hash.alias_param
        @@ stop)
-      (fun (name, _) cctxt ->
+      (fun show_private (name, _) cctxt ->
          let ok_lwt x = x >>= (fun x -> return x) in
          alias_keys cctxt name >>=? fun key_info ->
          match key_info with
@@ -206,7 +210,7 @@ let commands () =
              | Some pub ->
                  Public_key.to_source cctxt pub >>=? fun pub ->
                  ok_lwt @@ cctxt.message "Public Key: %s" pub >>=? fun () ->
-                 if !show_private then
+                 if show_private then
                    match priv with
                    | None -> return ()
                    | Some priv ->
@@ -215,8 +219,9 @@ let commands () =
                  else return ()) ;
 
     command ~group ~desc: "forget all keys"
+      no_options
       (fixed [ "forget" ; "all" ; "keys" ])
-      (fun cctxt ->
+      (fun () cctxt ->
          fail_unless cctxt.config.force
            (failure "this can only used with option -force true") >>=? fun () ->
          Public_key.save cctxt [] >>=? fun () ->

src/client/client_network.ml

@@ -16,7 +16,8 @@ let group =
 let commands () = [
   let open Cli_entries in
   command ~group ~desc: "show global network status"
-    (prefixes ["network" ; "stat"] stop) begin fun cctxt ->
+    no_options
+    (prefixes ["network" ; "stat"] stop) begin fun () cctxt ->
     Client_node_rpcs.Network.stat cctxt.rpc_config >>=? fun stat ->
     Client_node_rpcs.Network.connections cctxt.rpc_config >>=? fun conns ->
     Client_node_rpcs.Network.peers cctxt.rpc_config >>=? fun peers ->

src/client/client_protocols.ml

@@ -23,18 +23,20 @@ let commands () =
   [
 
     command ~group ~desc: "list known protocols"
+      no_options
       (prefixes [ "list" ; "protocols" ] stop)
-      (fun cctxt ->
+      (fun () cctxt ->
          Client_node_rpcs.Protocols.list cctxt.rpc_config ~contents:false () >>=? fun protos ->
          Lwt_list.iter_s (fun (ph, _p) -> cctxt.message "%a" Protocol_hash.pp ph) protos >>= fun () ->
          return ()
       );
 
     command ~group ~desc: "inject a new protocol to the shell database"
+      no_options
       (prefixes [ "inject" ; "protocol" ]
        @@ param ~name:"dir" ~desc:"directory containing a protocol" check_dir
        @@ stop)
-      (fun dirname cctxt ->
+      (fun () dirname cctxt ->
          Lwt.catch
            (fun () ->
               let proto = Tezos_compiler.read_dir dirname in
@@ -54,10 +56,11 @@ let commands () =
       );
 
     command ~group ~desc: "dump a protocol from the shell database"
+      no_options
       (prefixes [ "dump" ; "protocol" ]
        @@ Protocol_hash.param ~name:"protocol hash" ~desc:""
        @@ stop)
-      (fun ph cctxt ->
+      (fun () ph cctxt ->
          Client_node_rpcs.Protocols.contents cctxt.rpc_config ph >>=? fun proto ->
          Updater.extract "" ph proto >>= fun () ->
          cctxt.message "Extracted protocol %a" Protocol_hash.pp_short ph >>= fun () ->

src/client/embedded/alpha/baker/client_mining_daemon.ml

@@ -10,10 +10,10 @@
 open Client_commands
 open Logging.Client.Mining
 
-let run cctxt ?max_priority ~delay ?min_date delegates =
+let run cctxt ?max_priority ~delay ?min_date delegates ~endorsement ~denunciation ~mining =
   (* TODO really detach... *)
   let endorsement =
-    if Client_proto_args.Daemon.(!all || !endorsement) then
+    if endorsement then
       Client_mining_blocks.monitor
         cctxt.rpc_config ?min_date ~min_heads:1 () >>=? fun block_stream ->
       Client_mining_endorsement.create cctxt ~delay delegates block_stream >>= fun () ->
@@ -22,7 +22,7 @@ let run cctxt ?max_priority ~delay ?min_date delegates =
       return ()
   in
   let denunciation =
-    if Client_proto_args.Daemon.(!all || !denunciation) then
+    if denunciation then
       Client_mining_operations.monitor_endorsement
         cctxt.rpc_config >>=? fun endorsement_stream ->
       Client_mining_denunciation.create cctxt endorsement_stream >>= fun () ->
@@ -31,7 +31,7 @@ let run cctxt ?max_priority ~delay ?min_date delegates =
       return ()
   in
   let forge =
-    if Client_proto_args.Daemon.(!all || !mining) then begin
+    if mining then begin
       Client_mining_blocks.monitor
         cctxt.rpc_config ?min_date ~min_heads:1 () >>=? fun block_stream ->
       Client_mining_operations.monitor_endorsement

src/client/embedded/alpha/baker/client_mining_daemon.mli

@@ -12,4 +12,7 @@ val run:
   ?max_priority: int ->
   delay: int ->
   ?min_date: Time.t ->
-  public_key_hash list -> unit tzresult Lwt.t
+  public_key_hash list ->
+  endorsement:bool ->
+  denunciation:bool ->
+  mining:bool -> unit tzresult Lwt.t

src/client/embedded/alpha/baker/client_mining_main.ml

@@ -94,11 +94,12 @@ let reveal_nonces cctxt ?force () =
 
 open Client_proto_args
 
-let run_daemon cctxt delegates =
+let run_daemon cctxt max_priority endorsement_delay delegates ~endorsement ~mining ~denunciation =
   Client_mining_daemon.run cctxt
-    ?max_priority:!max_priority
+    ?max_priority
-    ~delay:!endorsement_delay
+    ~delay:endorsement_delay
     ~min_date:((Time.add (Time.now ()) (Int64.neg 1800L)))
+    ~endorsement ~mining ~denunciation
     (List.map snd delegates)
 
 let group =
@@ -109,43 +110,47 @@ let commands () =
   let open Cli_entries in
   [
     command ~group ~desc: "Launch a daemon that handles delegate operations."
-      ~args: [endorsement_delay_arg; max_priority_arg;
+      (args5 max_priority_arg endorsement_delay_arg
-              Daemon.mining_arg ; Daemon.endorsement_arg ; Daemon.denunciation_arg]
+                  Daemon.mining_switch Daemon.endorsement_switch Daemon.denunciation_switch)
       (prefixes [ "launch" ; "daemon" ]
        @@ seq_of_param Client_keys.Public_key_hash.alias_param)
-      (fun delegates cctxt ->
+      (fun (max_priority, endorsement_delay, mining, endorsement, denunciation) delegates cctxt ->
-         run_daemon cctxt delegates) ;
+         let (endorsement, mining, denunciation) =
+           if (not endorsement) && (not mining) && (not denunciation)
+           then (true, true, true)
+           else (endorsement, mining, denunciation) in
+         run_daemon cctxt max_priority endorsement_delay ~endorsement ~mining ~denunciation delegates) ;
     command ~group ~desc: "Forge and inject an endorsement operation"
-      ~args: [ force_arg ]
+      (args2 force_switch max_priority_arg)
       (prefixes [ "endorse"; "for" ]
        @@ Client_keys.Public_key_hash.alias_param
          ~name:"miner" ~desc: "name of the delegate owning the endorsement right"
        @@ stop)
-      (fun (_, delegate) cctxt ->
+      (fun (force, max_priority) (_, delegate) cctxt ->
          endorse_block cctxt
-           ~force:!force ?max_priority:!max_priority delegate) ;
+           ~force ?max_priority delegate) ;
     command ~group ~desc: "Forge and inject block using the delegate rights"
-      ~args: [ max_priority_arg ; force_arg ; free_mining_arg ]
+      (args3 max_priority_arg force_switch free_mining_switch)
       (prefixes [ "mine"; "for" ]
        @@ Client_keys.Public_key_hash.alias_param
          ~name:"miner" ~desc: "name of the delegate owning the mining right"
        @@ stop)
-      (fun (_, delegate) cctxt ->
+      (fun (max_priority, force, free_mining) (_, delegate) cctxt ->
          mine_block cctxt cctxt.config.block
-           ~force:!force ?max_priority:!max_priority ~free_mining:!free_mining delegate) ;
+           ~force ?max_priority ~free_mining delegate) ;
     command ~group ~desc: "Forge and inject a seed-nonce revelation operation"
-      ~args: [ force_arg ]
+      (args1 force_switch)
       (prefixes [ "reveal"; "nonce"; "for" ]
-       @@ Cli_entries.seq_of_param Block_hash.param)
+       @@ seq_of_param Block_hash.param)
-      (fun block_hashes cctxt ->
+      (fun force block_hashes cctxt ->
          reveal_block_nonces cctxt
-           ~force:!force block_hashes) ;
+           ~force block_hashes) ;
     command ~group ~desc: "Forge and inject redemption operations"
-      ~args: [ force_arg ]
+      (args1 force_switch)
       (prefixes [ "reveal"; "nonces" ]
        @@ stop)
-      (fun cctxt ->
+      (fun force cctxt ->
-         reveal_nonces cctxt ~force:!force ()) ;
+         reveal_nonces cctxt ~force ()) ;
   ]
 
 let () =

src/client/embedded/alpha/client_proto_args.ml

@@ -7,129 +7,156 @@
 (*                                                                        *)
 (**************************************************************************)
 
+open Cli_entries
+
+type error += Bad_tez_arg of string * string (* Arg_name * value *)
+type error += Bad_max_priority of string
+type error += Bad_endorsement_delay of string
+
+let () =
+  register_error_kind
+    `Permanent
+    ~id:"badTezArg"
+    ~title:"Bad Tez Arg"
+    ~description:("Invalid \xEA\x9C\xA9 notation in parameter.")
+    ~pp:(fun ppf (arg_name, literal) ->
+        Format.fprintf ppf
+          "Invalid \xEA\x9C\xA9 notation in parameter %s: '%s'"
+          arg_name literal)
+    Data_encoding.(obj2
+                     (req "parameter" string)
+                     (req "literal" string))
+    (function Bad_tez_arg (parameter, literal) -> Some (parameter, literal) | _ -> None)
+    (fun (parameter, literal) -> Bad_tez_arg (parameter, literal)) ;
+  register_error_kind
+    `Permanent
+    ~id:"badMaxPriorityArg"
+    ~title:"Bad -max-priority arg"
+    ~description:("invalid priority in -max-priority")
+    ~pp:(fun ppf literal ->
+        Format.fprintf ppf "invalid priority '%s'in -max-priority" literal)
+    Data_encoding.(obj1 (req "parameter" string))
+    (function Bad_max_priority parameter -> Some parameter | _ -> None)
+    (fun parameter -> Bad_max_priority parameter) ;
+  register_error_kind
+    `Permanent
+    ~id:"badEndorsementDelayArg"
+    ~title:"Bad -endorsement-delay arg"
+    ~description:("invalid priority in -endorsement-delay")
+    ~pp:(fun ppf literal ->
+        Format.fprintf ppf "Bad argument value for -endorsement-delay. Expected an integer, but given '%s'" literal)
+    Data_encoding.(obj1 (req "parameter" string))
+    (function Bad_endorsement_delay parameter -> Some parameter | _ -> None)
+    (fun parameter -> Bad_endorsement_delay parameter)
+  
+
 let tez_sym =
   "\xEA\x9C\xA9"
 
-let tez_of_string s =
-  match Tez.of_string s with
-  | None -> invalid_arg "tez_of_string"
-  | Some t -> t
-
-let init = ref "Unit"
 let init_arg =
-  "-init",
+  default_arg
-  Arg.Set_string init,
+    ~parameter:"-init"
-  "The initial value of the contract's storage.\n\
+    ~doc:"The initial value of the contract's storage."
-   default: unit"
+    ~default:"Unit"
+    (fun _ s -> return s)
 
-let arg = ref None
 let arg_arg =
-  "-arg",
+  default_arg
-  Arg.String (fun a -> arg := Some a),
+    ~parameter:"-arg"
-  "The argument passed to the contract's script, if needed.\n\
+    ~doc:"The argument passed to the contract's script, if needed."
-   default: no argument"
+    ~default:"Unit"
+    (fun _ a -> return a)
   
-let delegate = ref None
 let delegate_arg =
-  "-delegate",
+  arg
-  Arg.String (fun s -> delegate := Some s),
+    ~parameter:"-delegate"
-  "Set the delegate of the contract.\n\
+    ~doc:"Set the delegate of the contract.\
           Must be a known identity."
+    (fun _ s -> return s)
+  
 
-let source = ref None
 let source_arg =
-  "-source",
+  arg
-  Arg.String (fun s -> source := Some s),
+    ~parameter:"-source"
-  "Set the source of the bonds to be paid.\n\
+    ~doc:"Set the source of the bonds to be paid.\
           Must be a known identity."
+    (fun _ s -> return s)
 
-let spendable = ref true
+let non_spendable_switch =
-let spendable_args =
+  switch
-  [ "-spendable",
+    ~parameter:"-non-spendable"
-    Arg.Set spendable,
+    ~doc:"Set the created contract to be non spendable"
-    "Set the created contract to be spendable (default)" ;
-    "-non-spendable",
-    Arg.Clear spendable,
-    "Set the created contract to be non spendable" ]
 
-let force = ref false
+let force_switch =
-let force_arg =
+  switch
-  "-force",
+    ~parameter:"-force"
-  Arg.Set force,
+    ~doc:"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 bleck without a fitness greater than the \
          \ current head."
 
-let delegatable = ref false
+let delegatable_switch =
-let delegatable_args =
+  switch
-  [ "-delegatable",
+    ~parameter:"-delegatable"
-    Arg.Set delegatable,
+    ~doc:"Set the created contract to be delegatable"
-    "Set the created contract to be delegatable" ;
-    "-non-delegatable",
-    Arg.Clear delegatable,
-    "Set the created contract to be non delegatable (default)" ]
 
 let tez_format = "text format: D,DDD,DDD.DD (centiles are optional, commas are optional)"
 
-let tez_arg ~name ~desc ~default =
+let tez_arg ~default ~parameter ~doc =
-  let ref_cell = ref (tez_of_string default) in
+  default_arg ~parameter ~doc ~default
-  (ref_cell,
+    (fun _ s ->
-   (name,
+       match Tez.of_string s with
-    Arg.String (fun s ->
+       | Some tez -> return tez
-        try ref_cell := tez_of_string s
+       | None -> fail (Bad_tez_arg (parameter, s)))
-        with _ -> raise (Arg.Bad
-                           ("invalid \xEA\x9C\xA9 notation in parameter " ^ name))),
-    (Printf.sprintf
-       "%s\ndefault: \"%s\"\n%s"
-       desc
-       default
-       tez_format)))
 
 let tez_param ~name ~desc next =
   Cli_entries.param
     name
     (desc ^ " in \xEA\x9C\xA9\n" ^ tez_format)
     (fun _ s ->
-       try return (tez_of_string s)
+       match Tez.of_string s with
-       with _ -> failwith "invalid \xEA\x9C\xA9 notation")
+       | None -> fail (Bad_tez_arg (name, s))
+       | Some tez -> return tez)
     next
 
-let fee, fee_arg =
+let fee_arg =
   tez_arg
-    ~name:"-fee"
-    ~desc:"The fee in \xEA\x9C\xA9 to pay to the miner."
     ~default:"0.05"
+    ~parameter:"-fee"
+    ~doc:"The fee in \xEA\x9C\xA9 to pay to the miner."
 
-let max_priority = ref None
 let max_priority_arg =
-  "-max-priority",
+  arg
-  Arg.String (fun s ->
+    ~parameter:"-max-priority"
-      try max_priority := Some (int_of_string s)
+    ~doc:"Set the max_priority used when looking for mining slot."
-      with _ -> raise (Arg.Bad "invalid priority in -max-priority")),
+    (fun _ s ->
-  "Set the max_priority used when looking for mining slot."
+       try return (int_of_string s)
+       with _ -> fail (Bad_max_priority s))
 
-let free_mining = ref false
+let free_mining_switch =
-let free_mining_arg =
+  switch
-    "-free-mining", Arg.Set free_mining, "Only consider free mining slots."
+    ~parameter:"-free-mining"
+    ~doc:"Only consider free mining slots."
 
-let endorsement_delay = ref 15
 let endorsement_delay_arg =
-  "-endorsement-delay",
+  default_arg
-  Arg.String (fun s ->
+    ~parameter:"-endorsement-delay"
-      try endorsement_delay := int_of_string s
+    ~doc:"Set the delay used before to endorse the current block."
-      with _ -> raise (Arg.Bad "invalid priority in -endorsement-delay")),
+    ~default:"15"
-  "Set the delay used before to endorse the current block."
+    (fun _ s ->
+       try return (int_of_string s)
+       with _ -> fail (Bad_endorsement_delay s))
 
 module Daemon = struct
-  let all = ref true
+  let mining_switch =
-  let arg r = Arg.Unit (fun () -> all := false; r := true)
+    switch
-  let mining = ref false
+      ~parameter:"-mining"
-  let mining_arg =
+      ~doc:"Run the mining daemon"
-    "-mining", arg mining, "Run the mining daemon"
+  let endorsement_switch =
-  let endorsement = ref false
+    switch
-  let endorsement_arg =
+      ~parameter:"-endorsement"
-    "-endorsement", arg endorsement, "Run the endorsement daemon"
+      ~doc:"Run the endorsement daemon"
-  let denunciation = ref false
+  let denunciation_switch =
-  let denunciation_arg =
+    switch
-    "-denunciation", arg denunciation, "Run the denunciation daemon"
+      ~parameter:"-denunciation"
+      ~doc:"Run the denunciation daemon"
 end

src/client/embedded/alpha/client_proto_args.mli

@@ -9,47 +9,33 @@
 
 val tez_sym: string
 
-val init_arg: string * Arg.spec * string
+open Cli_entries
-val fee_arg: string * Arg.spec * string
+val init_arg: (string, Client_commands.context) arg
-val arg_arg: string * Arg.spec * string
+val fee_arg: (Tez.t, Client_commands.context) arg
-val source_arg: string * Arg.spec * string
+val arg_arg: (string, Client_commands.context) arg
-val delegate_arg: string * Arg.spec * string
+val source_arg: (string option, Client_commands.context) arg
-val delegatable_args: (string * Arg.spec * string) list
+
-val spendable_args: (string * Arg.spec * string) list
+val delegate_arg: (string option, Client_commands.context) arg
-val max_priority_arg: string * Arg.spec * string
+val delegatable_switch: (bool, Client_commands.context) arg
-val free_mining_arg: string * Arg.spec * string
+val non_spendable_switch: (bool, Client_commands.context) arg
-val force_arg: string * Arg.spec * string
+val max_priority_arg: (int option, Client_commands.context) arg
-val endorsement_delay_arg: string * Arg.spec * string
+val free_mining_switch: (bool, Client_commands.context) arg
+val force_switch: (bool, Client_commands.context) arg
+val endorsement_delay_arg: (int, Client_commands.context) arg
 
 val tez_arg :
-  name:string ->
-  desc:string ->
   default:string ->
-  Tez.tez ref * (string * Arg.spec * string)
+  parameter:string ->
+  doc:string ->
+  (Tez.t, Client_commands.context) arg
 val tez_param :
   name:string ->
   desc:string ->
   ('a, Client_commands.context, 'ret) Cli_entries.params ->
   (Tez.t -> 'a, Client_commands.context, 'ret) Cli_entries.params
 
-val delegate: string option ref
-val source: string option ref
-val delegatable: bool ref
-val spendable: bool ref
-val force: bool ref
-val fee: Tez.t ref
-val init: string ref
-val arg: string option ref
-val max_priority: int option ref
-val free_mining: bool ref
-val endorsement_delay: int ref
-
 module Daemon : sig
-  val mining_arg: string * Arg.spec * string
+  val mining_switch: (bool, Client_commands.context) arg
-  val endorsement_arg: string * Arg.spec * string
+  val endorsement_switch: (bool, Client_commands.context) arg
-  val denunciation_arg: string * Arg.spec * string
+  val denunciation_switch: (bool, Client_commands.context) arg
-  val all: bool ref
-  val mining: bool ref
-  val endorsement: bool ref
-  val denunciation: bool ref
 end

src/client/embedded/alpha/client_proto_context.ml

@@ -43,7 +43,6 @@ let get_branch rpc_config block branch =
 let transfer rpc_config
     block ?force ?branch
     ~source ~src_pk ~src_sk ~destination ?arg ~amount ~fee () =
-  let open Cli_entries in
   get_branch rpc_config block branch >>=? fun (net_id, branch) ->
   begin match arg with
     | Some arg ->
@@ -106,7 +105,7 @@ let originate_account rpc_config
 let originate_contract rpc_config
     block ?force ?branch
     ~source ~src_pk ~src_sk ~manager_pkh ~balance ?delegatable ?delegatePubKey
-    ~(code:Script.code) ~init ~fee () =
+    ~(code:Script.code) ~init ~fee ~spendable () =
   Client_proto_programs.parse_data init >>=? fun storage ->
   let storage = Script.{ storage=storage.ast ; storage_type = code.storage_type } in
   Client_proto_rpcs.Context.Contract.counter
@@ -115,7 +114,7 @@ let originate_contract rpc_config
   get_branch rpc_config block branch >>=? fun (net_id, branch) ->
   Client_proto_rpcs.Helpers.Forge.Manager.origination rpc_config block
     ~net_id ~branch ~source ~sourcePubKey:src_pk ~managerPubKey:manager_pkh
-    ~counter ~balance ~spendable:!spendable
+    ~counter ~balance ~spendable:spendable
     ?delegatable ?delegatePubKey
     ~script:{ code ; storage } ~fee () >>=? fun bytes ->
   let signature = Ed25519.sign src_sk bytes in
@@ -229,23 +228,29 @@ let dictate rpc_config block command seckey =
   assert (Operation_hash.equal oph injected_oph) ;
   return oph
 
+let default_fee =
+  match Tez.of_cents 5L with
+  | None -> raise (Failure "internal error: Could not parse default_fee literal")
+  | Some fee -> fee
+
 let commands () =
   let open Cli_entries in
   let open Client_commands in
   [
-
+    command ~group ~desc: "access the timestamp of the block"
-    command ~group ~desc: "access the timestamp of the block" begin
+      no_options
-      fixed [ "get" ; "timestamp" ]
+      (fixed [ "get" ; "timestamp" ])
-    end begin fun cctxt ->
+      begin fun () cctxt ->
         Client_node_rpcs.Blocks.timestamp
           cctxt.rpc_config cctxt.config.block >>=? fun v ->
         cctxt.message "%s" (Time.to_notation v) >>= fun () ->
         return ()
       end ;
 
-    command ~group ~desc: "lists all non empty contracts of the block" begin
+    command ~group ~desc: "lists all non empty contracts of the block"
-      fixed [ "list" ; "contracts" ]
+      no_options
-    end begin fun cctxt ->
+      (fixed [ "list" ; "contracts" ])
+      begin fun () cctxt ->
         list_contract_labels cctxt cctxt.config.block >>=? fun contracts ->
         Lwt_list.iter_s
           (fun (alias, hash, kind) -> cctxt.message "%s%s%s" hash kind alias)
@@ -253,21 +258,23 @@ let commands () =
         return ()
       end ;
 
-    command ~group ~desc: "get the balance of a contract" begin
+    command ~group ~desc: "get the balance of a contract"
-      prefixes [ "get" ; "balance" ; "for" ]
+      no_options
+      (prefixes [ "get" ; "balance" ; "for" ]
        @@ ContractAlias.destination_param ~name:"src" ~desc:"source contract"
-      @@ stop
+       @@ stop)
-    end begin fun (_, contract) cctxt ->
+      begin fun () (_, contract) cctxt ->
         get_balance cctxt.rpc_config cctxt.config.block contract >>=? fun amount ->
         cctxt.answer "%a %s" Tez.pp amount tez_sym >>= fun () ->
         return ()
       end ;
 
-    command ~group ~desc: "get the storage of a contract" begin
+    command ~group ~desc: "get the storage of a contract"
-      prefixes [ "get" ; "storage" ; "for" ]
+      no_options
+      (prefixes [ "get" ; "storage" ; "for" ]
        @@ ContractAlias.destination_param ~name:"src" ~desc:"source contract"
-      @@ stop
+       @@ stop)
-    end begin fun (_, contract) cctxt ->
+      begin fun () (_, contract) cctxt ->
         get_storage cctxt.rpc_config cctxt.config.block contract >>=? function
         | None ->
             cctxt.error "This is not a smart contract."
@@ -276,11 +283,12 @@ let commands () =
             return ()
       end ;
 
-    command ~group ~desc: "get the manager of a contract" begin
+    command ~group ~desc: "get the manager of a contract"
-      prefixes [ "get" ; "manager" ; "for" ]
+      no_options
+      (prefixes [ "get" ; "manager" ; "for" ]
        @@ ContractAlias.destination_param ~name:"src" ~desc:"source contract"
-      @@ stop
+       @@ stop)
-    end begin fun (_, contract) cctxt ->
+      begin fun () (_, contract) cctxt ->
         Client_proto_contracts.get_manager
           cctxt.rpc_config cctxt.config.block contract >>=? fun manager ->
         Public_key_hash.rev_find cctxt manager >>=? fun mn ->
@@ -290,11 +298,12 @@ let commands () =
         return ()
       end ;
 
-    command ~group ~desc: "get the delegate of a contract" begin
+    command ~group ~desc: "get the delegate of a contract"
-      prefixes [ "get" ; "delegate" ; "for" ]
+      no_options
+      (prefixes [ "get" ; "delegate" ; "for" ]
        @@ ContractAlias.destination_param ~name:"src" ~desc:"source contract"
-      @@ stop
+       @@ stop)
-    end begin fun (_, contract) cctxt ->
+      begin fun () (_, contract) cctxt ->
         Client_proto_contracts.get_delegate
           cctxt.rpc_config cctxt.config.block contract >>=? fun delegate ->
         Public_key_hash.rev_find cctxt delegate >>=? fun mn ->
@@ -305,27 +314,27 @@ let commands () =
       end ;
 
     command ~group ~desc: "set the delegate of a contract"
-      ~args: ([ fee_arg ; force_arg ]) begin
+      (args2 fee_arg force_switch)
-      prefixes [ "set" ; "delegate" ; "for" ]
+      (prefixes [ "set" ; "delegate" ; "for" ]
        @@ ContractAlias.destination_param ~name:"src" ~desc:"source contract"
        @@ prefix "to"
        @@ Public_key_hash.alias_param
          ~name: "mgr" ~desc: "new delegate of the contract"
-      @@ stop
+       @@ stop)
-    end begin fun (_, contract) (_, delegate) cctxt ->
+      begin fun (fee, force) (_, contract) (_, delegate) cctxt ->
         get_manager cctxt contract >>=? fun (_src_name, _src_pkh, src_pk, src_sk) ->
         delegate_contract
           cctxt.rpc_config cctxt.config.block ~source:contract
-        ~src_pk ~manager_sk:src_sk ~fee:!fee (Some delegate)
+          ~src_pk ~manager_sk:src_sk ~fee (Some delegate)
         >>=? fun oph ->
-      message_injection cctxt ~force:!force oph >>= fun () ->
+        message_injection cctxt ~force:force oph >>= fun () ->
         return ()
       end ;
 
     command ~group ~desc: "open a new account"
-      ~args: ([ fee_arg ; delegate_arg ; force_arg ]
+      (args5 fee_arg delegate_arg delegatable_switch
-              @ delegatable_args @ spendable_args) begin
+                  force_switch non_spendable_switch)
-      prefixes [ "originate" ; "account" ]
+      (prefixes [ "originate" ; "account" ]
        @@ RawContractAlias.fresh_alias_param
          ~name: "new" ~desc: "name of the new contract"
        @@ prefix "for"
@@ -337,26 +346,28 @@ let commands () =
        @@ prefix "from"
        @@ ContractAlias.alias_param
          ~name:"src" ~desc: "name of the source contract"
-      @@ stop
+       @@ stop)
-    end begin fun neu (_, manager) balance (_, source) cctxt ->
+      begin fun (fee, delegate, delegatable, force, non_spendable)
+        neu (_, manager) balance (_, source) cctxt ->
         check_contract cctxt neu >>=? fun () ->
-      get_delegate_pkh cctxt !delegate >>=? fun delegate ->
+        get_delegate_pkh cctxt delegate >>=? fun delegate ->
         get_manager cctxt source >>=? fun (_src_name, _src_pkh, src_pk, src_sk) ->
-      originate_account cctxt.rpc_config cctxt.config.block ~force:!force
+        originate_account cctxt.rpc_config cctxt.config.block ~force:force
-        ~source ~src_pk ~src_sk ~manager_pkh:manager ~balance ~fee:!fee
+          ~source ~src_pk ~src_sk ~manager_pkh:manager ~balance ~fee
-        ~delegatable:!delegatable ~spendable:!spendable ?delegate:delegate
+          ~delegatable:delegatable ~spendable:(not non_spendable) ?delegate:delegate
           () >>=? fun (oph, contract) ->
         message_injection cctxt
-        ~force:!force ~contracts:[contract] oph >>= fun () ->
+          ~force:force ~contracts:[contract] oph >>= fun () ->
         RawContractAlias.add cctxt neu contract >>=? fun () ->
         message_added_contract cctxt neu >>= fun () ->
         return ()
       end ;
 
     command ~group ~desc: "open a new scripted account"
-      ~args: ([ fee_arg ; delegate_arg ; force_arg ] @
+      (args6
-              delegatable_args @ spendable_args @ [ init_arg ]) begin
+                  fee_arg delegate_arg force_switch
-      prefixes [ "originate" ; "contract" ]
+                  delegatable_switch non_spendable_switch init_arg)
+      (prefixes [ "originate" ; "contract" ]
        @@ RawContractAlias.fresh_alias_param
          ~name: "new" ~desc: "name of the new contract"
        @@ prefix "for"
@@ -372,50 +383,52 @@ let commands () =
        @@ Program.source_param
          ~name:"prg" ~desc: "script of the account\n\
                              combine with -init if the storage type is not unit"
-      @@ stop
+       @@ stop)
-    end begin fun neu (_, manager) balance (_, source) { ast = code } cctxt ->
+      begin fun (fee, delegate, force, delegatable, non_spendable, init)
+        neu (_, manager) balance (_, source) { ast = code } cctxt ->
         check_contract cctxt neu >>=? fun () ->
-      get_delegate_pkh cctxt !delegate >>=? fun delegate ->
+        get_delegate_pkh cctxt delegate >>=? fun delegate ->
         get_manager cctxt source >>=? fun (_src_name, _src_pkh, src_pk, src_sk) ->
-      originate_contract cctxt.rpc_config cctxt.config.block ~force:!force
+        originate_contract cctxt.rpc_config cctxt.config.block ~force:force
-        ~source ~src_pk ~src_sk ~manager_pkh:manager ~balance ~fee:!fee
+          ~source ~src_pk ~src_sk ~manager_pkh:manager ~balance ~fee
-        ~delegatable:!delegatable ?delegatePubKey:delegate ~code ~init:!init
+          ~delegatable:delegatable ?delegatePubKey:delegate ~code
+          ~init
+          ~spendable:(not non_spendable)
           () >>=function
         | Error errs ->
             Client_proto_programs.report_errors cctxt errs >>= fun () ->
             cctxt.error "origination simulation failed"
         | Ok (oph, contract) ->
             message_injection cctxt
-            ~force:!force ~contracts:[contract] oph >>= fun () ->
+              ~force:force ~contracts:[contract] oph >>= fun () ->
             RawContractAlias.add cctxt neu contract >>=? fun () ->
             message_added_contract cctxt neu >>= fun () ->
             return ()
       end ;
 
     command ~group ~desc: "open a new (free) account"
-      ~args: ([ fee_arg ; delegate_arg ; force_arg ]
+      (args1 force_switch)
-              @ delegatable_args @ spendable_args) begin
+      (prefixes [ "originate" ; "free" ; "account" ]
-      prefixes [ "originate" ; "free" ; "account" ]
        @@ RawContractAlias.fresh_alias_param
          ~name: "new" ~desc: "name of the new contract"
        @@ prefix "for"
        @@ Public_key_hash.alias_param
          ~name: "mgr" ~desc: "manager of the new contract"
-      @@ stop end
+       @@ stop)
-      begin fun neu (_, manager) cctxt ->
+      begin fun force neu (_, manager) cctxt ->
         check_contract cctxt neu >>=? fun () ->
         faucet cctxt.rpc_config cctxt.config.block
-          ~force:!force ~manager_pkh:manager () >>=? fun (oph, contract) ->
+          ~force:force ~manager_pkh:manager () >>=? fun (oph, contract) ->
         message_injection cctxt
-          ~force:!force ~contracts:[contract] oph >>= fun () ->
+          ~force:force ~contracts:[contract] oph >>= fun () ->
         RawContractAlias.add cctxt neu contract >>=? fun () ->
         message_added_contract cctxt neu >>= fun () ->
         return ()
       end;
 
     command ~group ~desc: "transfer tokens"
-      ~args: [ fee_arg ; arg_arg ; force_arg ] begin
+      (args3 fee_arg arg_arg force_switch)
-      prefixes [ "transfer" ]
+      (prefixes [ "transfer" ]
        @@ tez_param
          ~name: "qty" ~desc: "amount taken from source"
        @@ prefix "from"
@@ -424,45 +437,49 @@ let commands () =
        @@ prefix "to"
        @@ ContractAlias.destination_param
          ~name: "dst" ~desc: "name/literal of the destination contract"
-      @@ stop
+       @@ stop)
-    end begin fun amount (_, source) (_, destination) cctxt ->
+      begin fun (fee, arg, force) amount (_, source) (_, destination) cctxt ->
         get_manager cctxt source >>=? fun (_src_name, _src_pkh, src_pk, src_sk) ->
-      transfer cctxt.rpc_config cctxt.config.block ~force:!force
+        transfer cctxt.rpc_config cctxt.config.block ~force:force
           ~source ~src_pk ~src_sk ~destination
-        ?arg:!arg ~amount ~fee:!fee () >>= function
+          ~arg ~amount ~fee () >>= function
         | Error errs ->
             Client_proto_programs.report_errors cctxt errs >>= fun () ->
             cctxt.error "transfer simulation failed"
         | Ok (oph, contracts) ->
-          message_injection cctxt ~force:!force ~contracts oph >>= fun () ->
+            message_injection cctxt ~force:force ~contracts oph >>= fun () ->
             return ()
       end;
 
-    command ~desc: "Activate a protocol" begin
+    command ~desc: "Activate a protocol"
-      prefixes [ "activate" ; "protocol" ] @@
+      (args1 force_switch)
-      Protocol_hash.param ~name:"version" ~desc:"Protocol version (b58check)" @@
+      (prefixes [ "activate" ; "protocol" ]
-      prefixes [ "with" ; "key" ] @@
+       @@ Protocol_hash.param ~name:"version"
-      Environment.Ed25519.Secret_key.param
+         ~desc:"Protocol version (b58check)"
-        ~name:"password" ~desc:"Dictator's key" @@
+       @@ prefixes [ "with" ; "key" ]
-        stop
+       @@ Environment.Ed25519.Secret_key.param
-    end begin fun hash seckey cctxt ->
+         ~name:"password" ~desc:"Dictator's key"
+       @@ stop)
+      begin fun force hash seckey cctxt ->
         dictate cctxt.rpc_config cctxt.config.block
           (Activate hash) seckey >>=? fun oph ->
-      message_injection cctxt ~force:!force oph >>= fun () ->
+        message_injection cctxt ~force:force oph >>= fun () ->
         return ()
       end ;
 
-    command ~desc: "Fork a test protocol" begin
+    command ~desc: "Fork a test protocol"
-      prefixes [ "fork" ; "test" ; "protocol" ] @@
+      (args1 force_switch)
-      Protocol_hash.param ~name:"version" ~desc:"Protocol version (b58check)" @@
+      (prefixes [ "fork" ; "test" ; "protocol" ]
-      prefixes [ "with" ; "key" ] @@
+       @@ Protocol_hash.param ~name:"version"
-      Environment.Ed25519.Secret_key.param
+         ~desc:"Protocol version (b58check)"
-        ~name:"password" ~desc:"Dictator's key" @@
+       @@ prefixes [ "with" ; "key" ]
-      stop
+       @@ Environment.Ed25519.Secret_key.param
-    end begin fun hash seckey cctxt ->
+         ~name:"password" ~desc:"Dictator's key"
+       @@ stop)
+      begin fun force hash seckey cctxt ->
         dictate cctxt.rpc_config cctxt.config.block
           (Activate_testnet hash) seckey >>=? fun oph ->
-      message_injection cctxt ~force:!force oph >>= fun () ->
+        message_injection cctxt ~force:force oph >>= fun () ->
         return ()
       end ;
 

src/client/embedded/alpha/client_proto_context.mli

@@ -60,6 +60,7 @@ val originate_contract:
   code:Script.code ->
   init:string ->
   fee:Tez.t ->
+  spendable:bool ->
   unit -> (Operation_hash.t * Contract.t) tzresult Lwt.t
 
 val delegate_contract:

src/client/embedded/alpha/client_proto_contracts.ml

@@ -166,22 +166,25 @@ let commands  () =
   [
 
     command ~group ~desc: "add a contract to the wallet"
+      no_options
       (prefixes [ "remember" ; "contract" ]
        @@ RawContractAlias.fresh_alias_param
        @@ RawContractAlias.source_param
        @@ stop)
-      (fun name hash cctxt ->
+      (fun () name hash cctxt ->
          RawContractAlias.add cctxt name hash) ;
 
     command ~group ~desc: "remove a contract from the wallet"
+      no_options
       (prefixes [ "forget" ; "contract" ]
        @@ RawContractAlias.alias_param
        @@ stop)
-      (fun (name, _) cctxt -> RawContractAlias.del cctxt name) ;
+      (fun () (name, _) cctxt -> RawContractAlias.del cctxt name) ;
 
     command ~group ~desc: "lists all known contracts"
+      no_options
       (fixed [ "list" ; "known" ; "contracts" ])
-      (fun cctxt ->
+      (fun () cctxt ->
          list_contracts cctxt >>=? fun contracts ->
          iter_s
            (fun (prefix, alias, contract) ->
@@ -191,28 +194,31 @@ let commands  () =
            contracts) ;
 
     command ~group ~desc: "forget all known contracts"
+      no_options
       (fixed [ "forget" ; "all" ; "contracts" ])
-      (fun cctxt ->
+      (fun () cctxt ->
          fail_unless
            cctxt.config.force
            (failure "this can only used with option -force true") >>=? fun () ->
          RawContractAlias.save cctxt []) ;
 
     command ~group ~desc: "display a contract from the wallet"
+      no_options
       (prefixes [ "show" ; "known" ; "contract" ]
        @@ RawContractAlias.alias_param
        @@ stop)
-      (fun (_, contract) cctxt ->
+      (fun () (_, contract) cctxt ->
          cctxt.message "%a\n%!" Contract.pp contract >>= fun () ->
          return ()) ;
 
     command ~group ~desc: "tag a contract in the wallet"
+      no_options
       (prefixes [ "tag" ; "contract" ]
        @@ RawContractAlias.alias_param
        @@ prefixes [ "with" ]
        @@ Contract_tags.tag_param
        @@ stop)
-      (fun (alias, _contract) new_tags cctxt ->
+      (fun () (alias, _contract) new_tags cctxt ->
          Contract_tags.find_opt cctxt alias >>=? fun tags ->
          let new_tags =
            match tags with
@@ -221,12 +227,13 @@ let commands  () =
          Contract_tags.update cctxt alias new_tags) ;
 
     command ~group ~desc: "remove tag(s) from a contract in the wallet"
+      no_options
       (prefixes [ "untag" ; "contract" ]
        @@ RawContractAlias.alias_param
        @@ prefixes [ "with" ]
        @@ Contract_tags.tag_param
        @@ stop)
-      (fun (alias, _contract) new_tags cctxt ->
+      (fun () (alias, _contract) new_tags cctxt ->
          Contract_tags.find_opt cctxt alias >>=? fun tags ->
          let new_tags =
            match tags with

src/client/embedded/alpha/client_proto_programs.ml

@@ -100,7 +100,7 @@ let rec print_expr_unwrapped_help emacs locations ppf = function
         | None -> Format.fprintf ppf "%s" name
         | Some _ as l -> Format.fprintf ppf "%s%a" name print_location_mark l
       end
-  | Script.Prim (loc, name, args, (Some _ as annot)) ->
+  | Script.Prim (loc, name, _, (Some _ as annot)) ->
       Format.fprintf ppf (if emacs then "%s%a %a" else "@[<hov 2>%s%a@ %a]")
         name print_location_mark (locations loc) print_annotation annot
   | Script.Prim (loc, name, args, annot) ->
@@ -698,59 +698,60 @@ let group =
 
 let commands () =
   let open Cli_entries in
-  let show_types = ref false in
+  let show_types_switch =
-  let show_types_arg =
+    switch
-    "-details",
+      ~parameter:"-details"
-    Arg.Set show_types,
+      ~doc:"Show the types of each instruction" in
-    "Show the types of each instruction" in
+  let emacs_mode_switch =
-  let emacs_mode = ref false in
+    switch
-  let emacs_mode_arg =
+      ~parameter:"-emacs"
-    "-emacs",
+      ~doc:"Output in michelson-mode.el compatible format" in
-    Arg.Set emacs_mode,
+  let trace_stack_switch =
-    "Output in michelson-mode.el compatible format" in
+    switch
-  let trace_stack = ref false in
+      ~parameter:"-trace-stack"
-  let trace_stack_arg =
+      ~doc:"Show the stack after each step" in
-    "-trace-stack",
+  let amount_arg =
-    Arg.Set trace_stack,
-    "Show the stack after each step" in
-  let amount, amount_arg =
     Client_proto_args.tez_arg
-      ~name:"-amount"
+      ~parameter:"-amount"
-      ~desc:"The amount of the transfer in \xEA\x9C\xA9."
+      ~doc:"The amount of the transfer in \xEA\x9C\xA9."
-      ~default: "0.00" in
+      ~default:"0.05" in
   [
 
     command ~group ~desc: "lists all known programs"
+      no_options
       (fixed [ "list" ; "known" ; "programs" ])
-      (fun cctxt ->
+      (fun () cctxt ->
          Program.load cctxt >>=? fun list ->
          Lwt_list.iter_s (fun (n, _) -> cctxt.message "%s" n) list >>= fun () ->
          return ()) ;
 
     command ~group ~desc: "remember a program under some name"
+      no_options
       (prefixes [ "remember" ; "program" ]
        @@ Program.fresh_alias_param
        @@ Program.source_param
        @@ stop)
-      (fun name hash cctxt -> Program.add cctxt name hash) ;
+      (fun () name hash cctxt -> Program.add cctxt name hash) ;
 
     command ~group ~desc: "forget a remembered program"
+      no_options
       (prefixes [ "forget" ; "program" ]
        @@ Program.alias_param
        @@ stop)
-      (fun (name, _) cctxt -> Program.del cctxt name) ;
+      (fun () (name, _) cctxt -> Program.del cctxt name) ;
 
     command ~group ~desc: "display a program"
+      no_options
       (prefixes [ "show" ; "known" ; "program" ]
        @@ Program.alias_param
        @@ stop)
-      (fun (_, program) cctxt ->
+      (fun () (_, program) cctxt ->
          Program.to_source cctxt program >>=? fun source ->
          cctxt.message "%s\n" source >>= fun () ->
          return ()) ;
 
     command ~group ~desc: "ask the node to run a program"
-      ~args: [ trace_stack_arg ; amount_arg ]
+      (args2 trace_stack_switch amount_arg)
       (prefixes [ "run" ; "program" ]
        @@ Program.source_param
        @@ prefixes [ "on" ; "storage" ]
@@ -760,15 +761,15 @@ let commands () =
        @@ Cli_entries.param ~name:"storage" ~desc:"the input data"
          (fun _cctxt data -> parse_data data)
        @@ stop)
-      (fun program storage input cctxt ->
+      (fun (trace_stack, amount) program storage input cctxt ->
          let open Data_encoding in
          let print_errors errs =
            report_errors cctxt errs >>= fun () ->
            cctxt.error "error running program" >>= fun () ->
            return () in
-         if !trace_stack then
+         if trace_stack then
            Client_proto_rpcs.Helpers.trace_code cctxt.rpc_config
-             cctxt.config.block program.ast (storage.ast, input.ast, !amount) >>= function
+             cctxt.config.block program.ast (storage.ast, input.ast, amount) >>= function
            | Ok (storage, output, trace) ->
                cctxt.message
                  "@[<v 0>@[<v 2>storage@,%a@]@,\
@@ -788,7 +789,7 @@ let commands () =
            | Error errs -> print_errors errs
          else
            Client_proto_rpcs.Helpers.run_code cctxt.rpc_config
-             cctxt.config.block program.ast (storage.ast, input.ast, !amount) >>= function
+             cctxt.config.block program.ast (storage.ast, input.ast, amount) >>= function
            | Ok (storage, output) ->
                cctxt.message "@[<v 0>@[<v 2>storage@,%a@]@,@[<v 2>output@,%a@]@]@."
                  (print_expr no_locations) storage
@@ -798,15 +799,15 @@ let commands () =
                print_errors errs);
 
     command ~group ~desc: "ask the node to typecheck a program"
-      ~args: [ show_types_arg ; emacs_mode_arg ]
+      (args2 show_types_switch emacs_mode_switch)
       (prefixes [ "typecheck" ; "program" ]
        @@ Program.source_param
        @@ stop)
-      (fun program cctxt ->
+      (fun (show_types, emacs_mode) program cctxt ->
          let open Data_encoding in
          Client_proto_rpcs.Helpers.typecheck_code
            cctxt.rpc_config cctxt.config.block program.ast >>= fun res ->
-         if !emacs_mode then
+         if emacs_mode then
            let emacs_type_map type_map =
              (Utils.filter_map
                 (fun (n, loc) ->
@@ -857,7 +858,7 @@ let commands () =
            | Ok type_map ->
                let type_map, program = unexpand_macros type_map program.ast in
                cctxt.message "Well typed" >>= fun () ->
-               if !show_types then
+               if show_types then
                  cctxt.message "%a" (print_program no_locations) (program, type_map) >>= fun () ->
                  return ()
                else return ()
@@ -866,6 +867,7 @@ let commands () =
                cctxt.error "ill-typed program") ;
 
     command ~group ~desc: "ask the node to typecheck a data expression"
+      no_options
       (prefixes [ "typecheck" ; "data" ]
        @@ Cli_entries.param ~name:"data" ~desc:"the data to typecheck"
          (fun _cctxt data -> parse_data data)
@@ -873,7 +875,7 @@ let commands () =
        @@ Cli_entries.param ~name:"type" ~desc:"the expected type"
          (fun _cctxt data -> parse_data data)
        @@ stop)
-      (fun data exp_ty cctxt ->
+      (fun () data exp_ty cctxt ->
          let open Data_encoding in
          Client_proto_rpcs.Helpers.typecheck_data cctxt.Client_commands.rpc_config
            cctxt.config.block (data.ast, exp_ty.ast) >>= function
@@ -887,11 +889,12 @@ let commands () =
     command ~group
       ~desc: "ask the node to compute the hash of a data expression \
               using the same algorithm as script instruction H"
+      no_options
       (prefixes [ "hash" ; "data" ]
        @@ Cli_entries.param ~name:"data" ~desc:"the data to hash"
          (fun _cctxt data -> parse_data data)
        @@ stop)
-      (fun data cctxt ->
+      (fun () data cctxt ->
          let open Data_encoding in
          Client_proto_rpcs.Helpers.hash_data cctxt.Client_commands.rpc_config
            cctxt.config.block (data.ast) >>= function
@@ -907,13 +910,14 @@ let commands () =
               using the same algorithm as script instruction H, sign it using \
               a given secret key, and display it using the format expected by \
               script instruction CHECK_SIGNATURE"
+      no_options
       (prefixes [ "hash" ; "and" ; "sign" ; "data" ]
        @@ Cli_entries.param ~name:"data" ~desc:"the data to hash"
          (fun _cctxt data -> parse_data data)
        @@ prefixes [ "for" ]
        @@ Client_keys.Secret_key.alias_param
        @@ stop)
-      (fun data (_, key) cctxt ->
+      (fun () data (_, key) cctxt ->
          let open Data_encoding in
          Client_proto_rpcs.Helpers.hash_data cctxt.rpc_config
            cctxt.config.block (data.ast) >>= function

src/client/embedded/demo/client_proto_main.ml

@@ -71,16 +71,19 @@ let commands () =
   let group = {name = "demo" ; title = "Some demo command" } in
   [
     command ~group ~desc: "A demo command"
+      no_options
       (fixed [ "demo" ])
-      (fun cctxt -> demo cctxt) ;
+      (fun () cctxt -> demo cctxt) ;
     command ~group ~desc: "A failing command"
+      no_options
       (fixed [ "fail" ])
-      (fun _cctxt ->
+      (fun () _cctxt ->
          Error.demo_error 101010
          >|= wrap_error) ;
     command ~group ~desc: "Mine an empty block"
+      no_options
       (fixed [ "mine" ])
-      (fun cctxt -> mine cctxt) ;
+      (fun () cctxt -> mine cctxt) ;
   ]
 
 let () =

src/client/embedded/genesis/client_proto_main.ml

@@ -45,29 +45,33 @@ let mine rpc_config ?timestamp block command fitness seckey =
   Client_node_rpcs.inject_block rpc_config signed_blk [[]]
 
 let commands () =
-  let timestamp = ref None in
-  let args =
-    [ "-timestamp",
-      Arg.String (fun t -> timestamp := Some (Time.of_notation_exn t)),
-      "Set the timestamp of the block (and initial time of the chain)" ] in
   let open Cli_entries in
+  let args =
+    args1
+      (arg
+         ~parameter:"-timestamp"
+         ~doc:"Set the timestamp of the block (and initial time of the chain)"
+         (fun _ t ->
+            match (Time.of_notation t) with
+            | None -> Error_monad.failwith "Could not parse value provided to -timestamp option"
+            | Some t -> return t)) in
   [
 
-    command ~args ~desc: "Activate a protocol" begin
+    command ~desc: "Activate a protocol"
-      prefixes [ "activate" ; "protocol" ] @@
+      args
-      Protocol_hash.param ~name:"version" ~desc:"Protocol version (b58check)" @@
+      (prefixes [ "activate" ; "protocol" ]
-      prefixes [ "with" ; "fitness" ] @@
+       @@ Protocol_hash.param ~name:"version" ~desc:"Protocol version (b58check)"
-      param ~name:"fitness"
+       @@ prefixes [ "with" ; "fitness" ]
+       @@ param ~name:"fitness"
          ~desc:"Hardcoded fitness of the first block (integer)"
          (fun _ p ->
             try return (Int64.of_string p)
-           with _ -> failwith "Cannot read int64") @@
+            with _ -> failwith "Cannot read int64")
-      prefixes [ "and" ; "key" ] @@
+       @@ prefixes [ "and" ; "key" ]
-      Client_keys.Secret_key.source_param
+       @@ Client_keys.Secret_key.source_param
-        ~name:"password" ~desc:"Dictator's key" @@
+         ~name:"password" ~desc:"Dictator's key"
-      stop
+       @@ stop)
-    end begin fun hash fitness seckey cctxt ->
+      begin fun timestamp hash fitness seckey cctxt ->
-         let timestamp = !timestamp in
         let fitness =
           Client_embedded_proto_alpha.Fitness_repr.from_int64 fitness in
         mine cctxt.rpc_config ?timestamp cctxt.config.block
@@ -76,21 +80,21 @@ let commands () =
         return ()
       end ;
 
-    command ~args ~desc: "Fork a test protocol" begin
+    command ~desc: "Fork a test protocol"
-      prefixes [ "fork" ; "test" ; "protocol" ] @@
+      args
-      Protocol_hash.param ~name:"version" ~desc:"Protocol version (b58check)" @@
+      (prefixes [ "fork" ; "test" ; "protocol" ]
-      prefixes [ "with" ; "fitness" ] @@
+       @@ Protocol_hash.param ~name:"version" ~desc:"Protocol version (b58check)"
-      param ~name:"fitness"
+       @@ prefixes [ "with" ; "fitness" ]
+       @@ param ~name:"fitness"
          ~desc:"Hardcoded fitness of the first block (integer)"
          (fun _ p ->
             try return (Int64.of_string p)
-           with _ -> failwith "Cannot read int64") @@
+            with _ -> failwith "Cannot read int64")
-      prefixes [ "and" ; "key" ] @@
+       @@ prefixes [ "and" ; "key" ]
-      Environment.Ed25519.Secret_key.param
+       @@ Environment.Ed25519.Secret_key.param
-        ~name:"password" ~desc:"Dictator's key" @@
+         ~name:"password" ~desc:"Dictator's key"
-      stop
+       @@ stop)
-    end begin fun hash fitness seckey cctxt ->
+      begin fun timestamp hash fitness seckey cctxt ->
-      let timestamp = !timestamp in
         let fitness =
           Client_embedded_proto_alpha.Fitness_repr.from_int64 fitness in
         mine cctxt.rpc_config ?timestamp cctxt.config.block

src/client_main.ml

@@ -40,7 +40,9 @@ let main () =
   Random.self_init () ;
   Sodium.Random.stir () ;
   Lwt.catch begin fun () ->
-    let parsed_config_file, block = Client_config.preparse_args Sys.argv in
+    begin
+      Client_config.parse_config_args Client_commands.default_cfg (List.tl (Array.to_list Sys.argv))
+      >>=? fun (parsed_config_file, parsed_args, remaining) ->
       let rpc_config : Client_rpcs.config = {
         Client_rpcs.default_config with
         host = parsed_config_file.node_addr ;
@@ -48,15 +50,15 @@ let main () =
         tls = parsed_config_file.tls ;
       } in
       begin
-      Client_node_rpcs.Blocks.protocol rpc_config block >>= function
+        Client_node_rpcs.Blocks.protocol rpc_config parsed_args.block >>= function
         | Ok version ->
-          Lwt.return (Some version, Client_commands.commands_for_version version)
+            return (Some version, Client_commands.commands_for_version version)
         | Error errs ->
             Format.eprintf
               "@[<v 2>Ignored error:@,Failed to acquire the protocol version from the node@,%a@."
               (Format.pp_print_list pp) errs ;
-          Lwt.return (None, [])
+            return (None, [])
-    end >>= fun (_version, commands_for_version)  ->
+      end >>=? fun (_version, commands_for_version)  ->
       let commands =
         Client_generic_rpcs.commands @
         Client_network.commands () @
@@ -64,14 +66,10 @@ let main () =
         Client_protocols.commands () @
         Client_helpers.commands () @
         commands_for_version in
-    (Client_config.parse_args
-       (Cli_entries.usage ~commands)
-       (Cli_entries.inline_dispatch commands)
-       Sys.argv >>=? fun (command, parsed_args) ->
       let config : Client_commands.cfg = {
         base_dir = parsed_config_file.base_dir ;
         force = parsed_args.force ;
-       block ;
+        block = parsed_args.block ;
         web_port = Client_commands.default_cfg.web_port ;
       } in
       let rpc_config =
@@ -82,12 +80,20 @@ let main () =
         then {rpc_config with logger = Client_rpcs.full_logger Format.err_formatter }
         else rpc_config
       in
-     command (cctxt config rpc_config)) >>= function
+      let client_config = (cctxt config rpc_config) in
-    | Ok () ->
+      (Cli_entries.dispatch
-        Lwt.return 0
+         commands
+         client_config
+         remaining) end >>=
+    Cli_entries.handle_cli_errors
+      ~stdout: Format.std_formatter
+      ~stderr: Format.err_formatter
+      ~global_options:Client_config.global_options
+    >>= function
+    | Ok i ->
+        Lwt.return i
     | Error errs ->
-        Format.eprintf "@[<v 2>Fatal error:@,%a@.\
+        Format.eprintf "@[<v 2>Fatal error:@,%a@."
-                        Try `-help` for a list of options and commands.@."
           (Format.pp_print_list Error_monad.pp) errs ;
         Lwt.return 1
   end begin function
@@ -95,12 +101,11 @@ let main () =
         Format.printf "%s%!" help ;
         Lwt.return 0
     |  Client_commands.Version_not_found ->
-        Format.eprintf "Unknown protocol version, try `list versions`.@." ;
+        Format.eprintf "Unknown protocol version.@." ;
         Lwt.return 1
     | Failure message ->
         Format.eprintf
-          "Fatal error: %s@.\
+          "Fatal error: %s@." message ;
-           Try `-help` for a list of options and commands.@." message ;
         Lwt.return 1
     | exn ->
         Format.printf "Fatal internal error: %s@."

src/utils/cli_entries.mli

@@ -12,69 +12,188 @@ open Error_monad
 (* Tezos: a small Command Line Parsing library *)
 (* Only used in the client. *)
 
-type error += Command_not_found
+(** {2 Flags and Options } *)
-type error += Bad_argument of int * string
 
-type ('a, 'arg, 'ret) params
+(** {3 Options and Switches } *)
-type ('arg, 'ret) command
+(** Type for option or switch *)
+type ('a, 'ctx) arg
 
+(** [arg ~doc ~parameter converter] creates an argument to a command.
+    The [~parameter] argument should begin with a [-].
+    If the argument is not provided, [None] is returned *)
+val arg : doc:string -> parameter:string ->
+  ('ctx -> string -> 'p tzresult Lwt.t) ->
+  ('p option, 'ctx) arg
+(** Create an argument that will contain the [~default] value if it is not provided.
+    @see arg *)
+val default_arg : doc:string -> parameter:string ->
+  default:string ->
+  ('ctx -> string -> 'p tzresult Lwt.t) ->
+  ('p, 'ctx) 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 ->
+  (bool, 'ctx) arg
+
+(** {3 Optional Argument Combinators} *)
+(** To specify default arguments ([options]) for a command,
+    You need to use the following functions,
+    which allow you to specify how many arguments you have.
+    If you are not including any arguments, use [no_args]. *)
+
+(** The type of a series of labeled arguments to a command *)
+type ('a, 'ctx) options
+
+(** Include no optional parameters *)
+val no_options : (unit, 'ctx) options
+(** Include 1 optional parameter *)
+val args1 :
+  ('a, 'ctx) arg ->
+  ('a, 'ctx) options
+(** Include 2 optional parameters *)
+val args2 :
+  ('a, 'ctx) arg ->
+  ('b, 'ctx) arg ->
+  ('a * 'b, 'ctx) options
+(** Include 3 optional parameters *)
+val args3 :
+  ('a, 'ctx) arg ->
+  ('b, 'ctx) arg ->
+  ('c, 'ctx) arg ->
+  ('a * 'b * 'c, 'ctx) options
+(** Include 4 optional parameters *)
+val args4 :
+  ('a, 'ctx) arg ->
+  ('b, 'ctx) arg ->
+  ('c, 'ctx) arg ->
+  ('d, 'ctx) arg ->
+  ('a * 'b * 'c * 'd, 'ctx) options
+(** Include 5 optional parameters *)
+val args5 :
+  ('a, 'ctx) arg ->
+  ('b, 'ctx) arg ->
+  ('c, 'ctx) arg ->
+  ('d, 'ctx) arg ->
+  ('e, 'ctx) arg ->
+  ('a * 'b * 'c * 'd * 'e, 'ctx) options
+(** Include 6 optional parameters *)
+val args6 :
+  ('a, 'ctx) arg ->
+  ('b, 'ctx) arg ->
+  ('c, 'ctx) arg ->
+  ('d, 'ctx) arg ->
+  ('e, 'ctx) arg ->
+  ('f, 'ctx) arg ->
+  ('a * 'b * 'c * 'd * 'e * 'f, 'ctx) options
+(** Include 7 optional parameters *)
+val args7 :
+  ('a, 'ctx) arg ->
+  ('b, 'ctx) arg ->
+  ('c, 'ctx) arg ->
+  ('d, 'ctx) arg ->
+  ('e, 'ctx) arg -> ('f, 'ctx) arg -> ('g, 'ctx) arg ->
+  ('a * 'b * 'c * 'd * 'e * 'f * 'g, 'ctx) options
+(** Include 8 optional parameters *)
+val args8 : ('a, 'ctx) arg -> ('b, 'ctx) arg -> ('c, 'ctx) arg -> ('d, 'ctx) arg ->
+  ('e, 'ctx) arg -> ('f, 'ctx) arg -> ('g, 'ctx) arg -> ('h, 'ctx) arg ->
+  ('a * 'b * 'c * 'd * 'e * 'f * 'g * 'h, 'ctx) options
+(** Include 9 optional parameters *)
+val args9 : ('a, 'ctx) arg -> ('b, 'ctx) arg -> ('c, 'ctx) arg -> ('d, 'ctx) arg ->
+  ('e, 'ctx) arg -> ('f, 'ctx) arg -> ('g, 'ctx) arg -> ('h, 'ctx) arg ->
+  ('i, 'ctx) arg ->
+  ('a * 'b * 'c * 'd * 'e * 'f * 'g * 'h * 'i, 'ctx) options
+(** Include 10 optional parameters *)
+val args10 : ('a, 'ctx) arg -> ('b, 'ctx) arg -> ('c, 'ctx) arg -> ('d, 'ctx) arg ->
+  ('e, 'ctx) arg -> ('f, 'ctx) arg -> ('g, 'ctx) arg -> ('h, 'ctx) arg ->
+  ('i, 'ctx) arg -> ('j, 'ctx) arg ->
+  ('a * 'b * 'c * 'd * 'e * 'f * 'g * 'h * 'i * 'j, 'ctx) options
+
+(** {2 Parameter based command lines } *)
+
+(** Type of parameters for a command *)
+type ('a, 'ctx, 'ret) params
+
+(** A piece of data inside a command line *)
 val param:
   name: string ->
   desc: string ->
-  ('arg -> string -> 'a tzresult Lwt.t) ->
+  ('ctx -> string -> 'a tzresult Lwt.t) ->
-  ('b, 'arg, 'ret) params ->
+  ('b, 'ctx, 'ret) params ->
-  ('a -> 'b, 'arg, 'ret) params
+  ('a -> 'b, 'ctx, 'ret) params
+
+(** A word in a command line.
+    Should be descriptive. *)
 val prefix:
   string ->
-  ('a, 'arg, 'ret) params ->
+  ('a, 'ctx, 'ret) params ->
-  ('a, 'arg, 'ret) params
+  ('a, 'ctx, 'ret) params
+(** Multiple words given in sequence for a command line *)
 val prefixes:
   string list ->
-  ('a, 'arg, 'ret) params ->
+  ('a, 'ctx, 'ret) params ->
-  ('a, 'arg, 'ret) params
+  ('a, 'ctx, 'ret) params
+
+(** A fixed series of words that trigger a command. *)
 val fixed:
   string list ->
-  ('arg -> 'ret tzresult Lwt.t, 'arg, 'ret) params
+  ('ctx -> 'ret tzresult Lwt.t, 'ctx, 'ret) params
+(** End the description of the command line *)
 val stop:
-  ('arg -> 'ret tzresult Lwt.t, 'arg, 'ret) params
+  ('ctx -> 'ret tzresult Lwt.t, 'ctx, 'ret) params
-val seq:
-  name: string ->
-  desc: string ->
-  ('arg -> string -> 'p tzresult Lwt.t) ->
-  ('p list -> 'arg -> 'ret tzresult Lwt.t, 'arg, 'ret) params
 
+(** Take a sequence of parameters instead of only a single one.
+    Must be the last thing in the command line. *)
+val seq_of_param:
+  (('ctx -> 'ret tzresult Lwt.t, 'ctx, 'ret) params ->
+   ('a -> 'ctx -> 'ret tzresult Lwt.t, 'ctx, 'ret) params) ->
+  ('a list -> 'ctx -> 'ret tzresult Lwt.t, 'ctx, 'ret) params
+
+(** Parameter that expects a string *)
 val string:
   name: string ->
   desc: string ->
-  ('a, 'arg, 'ret) params ->
+  ('a, 'ctx, 'ret) params ->
-  (string -> 'a, 'arg, 'ret) params
+  (string -> 'a, 'ctx, 'ret) params
 
-val seq_of_param:
+(** {2 Commands }  *)
-  (('arg -> 'ret tzresult Lwt.t, 'arg, 'ret) params ->
-   ('a -> 'arg -> 'ret tzresult Lwt.t, 'arg, 'ret) params) ->
-  ('a list -> 'arg -> 'ret tzresult Lwt.t, 'arg, 'ret) params
 
+(** Command, including a parameter specification, optional arguments, and handlers  *)
+type ('ctx, 'ret) command
+
+(** Type of a group of commands.
+    Groups have their documentation printed together
+    and should include a descriptive title. *)
 type group =
   { name : string ;
     title : string }
 
+(** A complete command, with documentation, a specification of its options, parameters, and handler function *)
 val command:
   ?group: group ->
-  ?args: (Arg.key * Arg.spec * Arg.doc) list ->
   desc: string ->
-  ('a, 'arg, 'ret) params -> 'a -> ('arg, 'ret) command
+  ('b, 'ctx) options ->
+  ('a, 'ctx, 'ret) params ->
+  ('b -> 'a) ->
+  ('ctx, 'ret) command
 
-val usage:
+(** {2 Parsing and error reporting} *)
-  commands: ('arg, 'ret) command list ->
-  (string * Arg.spec * string) list -> string
 
-val inline_dispatch:
+(** Print readable descriptions for CLI parsing errors.
-  ('arg, 'ret) command list -> unit ->
+    This function must be used for help printing to work. *)
-  [ `Arg of string | `End ] ->
+val handle_cli_errors:
-  [ `Args of (Arg.key * Arg.spec * Arg.doc) list
+  stdout: Format.formatter ->
-  | `Fail of error list
+  stderr: Format.formatter ->
-  | `Nop
+  global_options:(_, _) options ->
-  | `Res of 'arg -> 'ret tzresult Lwt.t ]
+  'a tzresult -> int tzresult Lwt.t
 
+(** Find and call the applicable command on the series of arguments.
+    @raises [Failure] if the command list would be ambiguous. *)
 val dispatch:
-  ('arg, 'ret) command list -> 'arg -> string list -> 'ret tzresult Lwt.t
+  ('ctx, 'ret) command list -> 'ctx -> string list -> 'ret tzresult Lwt.t
+
+(** Parse the sequence of optional arguments that proceed a command *)
+val parse_initial_options :
+  ('a, 'ctx) options ->
+  'ctx ->
+  string list ->
+  ('a * string list) tzresult Lwt.t