From 2531e723cc617cdc6b0f301964cf6fb33f73bd4e Mon Sep 17 00:00:00 2001 From: Etienne Millon Date: Mon, 26 Sep 2022 11:11:43 +0200 Subject: [PATCH] Upgrade cmdliner fork to 1.1.1 (#6038) We still need a fork to support `alias` but this brings the upstream part to 1.1.1. The main addition is builtin support of groups through the `Cmdliner.Cmd` API. Benefits include: - we get closer to upstream `cmdliner` - help pages like `dune ocaml --help` are now more useful This commit contains several things: - an update of the vendored copy, - a port of `bin/` to the `Cmdliner.Cmd` API, - test updates, mostly typographic. Signed-off-by: Etienne Millon Signed-off-by: Etienne Millon --- CHANGES.md | 3 + bin/build_cmd.ml | 36 +- bin/build_cmd.mli | 12 +- bin/cache.ml | 4 +- bin/cache.mli | 4 +- bin/clean.ml | 2 +- bin/clean.mli | 4 +- bin/common.ml | 23 +- bin/coq.ml | 4 +- bin/coq.mli | 2 +- bin/coqtop.ml | 4 +- bin/coqtop.mli | 4 +- bin/describe.ml | 4 +- bin/describe.mli | 4 +- bin/diagnostics.ml | 4 +- bin/diagnostics.mli | 2 +- bin/exec.ml | 4 +- bin/exec.mli | 4 +- bin/external_lib_deps.ml | 4 +- bin/external_lib_deps.mli | 4 +- bin/format_dune_file.ml | 4 +- bin/format_dune_file.mli | 4 +- bin/help.ml | 4 +- bin/help.mli | 4 +- bin/import.ml | 10 +- bin/init.ml | 4 +- bin/init.mli | 4 +- bin/install_uninstall.ml | 13 +- bin/install_uninstall.mli | 6 +- bin/installed_libraries.ml | 4 +- bin/installed_libraries.mli | 4 +- bin/internal.ml | 9 +- bin/internal.mli | 2 +- bin/internal_dump.ml | 4 +- bin/internal_dump.mli | 2 +- bin/main.ml | 65 +- bin/ocaml_cmd.ml | 15 +- bin/ocaml_cmd.mli | 2 +- bin/ocaml_merlin.ml | 8 +- bin/ocaml_merlin.mli | 6 +- bin/print_rules.ml | 4 +- bin/print_rules.mli | 4 +- bin/printenv.ml | 4 +- bin/printenv.mli | 4 +- bin/promote.ml | 2 +- bin/promote.mli | 4 +- bin/rpc.ml | 16 +- bin/rpc.mli | 2 +- bin/shutdown.ml | 4 +- bin/shutdown.mli | 2 +- bin/subst.ml | 4 +- bin/subst.mli | 4 +- bin/top.ml | 4 +- bin/top.mli | 4 +- bin/upgrade.ml | 4 +- bin/upgrade.mli | 4 +- bin/utop.ml | 4 +- bin/utop.mli | 2 +- doc/dune.inc | 18 +- doc/update-jbuild.sh | 2 +- .../test-cases/cmdline/profile.t | 6 +- .../test-cases/cmdliner-dep-conf.t/run.t | 12 +- test/blackbox-tests/test-cases/describe.t | 12 +- .../test-cases/dune-init.t/run.t | 21 +- .../test-cases/external-lib-deps.t | 2 +- test/blackbox-tests/test-cases/github3046.t | 29 +- test/blackbox-tests/test-cases/github3530.t | 12 +- test/blackbox-tests/test-cases/misc.t/run.t | 36 +- vendor/cmdliner/LICENSE.md | 2 +- vendor/cmdliner/src/cmdliner.ml | 403 +---- vendor/cmdliner/src/cmdliner.mli | 1408 ++++++----------- vendor/cmdliner/src/cmdliner_arg.ml | 135 +- vendor/cmdliner/src/cmdliner_arg.mli | 16 +- vendor/cmdliner/src/cmdliner_base.ml | 106 +- vendor/cmdliner/src/cmdliner_base.mli | 17 +- vendor/cmdliner/src/cmdliner_cline.ml | 62 +- vendor/cmdliner/src/cmdliner_cline.mli | 16 +- vendor/cmdliner/src/cmdliner_cmd.ml | 46 + vendor/cmdliner/src/cmdliner_cmd.mli | 40 + vendor/cmdliner/src/cmdliner_docgen.ml | 328 ++-- vendor/cmdliner/src/cmdliner_docgen.mli | 11 +- vendor/cmdliner/src/cmdliner_eval.ml | 292 ++++ vendor/cmdliner/src/cmdliner_eval.mli | 60 + ...{cmdliner_suggest.mli => cmdliner_exit.ml} | 8 +- vendor/cmdliner/src/cmdliner_exit.mli | 21 + vendor/cmdliner/src/cmdliner_info.ml | 451 +++--- vendor/cmdliner/src/cmdliner_info.mli | 267 ++-- vendor/cmdliner/src/cmdliner_manpage.ml | 63 +- vendor/cmdliner/src/cmdliner_manpage.mli | 8 +- vendor/cmdliner/src/cmdliner_msg.ml | 64 +- vendor/cmdliner/src/cmdliner_msg.mli | 24 +- vendor/cmdliner/src/cmdliner_suggest.ml | 54 - vendor/cmdliner/src/cmdliner_term.ml | 71 +- vendor/cmdliner/src/cmdliner_term.mli | 21 +- .../cmdliner/src/cmdliner_term_deprecated.ml | 93 ++ vendor/cmdliner/src/cmdliner_trie.ml | 5 +- vendor/cmdliner/src/cmdliner_trie.mli | 5 +- vendor/update-cmdliner.sh | 2 +- 98 files changed, 2257 insertions(+), 2374 deletions(-) mode change 100755 => 100644 test/blackbox-tests/test-cases/cmdliner-dep-conf.t/run.t create mode 100644 vendor/cmdliner/src/cmdliner_cmd.ml create mode 100644 vendor/cmdliner/src/cmdliner_cmd.mli create mode 100644 vendor/cmdliner/src/cmdliner_eval.ml create mode 100644 vendor/cmdliner/src/cmdliner_eval.mli rename vendor/cmdliner/src/{cmdliner_suggest.mli => cmdliner_exit.ml} (80%) create mode 100644 vendor/cmdliner/src/cmdliner_exit.mli delete mode 100644 vendor/cmdliner/src/cmdliner_suggest.ml create mode 100644 vendor/cmdliner/src/cmdliner_term_deprecated.ml diff --git a/CHANGES.md b/CHANGES.md index 865cc57c0ae..3acc995707f 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -58,6 +58,9 @@ - Add `%{coq:...}` macro for accessing data about the configuration about Coq. For instance `%{coq:version}` (#6049, @Alizter) +- update vendored copy of cmdliner to 1.1.1. This improves the built-in + documentation for command groups such as `dune ocaml`. (#6038, @emillon) + 3.4.1 (26-07-2022) ------------------ diff --git a/bin/build_cmd.ml b/bin/build_cmd.ml index 5dc61b98460..702607ff452 100644 --- a/bin/build_cmd.ml +++ b/bin/build_cmd.ml @@ -115,7 +115,7 @@ let run_build_command ~(common : Common.t) ~config ~request = | No -> run_build_command_once) ~common ~config ~request -let runtest = +let runtest_info = let doc = "Run tests." in let man = [ `S "DESCRIPTION" @@ -131,22 +131,24 @@ let runtest = ] ] in + Cmd.info "runtest" ~doc ~man + +let runtest_term = let name_ = Arg.info [] ~docv:"DIR" in - let term = - let+ common = Common.term - and+ dirs = Arg.(value & pos_all string [ "." ] name_) in - let config = Common.init common in - let request (setup : Import.Main.build_system) = - Action_builder.all_unit - (List.map dirs ~f:(fun dir -> - let dir = Path.(relative root) (Common.prefix_target common dir) in - Alias.in_dir ~name:Dune_engine.Alias.Name.runtest ~recursive:true - ~contexts:setup.contexts dir - |> Alias.request)) - in - run_build_command ~common ~config ~request + let+ common = Common.term + and+ dirs = Arg.(value & pos_all string [ "." ] name_) in + let config = Common.init common in + let request (setup : Import.Main.build_system) = + Action_builder.all_unit + (List.map dirs ~f:(fun dir -> + let dir = Path.(relative root) (Common.prefix_target common dir) in + Alias.in_dir ~name:Dune_engine.Alias.Name.runtest ~recursive:true + ~contexts:setup.contexts dir + |> Alias.request)) in - (term, Term.info "runtest" ~doc ~man) + run_build_command ~common ~config ~request + +let runtest = Cmd.v runtest_info runtest_term let build = let doc = @@ -182,7 +184,7 @@ let build = in run_build_command ~common ~config ~request in - (term, Term.info "build" ~doc ~man) + Cmd.v (Cmd.info "build" ~doc ~man) term let fmt = let doc = "Format source code." in @@ -207,4 +209,4 @@ let fmt = in run_build_command ~common ~config ~request in - (term, Term.info "fmt" ~doc ~man) + Cmd.v (Cmd.info "fmt" ~doc ~man) term diff --git a/bin/build_cmd.mli b/bin/build_cmd.mli index 9cbe8c49e66..7ddc88ca111 100644 --- a/bin/build_cmd.mli +++ b/bin/build_cmd.mli @@ -1,13 +1,15 @@ -open Dune_engine +open Import val run_build_command : common:Common.t -> config:Dune_config.t - -> request:(Dune_rules.Main.build_system -> unit Action_builder.t) + -> request:(Main.build_system -> unit Action_builder.t) -> unit -val runtest : unit Cmdliner.Term.t * Cmdliner.Term.info +val runtest : unit Cmd.t -val build : unit Cmdliner.Term.t * Cmdliner.Term.info +val runtest_term : unit Term.t -val fmt : unit Cmdliner.Term.t * Cmdliner.Term.info +val build : unit Cmd.t + +val fmt : unit Cmd.t diff --git a/bin/cache.ml b/bin/cache.ml index 4c2b3f2c490..b5445ec0885 100644 --- a/bin/cache.ml +++ b/bin/cache.ml @@ -18,7 +18,7 @@ let man = let doc = "Manage the shared cache of build artifacts" -let info = Term.info name ~doc ~man +let info = Cmd.info name ~doc ~man let trim ~trimmed_size ~size = Log.init_disabled (); @@ -87,4 +87,4 @@ let term = | Some Start_deprecated | Some Stop_deprecated -> deprecated_error () | None -> `Help (`Pager, Some name) -let command = (term, info) +let command = Cmd.v info term diff --git a/bin/cache.mli b/bin/cache.mli index 6d988967f3a..8c78dc310b9 100644 --- a/bin/cache.mli +++ b/bin/cache.mli @@ -1 +1,3 @@ -val command : unit Cmdliner.Term.t * Cmdliner.Term.info +open Import + +val command : unit Cmd.t diff --git a/bin/clean.ml b/bin/clean.ml index dd2c63601b5..dece1f4b7dd 100644 --- a/bin/clean.ml +++ b/bin/clean.ml @@ -22,4 +22,4 @@ let command = |> Path.Set.iter ~f:Path.unlink_no_err; Path.rm_rf Path.build_dir in - (term, Term.info "clean" ~doc ~man) + Cmd.v (Cmd.info "clean" ~doc ~man) term diff --git a/bin/clean.mli b/bin/clean.mli index 6d988967f3a..8c78dc310b9 100644 --- a/bin/clean.mli +++ b/bin/clean.mli @@ -1 +1,3 @@ -val command : unit Cmdliner.Term.t * Cmdliner.Term.info +open Import + +val command : unit Cmd.t diff --git a/bin/common.ml b/bin/common.ml index 4f96b29f461..1eeec21281f 100644 --- a/bin/common.ml +++ b/bin/common.ml @@ -6,6 +6,7 @@ module Clflags = Dune_engine.Clflags module Graph = Dune_graph.Graph module Package = Dune_engine.Package module Profile = Dune_rules.Profile +module Cmd = Cmdliner.Cmd module Term = Cmdliner.Term module Manpage = Cmdliner.Manpage module Only_packages = Dune_rules.Only_packages @@ -506,7 +507,7 @@ module Options_implied_by_dash_p = struct last & opt_all (some profile) [ None ] & info [ "profile" ] ~docs - ~env:(Arg.env_var ~doc "DUNE_PROFILE") + ~env:(Cmd.Env.info ~doc "DUNE_PROFILE") ~doc: (Printf.sprintf "Select the build profile, for instance $(b,dev) or \ @@ -561,7 +562,7 @@ let shared_with_config_file = & opt (some (enum all)) None & info [ "sandbox" ] ~env: - (Arg.env_var + (Cmd.Env.info ~doc:"Sandboxing mode to use by default. (see --sandbox)" "DUNE_SANDBOX") ~doc: @@ -597,7 +598,7 @@ let shared_with_config_file = Arg.( value & opt (some (enum Dune_config.Cache.Enabled.all)) None - & info [ "cache" ] ~docs ~env:(Arg.env_var ~doc "DUNE_CACHE") ~doc) + & info [ "cache" ] ~docs ~env:(Cmd.Env.info ~doc "DUNE_CACHE") ~doc) and+ cache_storage_mode = let doc = Printf.sprintf "Dune cache storage mode (%s). Default is `%s'." @@ -609,7 +610,7 @@ let shared_with_config_file = value & opt (some (enum Dune_config.Cache.Storage_mode.all)) None & info [ "cache-storage-mode" ] ~docs - ~env:(Arg.env_var ~doc "DUNE_CACHE_STORAGE_MODE") + ~env:(Cmd.Env.info ~doc "DUNE_CACHE_STORAGE_MODE") ~doc) and+ cache_check_probability = let doc = @@ -625,7 +626,7 @@ let shared_with_config_file = & info [ "cache-check-probability" ] ~docs - ~env:(Arg.env_var ~doc "DUNE_CACHE_CHECK_PROBABILITY") + ~env:(Cmd.Env.info ~doc "DUNE_CACHE_CHECK_PROBABILITY") ~doc) and+ action_stdout_on_success = Arg.( @@ -790,7 +791,7 @@ let term ~default_root_is_cwd = value & opt (some path) None & info [ "workspace" ] ~docs ~docv:"FILE" ~doc - ~env:(Arg.env_var ~doc "DUNE_WORKSPACE")) + ~env:(Cmd.Env.info ~doc "DUNE_WORKSPACE")) and+ promote = one_of (let+ auto = @@ -804,7 +805,7 @@ let term ~default_root_is_cwd = Option.some_if auto Clflags.Promote.Automatically) (let+ disable = let doc = "Disable all promotion rules" in - let env = Arg.env_var ~doc "DUNE_DISABLE_PROMOTION" in + let env = Cmd.Env.info ~doc "DUNE_DISABLE_PROMOTION" in Arg.(value & flag & info [ "disable-promotion" ] ~docs ~env ~doc) in Option.some_if disable Clflags.Promote.Never) @@ -892,7 +893,7 @@ let term ~default_root_is_cwd = value & opt (some string) None & info [ "build-dir" ] ~docs ~docv:"FILE" - ~env:(Arg.env_var ~doc "DUNE_BUILD_DIR") + ~env:(Cmd.Env.info ~doc "DUNE_BUILD_DIR") ~doc) and+ diff_command = let doc = @@ -903,7 +904,7 @@ let term ~default_root_is_cwd = value & opt (some string) None & info [ "diff-command" ] ~docs - ~env:(Arg.env_var ~doc "DUNE_DIFF_COMMAND") + ~env:(Cmd.Env.info ~doc "DUNE_DIFF_COMMAND") ~doc) and+ stats_trace_file = Arg.( @@ -925,7 +926,7 @@ let term ~default_root_is_cwd = & info [ "store-orig-source-dir" ] ~docs - ~env:(Arg.env_var ~doc "DUNE_STORE_ORIG_SOURCE_DIR") + ~env:(Cmd.Env.info ~doc "DUNE_STORE_ORIG_SOURCE_DIR") ~doc) and+ () = build_info and+ instrument_with = @@ -938,7 +939,7 @@ let term ~default_root_is_cwd = value & opt (some (list lib_name)) None & info [ "instrument-with" ] ~docs - ~env:(Arg.env_var ~doc "DUNE_INSTRUMENT_WITH") + ~env:(Cmd.Env.info ~doc "DUNE_INSTRUMENT_WITH") ~docv:"BACKENDS" ~doc) and+ file_watcher = let doc = diff --git a/bin/coq.ml b/bin/coq.ml index c0cbee3828e..b6465e2700e 100644 --- a/bin/coq.ml +++ b/bin/coq.ml @@ -6,6 +6,6 @@ let sub_commands_synopsis = Common.command_synopsis [ "coq top FILE -- ARGS" ] let man = [ `Blocks sub_commands_synopsis ] -let info = Term.info ~doc ~man "coq" +let info = Cmd.info ~doc ~man "coq" -let group = (Term.Group.Group [ in_group Coqtop.command ], info) +let group = Cmd.group info [ Coqtop.command ] diff --git a/bin/coq.mli b/bin/coq.mli index 8c539d3387e..d4c5902fcd6 100644 --- a/bin/coq.mli +++ b/bin/coq.mli @@ -1,3 +1,3 @@ open Import -val group : unit Term.Group.t +val group : unit Cmd.t diff --git a/bin/coqtop.ml b/bin/coqtop.ml index 472ce92553c..5ae53cf7a50 100644 --- a/bin/coqtop.ml +++ b/bin/coqtop.ml @@ -15,7 +15,7 @@ let man = ; `Blocks Common.help_secs ] -let info = Term.info "top" ~doc ~man +let info = Cmd.info "top" ~doc ~man let term = let+ common = Common.term @@ -137,4 +137,4 @@ let term = in restore_cwd_and_execve common coqtop argv env -let command = (term, info) +let command = Cmd.v info term diff --git a/bin/coqtop.mli b/bin/coqtop.mli index 6d988967f3a..8c78dc310b9 100644 --- a/bin/coqtop.mli +++ b/bin/coqtop.mli @@ -1 +1,3 @@ -val command : unit Cmdliner.Term.t * Cmdliner.Term.info +open Import + +val command : unit Cmd.t diff --git a/bin/describe.ml b/bin/describe.ml index 0d545b2184e..59f9afc6a54 100644 --- a/bin/describe.ml +++ b/bin/describe.ml @@ -26,7 +26,7 @@ let man = ; `Blocks Common.help_secs ] -let info = Term.info "describe" ~doc ~man +let info = Cmd.info "describe" ~doc ~man (** whether to sanitize absolute paths of workspace items, and their UIDs, to ensure reproducible tests *) @@ -869,4 +869,4 @@ let term : unit Term.t = | Csexp -> Csexp.to_channel stdout (Sexp.of_dyn res) | Sexp -> print_as_sexp res)) -let command : unit Term.t * Term.info = (term, info) +let command = Cmd.v info term diff --git a/bin/describe.mli b/bin/describe.mli index 6d988967f3a..8c78dc310b9 100644 --- a/bin/describe.mli +++ b/bin/describe.mli @@ -1 +1,3 @@ -val command : unit Cmdliner.Term.t * Cmdliner.Term.info +open Import + +val command : unit Cmd.t diff --git a/bin/diagnostics.ml b/bin/diagnostics.ml index 83cfc5871db..19cd688070a 100644 --- a/bin/diagnostics.ml +++ b/bin/diagnostics.ml @@ -52,10 +52,10 @@ let exec () = let info = let doc = "fetch and return errors from the current build" in - Term.info "diagnostics" ~doc + Cmd.info "diagnostics" ~doc let term = let+ (common : Common.t) = Common.term in Rpc.client_term common exec -let command = (term, info) +let command = Cmd.v info term diff --git a/bin/diagnostics.mli b/bin/diagnostics.mli index 8e37776fc90..8c78dc310b9 100644 --- a/bin/diagnostics.mli +++ b/bin/diagnostics.mli @@ -1,3 +1,3 @@ open Import -val command : unit Term.t * Term.info +val command : unit Cmd.t diff --git a/bin/exec.ml b/bin/exec.ml index 2ffb5f1491a..4a2e4751524 100644 --- a/bin/exec.ml +++ b/bin/exec.ml @@ -30,7 +30,7 @@ let man = ] ] -let info = Term.info "exec" ~doc ~man +let info = Cmd.info "exec" ~doc ~man let term = let+ common = Common.term @@ -132,4 +132,4 @@ let term = in restore_cwd_and_execve common prog argv env -let command = (term, info) +let command = Cmd.v info term diff --git a/bin/exec.mli b/bin/exec.mli index 6d988967f3a..8c78dc310b9 100644 --- a/bin/exec.mli +++ b/bin/exec.mli @@ -1 +1,3 @@ -val command : unit Cmdliner.Term.t * Cmdliner.Term.info +open Import + +val command : unit Cmd.t diff --git a/bin/external_lib_deps.ml b/bin/external_lib_deps.ml index f7ff2bd3d27..f636de96f06 100644 --- a/bin/external_lib_deps.ml +++ b/bin/external_lib_deps.ml @@ -14,7 +14,7 @@ let man = ; `Blocks Common.help_secs ] -let info = Term.info "external-lib-deps" ~doc ~man +let info = Cmd.info "external-lib-deps" ~doc ~man let term = Term.ret @@ -25,4 +25,4 @@ let term = and+ _ = Arg.(value & flag & info [ "sexp" ] ~doc:{|unused|}) in `Error (false, "This subcommand is no longer implemented.") -let command = (term, info) +let command = Cmd.v info term diff --git a/bin/external_lib_deps.mli b/bin/external_lib_deps.mli index 6d988967f3a..8c78dc310b9 100644 --- a/bin/external_lib_deps.mli +++ b/bin/external_lib_deps.mli @@ -1 +1,3 @@ -val command : unit Cmdliner.Term.t * Cmdliner.Term.info +open Import + +val command : unit Cmd.t diff --git a/bin/format_dune_file.ml b/bin/format_dune_file.ml index 483bc1d5c56..752e7716706 100644 --- a/bin/format_dune_file.ml +++ b/bin/format_dune_file.ml @@ -12,7 +12,7 @@ let man = formatting" section in the manual.|} ] -let info = Term.info "format-dune-file" ~doc ~man +let info = Cmd.info "format-dune-file" ~doc ~man let format_file ~version ~input = let with_input = @@ -50,4 +50,4 @@ let term = let input = Option.map ~f:Arg.Path.path path_opt in format_file ~version ~input -let command = (term, info) +let command = Cmd.v info term diff --git a/bin/format_dune_file.mli b/bin/format_dune_file.mli index 6d988967f3a..8c78dc310b9 100644 --- a/bin/format_dune_file.mli +++ b/bin/format_dune_file.mli @@ -1 +1,3 @@ -val command : unit Cmdliner.Term.t * Cmdliner.Term.info +open Import + +val command : unit Cmd.t diff --git a/bin/help.ml b/bin/help.ml index 8b3a9f9d1a3..3dba7d8364b 100644 --- a/bin/help.ml +++ b/bin/help.ml @@ -102,7 +102,7 @@ let man = ; Common.footer ] -let info = Term.info "help" ~doc ~man +let info = Cmd.info "help" ~doc ~man let term = Term.ret @@ -124,4 +124,4 @@ let term = |> String.concat ~sep:"\n" |> print_endline; `Ok () -let command = (term, info) +let command = Cmd.v info term diff --git a/bin/help.mli b/bin/help.mli index 6d988967f3a..8c78dc310b9 100644 --- a/bin/help.mli +++ b/bin/help.mli @@ -1 +1,3 @@ -val command : unit Cmdliner.Term.t * Cmdliner.Term.info +open Import + +val command : unit Cmd.t diff --git a/bin/import.ml b/bin/import.ml index 2017c2c9719..a2db64f713a 100644 --- a/bin/import.ml +++ b/bin/import.ml @@ -5,6 +5,7 @@ module Metrics = Dune_metrics module Console = Dune_console module Term = Cmdliner.Term module Manpage = Cmdliner.Manpage +module Cmd = Cmdliner.Cmd module Stanza = Dune_lang.Stanza module Super_context = Dune_rules.Super_context module Context = Dune_rules.Context @@ -37,8 +38,6 @@ module Dune_rpc = Dune_rpc_private module Graph = Dune_graph.Graph include Common.Let_syntax -let in_group (t, info) = (Term.Group.Term t, info) - module Main : sig include module type of struct include Dune_rules.Main @@ -165,9 +164,8 @@ let restore_cwd_and_execve (common : Common.t) prog argv env = (* Adapted from https://github.com/ocaml/opam/blob/fbbe93c3f67034da62d28c8666ec6b05e0a9b17c/src/client/opamArg.ml#L759 *) -let command_alias cmd name = - let term, info = cmd in - let orig = Term.name info in +let command_alias cmd term name = + let orig = Cmd.name cmd in let doc = Printf.sprintf "An alias for $(b,%s)." orig in let man = [ `S "DESCRIPTION" @@ -178,4 +176,4 @@ let command_alias cmd name = ; `Blocks Common.help_secs ] in - (term, Term.info name ~docs:"COMMAND ALIASES" ~doc ~man) + Cmd.v (Cmd.info name ~docs:"COMMAND ALIASES" ~doc ~man) term diff --git a/bin/init.ml b/bin/init.ml index 6fa65f643f9..3ed0fb3e4ab 100644 --- a/bin/init.ml +++ b/bin/init.ml @@ -140,7 +140,7 @@ let man = ] ] -let info = Term.info "init" ~doc ~man +let info = Cmd.info "init" ~doc ~man let term = let+ common_term = Common.term_with_default_root_is_cwd @@ -249,4 +249,4 @@ let term = init @@ Test { context; common; options = () }); print_completion kind name -let command = (term, info) +let command = Cmd.v info term diff --git a/bin/init.mli b/bin/init.mli index 6d988967f3a..8c78dc310b9 100644 --- a/bin/init.mli +++ b/bin/init.mli @@ -1 +1,3 @@ -val command : unit Cmdliner.Term.t * Cmdliner.Term.info +open Import + +val command : unit Cmd.t diff --git a/bin/install_uninstall.ml b/bin/install_uninstall.ml index 7e31bdd82a6..c55e8123189 100644 --- a/bin/install_uninstall.ml +++ b/bin/install_uninstall.ml @@ -369,7 +369,7 @@ module Sections = struct | All | Only of Section.Set.t - let sections_conv : Section.t list Cmdliner.Arg.converter = + let sections_conv = let all = Section.all |> Section.Set.to_list |> List.map ~f:(fun section -> (Section.to_string section, section)) @@ -432,7 +432,7 @@ let install_uninstall ~what = value & opt (some string) None & info [ "prefix" ] - ~env:(env_var "DUNE_INSTALL_PREFIX") + ~env:(Cmd.Env.info "DUNE_INSTALL_PREFIX") ~docv:"PREFIX" ~doc: "Directory where files are copied. For instance binaries are \ @@ -442,7 +442,7 @@ let install_uninstall ~what = Arg.( value & opt (some string) None - & info [ "destdir" ] ~env:(env_var "DESTDIR") ~docv:"PATH" + & info [ "destdir" ] ~env:(Cmd.Env.info "DESTDIR") ~docv:"PATH" ~doc:"This directory is prepended to all installed paths.") and+ libdir_from_command_line = Arg.( @@ -740,9 +740,10 @@ let install_uninstall ~what = |> List.rev |> List.iter ~f:(Ops.remove_dir_if_exists ~if_non_empty:Warn)) in - ( term - , Cmdliner.Term.info (cmd_what what) ~doc - ~man:Manpage.(`S s_synopsis :: (synopsis @ Common.help_secs)) ) + Cmd.v + (Cmd.info (cmd_what what) ~doc + ~man:Manpage.(`S s_synopsis :: (synopsis @ Common.help_secs))) + term let install = install_uninstall ~what:Install diff --git a/bin/install_uninstall.mli b/bin/install_uninstall.mli index cc1a0b6896d..20759660915 100644 --- a/bin/install_uninstall.mli +++ b/bin/install_uninstall.mli @@ -1,3 +1,5 @@ -val install : unit Cmdliner.Term.t * Cmdliner.Term.info +open Import -val uninstall : unit Cmdliner.Term.t * Cmdliner.Term.info +val install : unit Cmd.t + +val uninstall : unit Cmd.t diff --git a/bin/installed_libraries.ml b/bin/installed_libraries.ml index 4ba93b00a7c..921ffe76df3 100644 --- a/bin/installed_libraries.ml +++ b/bin/installed_libraries.ml @@ -3,7 +3,7 @@ open Import let doc = "Print out libraries installed on the system." -let info = Term.info "installed-libraries" ~doc +let info = Cmd.info "installed-libraries" ~doc let term = let+ common = Common.term @@ -71,4 +71,4 @@ let term = in fun () -> Memo.run (run ())) -let command = (term, info) +let command = Cmd.v info term diff --git a/bin/installed_libraries.mli b/bin/installed_libraries.mli index 6d988967f3a..8c78dc310b9 100644 --- a/bin/installed_libraries.mli +++ b/bin/installed_libraries.mli @@ -1 +1,3 @@ -val command : unit Cmdliner.Term.t * Cmdliner.Term.info +open Import + +val command : unit Cmd.t diff --git a/bin/internal.ml b/bin/internal.ml index 34e331c1ee7..89947c6aa5b 100644 --- a/bin/internal.ml +++ b/bin/internal.ml @@ -1,13 +1,12 @@ open Import let latest_lang_version = - ( (let+ () = Term.const () in + Cmd.v + (Cmd.info "latest-lang-version") + (let+ () = Term.const () in print_endline (Dune_lang.Syntax.greatest_supported_version Stanza.syntax |> Dune_lang.Syntax.Version.to_string)) - , Term.info "latest-lang-version" ) let group = - ( Term.Group.Group - [ in_group Internal_dump.command; in_group latest_lang_version ] - , Term.info "internal" ) + Cmd.group (Cmd.info "internal") [ Internal_dump.command; latest_lang_version ] diff --git a/bin/internal.mli b/bin/internal.mli index 8c539d3387e..d4c5902fcd6 100644 --- a/bin/internal.mli +++ b/bin/internal.mli @@ -1,3 +1,3 @@ open Import -val group : unit Term.Group.t +val group : unit Cmd.t diff --git a/bin/internal_dump.ml b/bin/internal_dump.ml index 11eea8a3c6d..33cc981139c 100644 --- a/bin/internal_dump.ml +++ b/bin/internal_dump.ml @@ -10,7 +10,7 @@ let man = ; `Blocks Common.help_secs ] -let info = Term.info "dump" ~doc ~man +let info = Cmd.info "dump" ~doc ~man let term = let+ common = Common.term @@ -23,4 +23,4 @@ let term = in Console.print [ Dyn.pp (D.to_dyn data) ] -let command = (term, info) +let command = Cmd.v info term diff --git a/bin/internal_dump.mli b/bin/internal_dump.mli index 8e37776fc90..8c78dc310b9 100644 --- a/bin/internal_dump.mli +++ b/bin/internal_dump.mli @@ -1,3 +1,3 @@ open Import -val command : unit Term.t * Term.info +val command : unit Cmd.t diff --git a/bin/main.ml b/bin/main.ml index 73594428e47..bfe0123a274 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -1,14 +1,14 @@ open! Stdune open Import -let all : _ Term.Group.t list = +let all : _ Cmdliner.Cmd.t list = let terms = [ Installed_libraries.command ; External_lib_deps.command ; Build_cmd.build ; Build_cmd.runtest ; Build_cmd.fmt - ; command_alias Build_cmd.runtest "test" + ; command_alias Build_cmd.runtest Build_cmd.runtest_term "test" ; Clean.command ; Install_uninstall.install ; Install_uninstall.uninstall @@ -29,7 +29,6 @@ let all : _ Term.Group.t list = ; Shutdown.command ; Diagnostics.command ] - |> List.map ~f:in_group in let groups = [ Ocaml_cmd.group; Coq.group; Rpc.group; Internal.group ] in terms @ groups @@ -45,45 +44,41 @@ let common_commands_synopsis = ; "init project NAME [PATH] [--libs=l1,l2 --ppx=p1,p2 --inline-tests]" ] -let default = +let info = let doc = "composable build system for OCaml" in - let term = - Term.ret - @@ let+ _ = Common.term in - `Help (`Pager, None) - in - ( term - , Term.info "dune" ~doc - ~version: - (match Build_info.V1.version () with - | None -> "n/a" - | Some v -> Build_info.V1.Version.to_string v) - ~man: - [ `Blocks common_commands_synopsis - ; `S "DESCRIPTION" - ; `P - {|Dune is a build system designed for OCaml projects only. It + Cmd.info "dune" ~doc + ~version: + (match Build_info.V1.version () with + | None -> "n/a" + | Some v -> Build_info.V1.Version.to_string v) + ~man: + [ `Blocks common_commands_synopsis + ; `S "DESCRIPTION" + ; `P + {|Dune is a build system designed for OCaml projects only. It focuses on providing the user with a consistent experience and takes care of most of the low-level details of OCaml compilation. All you have to do is provide a description of your project and Dune will do the rest. |} - ; `P - {|The scheme it implements is inspired from the one used inside Jane + ; `P + {|The scheme it implements is inspired from the one used inside Jane Street and adapted to the open source world. It has matured over a long time and is used daily by hundreds of developers, which means that it is highly tested and productive. |} - ; `Blocks Common.help_secs - ; Common.examples - [ ("Initialise a new project named `foo'", "dune init project foo") - ; ("Build all targets in the current source tree", "dune build") - ; ("Run the executable named `bar'", "dune exec bar") - ; ("Run all tests in the current source tree", "dune runtest") - ; ("Install all components defined in the project", "dune install") - ; ("Remove all build artefacts", "dune clean") - ] - ] ) + ; `Blocks Common.help_secs + ; Common.examples + [ ("Initialise a new project named `foo'", "dune init project foo") + ; ("Build all targets in the current source tree", "dune build") + ; ("Run the executable named `bar'", "dune exec bar") + ; ("Run all tests in the current source tree", "dune runtest") + ; ("Install all components defined in the project", "dune install") + ; ("Remove all build artefacts", "dune clean") + ] + ] + +let cmd = Cmd.group info all let exit_and_flush code = Console.finish (); @@ -92,9 +87,9 @@ let exit_and_flush code = let () = Colors.setup_err_formatter_colors (); try - match Term.Group.eval default all ~catch:false with - | `Error _ -> exit_and_flush 1 - | _ -> exit_and_flush 0 + match Cmd.eval_value cmd ~catch:false with + | Ok _ -> exit_and_flush 0 + | Error _ -> exit_and_flush 1 with | Scheduler.Run.Shutdown.E Requested -> exit_and_flush 0 | Scheduler.Run.Shutdown.E (Signal _) -> exit_and_flush 130 diff --git a/bin/ocaml_cmd.ml b/bin/ocaml_cmd.ml index 8457c1febcb..99315b4ec32 100644 --- a/bin/ocaml_cmd.ml +++ b/bin/ocaml_cmd.ml @@ -1,12 +1,11 @@ open Import -let info = Term.info "ocaml" +let info = Cmd.info "ocaml" let group = - ( Term.Group.Group - [ in_group Utop.command - ; in_group Ocaml_merlin.command - ; in_group Ocaml_merlin.Dump_dot_merlin.command - ; in_group Top.command - ] - , info ) + Cmdliner.Cmd.group info + [ Utop.command + ; Ocaml_merlin.command + ; Ocaml_merlin.Dump_dot_merlin.command + ; Top.command + ] diff --git a/bin/ocaml_cmd.mli b/bin/ocaml_cmd.mli index 8c539d3387e..d4c5902fcd6 100644 --- a/bin/ocaml_cmd.mli +++ b/bin/ocaml_cmd.mli @@ -1,3 +1,3 @@ open Import -val group : unit Term.Group.t +val group : unit Cmd.t diff --git a/bin/ocaml_merlin.ml b/bin/ocaml_merlin.ml index 6996b57bff3..2072b089c61 100644 --- a/bin/ocaml_merlin.ml +++ b/bin/ocaml_merlin.ml @@ -192,7 +192,7 @@ let man = ; Common.footer ] -let info = Term.info "ocaml-merlin" ~doc ~man +let info = Cmd.info "ocaml-merlin" ~doc ~man let term = let+ common = Common.term @@ -214,7 +214,7 @@ let term = | Some s -> Server.dump s | None -> Server.start ()) -let command = (term, info) +let command = Cmd.v info term module Dump_dot_merlin = struct let doc = "Print Merlin configuration" @@ -230,7 +230,7 @@ module Dump_dot_merlin = struct ; Common.footer ] - let info = Term.info "dump-dot-merlin" ~doc ~man + let info = Cmd.info "dump-dot-merlin" ~doc ~man let term = let+ common = Common.term @@ -249,5 +249,5 @@ module Dump_dot_merlin = struct | Some s -> Server.dump_dot_merlin s | None -> Server.dump_dot_merlin ".") - let command = (term, info) + let command = Cmd.v info term end diff --git a/bin/ocaml_merlin.mli b/bin/ocaml_merlin.mli index da88812c8e8..15026f93d8f 100644 --- a/bin/ocaml_merlin.mli +++ b/bin/ocaml_merlin.mli @@ -1,5 +1,7 @@ -val command : unit Cmdliner.Term.t * Cmdliner.Term.info +open Import + +val command : unit Cmd.t module Dump_dot_merlin : sig - val command : unit Cmdliner.Term.t * Cmdliner.Term.info + val command : unit Cmd.t end diff --git a/bin/print_rules.ml b/bin/print_rules.ml index 5948704a9e3..cee1e57e21f 100644 --- a/bin/print_rules.ml +++ b/bin/print_rules.ml @@ -25,7 +25,7 @@ let man = ; `Blocks Common.help_secs ] -let info = Term.info "rules" ~doc ~man +let info = Cmd.info "rules" ~doc ~man let print_rule_makefile ppf (rule : Dune_engine.Reflection.Rule.t) = let action = @@ -137,4 +137,4 @@ let term = | None -> print stdout | Some fn -> Io.with_file_out fn ~f:print)) -let command = (term, info) +let command = Cmd.v info term diff --git a/bin/print_rules.mli b/bin/print_rules.mli index 6d988967f3a..8c78dc310b9 100644 --- a/bin/print_rules.mli +++ b/bin/print_rules.mli @@ -1 +1,3 @@ -val command : unit Cmdliner.Term.t * Cmdliner.Term.info +open Import + +val command : unit Cmd.t diff --git a/bin/printenv.ml b/bin/printenv.ml index 2cf4a7bfbf4..931bf1dd749 100644 --- a/bin/printenv.ml +++ b/bin/printenv.ml @@ -9,7 +9,7 @@ let man = ; `Blocks Common.help_secs ] -let info = Term.info "printenv" ~doc ~man +let info = Cmd.info "printenv" ~doc ~man let dump sctx ~dir = let open Action_builder.O in @@ -88,4 +88,4 @@ let term = (Dune_engine.Context_name.to_string name) (pp ~fields) env)) -let command = (term, info) +let command = Cmd.v info term diff --git a/bin/printenv.mli b/bin/printenv.mli index 6d988967f3a..8c78dc310b9 100644 --- a/bin/printenv.mli +++ b/bin/printenv.mli @@ -1 +1,3 @@ -val command : unit Cmdliner.Term.t * Cmdliner.Term.info +open Import + +val command : unit Cmd.t diff --git a/bin/promote.ml b/bin/promote.ml index 792bc0dbea7..fbbff1c5333 100644 --- a/bin/promote.ml +++ b/bin/promote.ml @@ -39,4 +39,4 @@ let command = in These (files, on_missing)) in - (term, Term.info "promote" ~doc ~man) + Cmd.v (Cmd.info "promote" ~doc ~man) term diff --git a/bin/promote.mli b/bin/promote.mli index 6d988967f3a..8c78dc310b9 100644 --- a/bin/promote.mli +++ b/bin/promote.mli @@ -1 +1,3 @@ -val command : unit Cmdliner.Term.t * Cmdliner.Term.info +open Import + +val command : unit Cmd.t diff --git a/bin/rpc.ml b/bin/rpc.ml index 3e76d63990e..368faf08132 100644 --- a/bin/rpc.ml +++ b/bin/rpc.ml @@ -130,9 +130,9 @@ module Status = struct let info = let doc = "show active connections" in - Term.info "status" ~doc + Cmd.info "status" ~doc - let term = (Term.Group.Term term, info) + let cmd = Cmd.v info term end module Build = struct @@ -163,9 +163,9 @@ module Build = struct "build a given target (requires dune to be running in passive watching \ mode)" in - Term.info "build" ~doc + Cmd.info "build" ~doc - let term = (Term.Group.Term term, info) + let cmd = Cmd.v info term end module Ping = struct @@ -189,13 +189,13 @@ module Ping = struct let info = let doc = "Ping the build server running in the current directory" in - Term.info "ping" ~doc + Cmd.info "ping" ~doc let term = let+ (common : Common.t) = Common.term in client_term common exec - let term = (Term.Group.Term term, info) + let cmd = Cmd.v info term end let info = @@ -206,6 +206,6 @@ let info = ; `Blocks Common.help_secs ] in - Term.info "rpc" ~doc ~man + Cmd.info "rpc" ~doc ~man -let group = (Term.Group.Group [ Status.term; Build.term; Ping.term ], info) +let group = Cmd.group info [ Status.cmd; Build.cmd; Ping.cmd ] diff --git a/bin/rpc.mli b/bin/rpc.mli index 0b4b6db510e..6ff422917b4 100644 --- a/bin/rpc.mli +++ b/bin/rpc.mli @@ -7,4 +7,4 @@ val active_server : unit -> Dune_rpc.Where.t val client_term : Common.t -> (unit -> 'a Fiber.t) -> 'a -val group : unit Term.Group.t +val group : unit Cmdliner.Cmd.t diff --git a/bin/shutdown.ml b/bin/shutdown.ml index 9e9820200b1..3439d150efb 100644 --- a/bin/shutdown.ml +++ b/bin/shutdown.ml @@ -22,10 +22,10 @@ let exec common = let info = let doc = "cancel and shutdown any builds in the current workspace" in - Term.info "shutdown" ~doc + Cmd.info "shutdown" ~doc let term = let+ (common : Common.t) = Common.term in Rpc.client_term common exec -let command = (term, info) +let command = Cmd.v info term diff --git a/bin/shutdown.mli b/bin/shutdown.mli index 8e37776fc90..8c78dc310b9 100644 --- a/bin/shutdown.mli +++ b/bin/shutdown.mli @@ -1,3 +1,3 @@ open Import -val command : unit Term.t * Term.info +val command : unit Cmd.t diff --git a/bin/subst.ml b/bin/subst.ml index 301144fa291..4f50a8bb3b4 100644 --- a/bin/subst.ml +++ b/bin/subst.ml @@ -418,7 +418,7 @@ let man = ; `Blocks Common.help_secs ] -let info = Term.info "subst" ~doc ~man +let info = Cmd.info "subst" ~doc ~man let term = let+ () = Common.build_info @@ -441,4 +441,4 @@ let term = ~signal_watcher:`No) subst -let command = (term, info) +let command = Cmd.v info term diff --git a/bin/subst.mli b/bin/subst.mli index 6d988967f3a..8c78dc310b9 100644 --- a/bin/subst.mli +++ b/bin/subst.mli @@ -1 +1,3 @@ -val command : unit Cmdliner.Term.t * Cmdliner.Term.info +open Import + +val command : unit Cmd.t diff --git a/bin/top.ml b/bin/top.ml index 76f4f0ff008..fee8132ed92 100644 --- a/bin/top.ml +++ b/bin/top.ml @@ -15,7 +15,7 @@ let man = ; `Blocks Common.help_secs ] -let info = Term.info "top" ~doc ~man +let info = Cmd.info "top" ~doc ~man let link_deps sctx link = let open Memo.O in @@ -69,4 +69,4 @@ let term = Dune_rules.Toplevel.print_toplevel_init_file ~include_paths ~files_to_load)) -let command = (term, info) +let command = Cmd.v info term diff --git a/bin/top.mli b/bin/top.mli index 6d988967f3a..8c78dc310b9 100644 --- a/bin/top.mli +++ b/bin/top.mli @@ -1 +1,3 @@ -val command : unit Cmdliner.Term.t * Cmdliner.Term.info +open Import + +val command : unit Cmd.t diff --git a/bin/upgrade.ml b/bin/upgrade.ml index ff49b00cfb2..c990f78cc5c 100644 --- a/bin/upgrade.ml +++ b/bin/upgrade.ml @@ -11,11 +11,11 @@ let man = ; `Blocks Common.help_secs ] -let info = Term.info "upgrade" ~doc ~man +let info = Cmd.info "upgrade" ~doc ~man let term = let+ common = Common.term in let config = Common.init common in Scheduler.go ~common ~config (fun () -> Dune_upgrader.upgrade ()) -let command = (term, info) +let command = Cmd.v info term diff --git a/bin/upgrade.mli b/bin/upgrade.mli index 6d988967f3a..8c78dc310b9 100644 --- a/bin/upgrade.mli +++ b/bin/upgrade.mli @@ -1 +1,3 @@ -val command : unit Cmdliner.Term.t * Cmdliner.Term.info +open Import + +val command : unit Cmd.t diff --git a/bin/utop.ml b/bin/utop.ml index 70f184ff5a4..2ac13a13a87 100644 --- a/bin/utop.ml +++ b/bin/utop.ml @@ -11,7 +11,7 @@ let man = ; `Blocks Common.help_secs ] -let info = Term.info "utop" ~doc ~man +let info = Cmd.info "utop" ~doc ~man let term = let+ common = Common.term @@ -51,4 +51,4 @@ let term = restore_cwd_and_execve common utop_path (utop_path :: args) (Super_context.context_env sctx) -let command = (term, info) +let command = Cmd.v info term diff --git a/bin/utop.mli b/bin/utop.mli index 6d988967f3a..54b77188162 100644 --- a/bin/utop.mli +++ b/bin/utop.mli @@ -1 +1 @@ -val command : unit Cmdliner.Term.t * Cmdliner.Term.info +val command : unit Cmdliner.Cmd.t diff --git a/doc/dune.inc b/doc/dune.inc index 2ba527ec9d8..274d6cd56f6 100644 --- a/doc/dune.inc +++ b/doc/dune.inc @@ -1,4 +1,13 @@ +(rule + (with-stdout-to dune-test.1 + (run dune test --help=groff))) + +(install + (section man) + (package dune) + (files dune-test.1)) + (rule (with-stdout-to dune-build.1 (run dune build --help=groff))) @@ -251,12 +260,3 @@ (package dune) (files dune-utop.1)) -(rule - (with-stdout-to dune-test.1 - (run dune test --help=groff))) - -(install - (section man) - (package dune) - (files dune-test.1)) - diff --git a/doc/update-jbuild.sh b/doc/update-jbuild.sh index 2db491c3a5c..0db9b7613e6 100755 --- a/doc/update-jbuild.sh +++ b/doc/update-jbuild.sh @@ -5,7 +5,7 @@ set -e -o pipefail CMDS=$(dune --help=plain | \ - sed -n '/COMMANDS/,/OPTIONS/p' | sed -En 's/^ ([a-z-]+) ?.*/\1/p') + sed -n '/COMMAND ALIASES/,/COMMON OPTIONS/p' | sed -En 's/^ ([a-z-]+) ?.*/\1/p') for cmd in $CMDS; do cat <&1 | grep "; profile" diff --git a/test/blackbox-tests/test-cases/cmdliner-dep-conf.t/run.t b/test/blackbox-tests/test-cases/cmdliner-dep-conf.t/run.t old mode 100755 new mode 100644 index 6d3706ccef6..2213ae13898 --- a/test/blackbox-tests/test-cases/cmdliner-dep-conf.t/run.t +++ b/test/blackbox-tests/test-cases/cmdliner-dep-conf.t/run.t @@ -14,13 +14,13 @@ [1] $ dune build "(fi" - dune build: TARGET... arguments: unclosed parenthesis at end of input - Usage: dune build [OPTION]... [TARGET]... - Try `dune build --help' or `dune --help' for more information. + dune: TARGET… arguments: unclosed parenthesis at end of input + Usage: dune build [OPTION]… [TARGET]… + Try 'dune build --help' or 'dune --help' for more information. [1] $ dune build "()" - dune build: TARGET... arguments: Unexpected list - Usage: dune build [OPTION]... [TARGET]... - Try `dune build --help' or `dune --help' for more information. + dune: TARGET… arguments: Unexpected list + Usage: dune build [OPTION]… [TARGET]… + Try 'dune build --help' or 'dune --help' for more information. [1] diff --git a/test/blackbox-tests/test-cases/describe.t b/test/blackbox-tests/test-cases/describe.t index 62bf5697bdf..afcc96c1008 100644 --- a/test/blackbox-tests/test-cases/describe.t +++ b/test/blackbox-tests/test-cases/describe.t @@ -1323,12 +1323,12 @@ Test errors [1] $ dune describe --lang 1.0 - dune describe: Only --lang 0.1 is available at the moment as this command is not yet - stabilised. If you would like to release a software that relies on the output - of 'dune describe', please open a ticket on - https://github.com/ocaml/dune. - Usage: dune describe [OPTION]... [STRING]... - Try `dune describe --help' or `dune --help' for more information. + dune: Only --lang 0.1 is available at the moment as this command is not yet + stabilised. If you would like to release a software that relies on the output + of 'dune describe', please open a ticket on + https://github.com/ocaml/dune. + Usage: dune describe [OPTION]… [STRING]… + Try 'dune describe --help' or 'dune --help' for more information. [1] opam file listing diff --git a/test/blackbox-tests/test-cases/dune-init.t/run.t b/test/blackbox-tests/test-cases/dune-init.t/run.t index 0cb9133b31c..eb82ed5ea6e 100644 --- a/test/blackbox-tests/test-cases/dune-init.t/run.t +++ b/test/blackbox-tests/test-cases/dune-init.t/run.t @@ -251,13 +251,12 @@ Comments in dune files are preserved Will not create components with invalid names $ dune init lib invalid-component-name ./_test_lib - dune init: NAME argument: invalid component name - `invalid-component-name' - Library names must be non-empty and composed only of the - following - characters: 'A'..'Z', 'a'..'z', '_' or '0'..'9'. - Usage: dune init [OPTION]... COMPONENT NAME [PATH] - Try `dune init --help' or `dune --help' for more information. + dune: NAME argument: invalid component name `invalid-component-name' + Library names must be non-empty and composed only of the + following + characters: 'A'..'Z', 'a'..'z', '_' or '0'..'9'. + Usage: dune init [OPTION]… COMPONENT NAME [PATH] + Try 'dune init --help' or 'dune --help' for more information. [1] $ test -f ./_test_lib [1] @@ -265,10 +264,10 @@ Will not create components with invalid names Will fail and inform user when invalid component command is given $ dune init foo blah - dune init: COMPONENT argument: invalid value `foo', expected one of - `executable', `library', `project' or `test' - Usage: dune init [OPTION]... COMPONENT NAME [PATH] - Try `dune init --help' or `dune --help' for more information. + dune: COMPONENT argument: invalid value 'foo', expected one of 'executable', + 'library', 'project' or 'test' + Usage: dune init [OPTION]… COMPONENT NAME [PATH] + Try 'dune init --help' or 'dune --help' for more information. [1] Will fail and inform user when an invalid option is given to a component diff --git a/test/blackbox-tests/test-cases/external-lib-deps.t b/test/blackbox-tests/test-cases/external-lib-deps.t index 1ba689c12eb..4fea65397fe 100644 --- a/test/blackbox-tests/test-cases/external-lib-deps.t +++ b/test/blackbox-tests/test-cases/external-lib-deps.t @@ -1,5 +1,5 @@ external-lib-deps is no more. $ dune external-lib-deps - dune external-lib-deps: This subcommand is no longer implemented. + dune: This subcommand is no longer implemented. [1] diff --git a/test/blackbox-tests/test-cases/github3046.t b/test/blackbox-tests/test-cases/github3046.t index 6fe7849a117..3e69b68328c 100644 --- a/test/blackbox-tests/test-cases/github3046.t +++ b/test/blackbox-tests/test-cases/github3046.t @@ -7,29 +7,28 @@ are given as parameters `dune init exe main --libs="str gsl"` returns an informative parsing error $ dune init exe main --libs="str gsl" - dune init: option `--libs': invalid element in list (`str gsl'): expected a - valid dune atom - Usage: dune init [OPTION]... COMPONENT NAME [PATH] - Try `dune init --help' or `dune --help' for more information. + dune: option '--libs': invalid element in list ('str gsl'): expected a valid + dune atom + Usage: dune init [OPTION]… COMPONENT NAME [PATH] + Try 'dune init --help' or 'dune --help' for more information. [1] `dune init lib foo --ppx="foo bar"` returns an informative parsing error $ dune init lib foo --ppx="foo bar" - dune init: option `--ppx': invalid element in list (`foo bar'): expected a - valid dune atom - Usage: dune init [OPTION]... COMPONENT NAME [PATH] - Try `dune init --help' or `dune --help' for more information. + dune: option '--ppx': invalid element in list ('foo bar'): expected a valid + dune atom + Usage: dune init [OPTION]… COMPONENT NAME [PATH] + Try 'dune init --help' or 'dune --help' for more information. [1] `dune init lib foo --public="some/invalid&name!"` returns an informative parsing error $ dune init lib foo --public="some/invalid&name!" - dune init: option `--public': invalid component name - `some/invalid&name!' - Library names must be non-empty and composed only of the - following - characters: 'A'..'Z', 'a'..'z', '_' or '0'..'9'. - Usage: dune init [OPTION]... COMPONENT NAME [PATH] - Try `dune init --help' or `dune --help' for more information. + dune: option '--public': invalid component name `some/invalid&name!' + Library names must be non-empty and composed only of the + following + characters: 'A'..'Z', 'a'..'z', '_' or '0'..'9'. + Usage: dune init [OPTION]… COMPONENT NAME [PATH] + Try 'dune init --help' or 'dune --help' for more information. [1] diff --git a/test/blackbox-tests/test-cases/github3530.t b/test/blackbox-tests/test-cases/github3530.t index 4aa6157a402..6583ab892e0 100644 --- a/test/blackbox-tests/test-cases/github3530.t +++ b/test/blackbox-tests/test-cases/github3530.t @@ -2,15 +2,15 @@ When an empty string is passed to `-p`, we get a nice error message. $ echo '(lang dune 2.0)' > dune-project $ dune build -p '' - dune build: option `--only-packages': Invalid package name: "" - Usage: dune build [OPTION]... [TARGET]... - Try `dune build --help' or `dune --help' for more information. + dune: option '--only-packages': Invalid package name: "" + Usage: dune build [OPTION]… [TARGET]… + Try 'dune build --help' or 'dune --help' for more information. [1] This can happen in a list as well: $ dune build -p 'a,b,' - dune build: option `--only-packages': Invalid package name: "" - Usage: dune build [OPTION]... [TARGET]... - Try `dune build --help' or `dune --help' for more information. + dune: option '--only-packages': Invalid package name: "" + Usage: dune build [OPTION]… [TARGET]… + Try 'dune build --help' or 'dune --help' for more information. [1] diff --git a/test/blackbox-tests/test-cases/misc.t/run.t b/test/blackbox-tests/test-cases/misc.t/run.t index 55292e23b88..fdc5fd94b8e 100644 --- a/test/blackbox-tests/test-cases/misc.t/run.t +++ b/test/blackbox-tests/test-cases/misc.t/run.t @@ -6,39 +6,39 @@ Test that incompatible options are properly reported ---------------------------------------------------- $ dune build --verbose --display quiet - dune build: Cannot use --verbose and --display simultaneously - Usage: dune build [OPTION]... [TARGET]... - Try `dune build --help' or `dune --help' for more information. + dune: Cannot use --verbose and --display simultaneously + Usage: dune build [OPTION]… [TARGET]… + Try 'dune build --help' or 'dune --help' for more information. [1] $ dune build -p toto --root . - dune build: option `--root' cannot be repeated - Usage: dune build [OPTION]... [TARGET]... - Try `dune build --help' or `dune --help' for more information. + dune: option '--root' cannot be repeated + Usage: dune build [OPTION]… [TARGET]… + Try 'dune build --help' or 'dune --help' for more information. [1] $ dune build --for-release-of-packages toto --root . - dune build: option `--root' cannot be repeated - Usage: dune build [OPTION]... [TARGET]... - Try `dune build --help' or `dune --help' for more information. + dune: option '--root' cannot be repeated + Usage: dune build [OPTION]… [TARGET]… + Try 'dune build --help' or 'dune --help' for more information. [1] $ dune build --no-config --config x - dune build: Cannot use --config and --no-config simultaneously - Usage: dune build [OPTION]... [TARGET]... - Try `dune build --help' or `dune --help' for more information. + dune: Cannot use --config and --no-config simultaneously + Usage: dune build [OPTION]… [TARGET]… + Try 'dune build --help' or 'dune --help' for more information. [1] $ dune build -p toto --release - dune build: option `--root' cannot be repeated - Usage: dune build [OPTION]... [TARGET]... - Try `dune build --help' or `dune --help' for more information. + dune: option '--root' cannot be repeated + Usage: dune build [OPTION]… [TARGET]… + Try 'dune build --help' or 'dune --help' for more information. [1] $ dune build --release --root . - dune build: option `--root' cannot be repeated - Usage: dune build [OPTION]... [TARGET]... - Try `dune build --help' or `dune --help' for more information. + dune: option '--root' cannot be repeated + Usage: dune build [OPTION]… [TARGET]… + Try 'dune build --help' or 'dune --help' for more information. [1] Allowed combinations diff --git a/vendor/cmdliner/LICENSE.md b/vendor/cmdliner/LICENSE.md index 90fca24d71e..c4cd256d5c6 100644 --- a/vendor/cmdliner/LICENSE.md +++ b/vendor/cmdliner/LICENSE.md @@ -1,4 +1,4 @@ -Copyright (c) 2011 Daniel C. Bünzli +Copyright (c) 2011 The cmdliner programmers Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above diff --git a/vendor/cmdliner/src/cmdliner.ml b/vendor/cmdliner/src/cmdliner.ml index 4bf33a0b09e..b5b1f11fbdd 100644 --- a/vendor/cmdliner/src/cmdliner.ml +++ b/vendor/cmdliner/src/cmdliner.ml @@ -1,406 +1,23 @@ (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli. All rights reserved. + Copyright (c) 2011 The cmdliner programmers. All rights reserved. Distributed under the ISC license, see terms at the end of the file. - cmdliner v1.0.4-31-gb5d6161 ---------------------------------------------------------------------------*) module Manpage = Cmdliner_manpage -module Arg = Cmdliner_arg module Term = struct - type ('a, 'b) stdlib_result = ('a, 'b) result - include Cmdliner_term - - (* Deprecated *) - - let man_format = Cmdliner_arg.man_format - let pure = const - - (* Terms *) - - let ( $ ) = app - - type 'a ret = [ `Ok of 'a | term_escape ] - - let ret (al, v) = - al, fun ei cl -> match v ei cl with - | Ok (`Ok v) -> Ok v - | Ok (`Error _ as err) -> Error err - | Ok (`Help _ as help) -> Error help - | Error _ as e -> e - - let term_result ?(usage = false) (al, v) = - al, fun ei cl -> match v ei cl with - | Ok (Ok _ as ok) -> ok - | Ok (Error (`Msg e)) -> Error (`Error (usage, e)) - | Error _ as e -> e - - let cli_parse_result (al, v) = - al, fun ei cl -> match v ei cl with - | Ok (Ok _ as ok) -> ok - | Ok (Error (`Msg e)) -> Error (`Parse e) - | Error _ as e -> e - - let main_name = - Cmdliner_info.Args.empty, - (fun ei _ -> Ok (Cmdliner_info.(term_name @@ eval_main ei))) - - let choice_names = - let choice_name t = Cmdliner_info.term_name t in - Cmdliner_info.Args.empty, - (fun ei _ -> Ok (List.rev_map choice_name (Cmdliner_info.eval_choices ei))) - - let with_used_args (al, v) : (_ * string list) t = - al, fun ei cl -> - match v ei cl with - | Ok x -> - let actual_args arg_info acc = - let args = Cmdliner_cline.actual_args cl arg_info in - List.rev_append args acc - in - let used = List.rev (Cmdliner_info.Args.fold actual_args al []) in - Ok (x, used) - | Error _ as e -> e - - (* Term information *) - - type exit_info = Cmdliner_info.exit - let exit_info = Cmdliner_info.exit - - let exit_status_success = 0 - let exit_status_cli_error = 124 - let exit_status_internal_error = 125 - let default_error_exits = - [ exit_info exit_status_cli_error ~doc:"on command line parsing errors."; - exit_info exit_status_internal_error - ~doc:"on unexpected internal errors (bugs)."; ] - - let default_exits = - (exit_info exit_status_success ~doc:"on success.") :: default_error_exits - - type env_info = Cmdliner_info.env - let env_info = Cmdliner_info.env - - type info = Cmdliner_info.term - let info = Cmdliner_info.term ~args:Cmdliner_info.Args.empty - let name ti = Cmdliner_info.term_name ti - - (* Evaluation *) - - let err_help s = "Term error, help requested for unknown command " ^ s - let err_argv = "argv array must have at least one element" - let err_multi_cmd_def name (a, _) (a', _) = - Cmdliner_base.err_multi_def ~kind:"command" name Cmdliner_info.term_doc a a' - - type 'a result = - [ `Ok of 'a | `Error of [`Parse | `Term | `Exn ] | `Version | `Help ] - - let add_stdopts ei = - let docs = Cmdliner_info.(term_stdopts_docs @@ eval_term ei) in - let vargs, vers = match Cmdliner_info.(term_version @@ eval_main ei) with - | None -> Cmdliner_info.Args.empty, None - | Some _ -> - let args, _ as vers = Cmdliner_arg.stdopt_version ~docs in - args, Some vers - in - let help = Cmdliner_arg.stdopt_help ~docs in - let args = Cmdliner_info.Args.union vargs (fst help) in - let term = Cmdliner_info.(term_add_args (eval_term ei) args) in - help, vers, Cmdliner_info.eval_with_term ei term - - type 'a eval_result = - ('a, [ term_escape - | `Exn of exn * Printexc.raw_backtrace - | `Parse of string - | `Std_help of Manpage.format | `Std_version ]) stdlib_result - - let run ~catch ei cl f = try (f ei cl :> 'a eval_result) with - | exn when catch -> - let bt = Printexc.get_raw_backtrace () in - Error (`Exn (exn, bt)) - - let try_eval_stdopts ~catch ei cl help version = - match run ~catch ei cl (snd help) with - | Ok (Some fmt) -> Some (Error (`Std_help fmt)) - | Error _ as err -> Some err - | Ok None -> - match version with - | None -> None - | Some version -> - match run ~catch ei cl (snd version) with - | Ok false -> None - | Ok true -> Some (Error (`Std_version)) - | Error _ as err -> Some err - - let term_eval ~catch ei f args = - let help, version, ei = add_stdopts ei in - let term_args = Cmdliner_info.(term_args @@ eval_term ei) in - let res = match Cmdliner_cline.create term_args args with - | Error (e, cl) -> - begin match try_eval_stdopts ~catch ei cl help version with - | Some e -> e - | None -> Error (`Error (true, e)) - end - | Ok cl -> - match try_eval_stdopts ~catch ei cl help version with - | Some e -> e - | None -> run ~catch ei cl f - in - ei, res - - let term_eval_peek_opts ei f args = - let help, version, ei = add_stdopts ei in - let term_args = Cmdliner_info.(term_args @@ eval_term ei) in - let v, ret = match Cmdliner_cline.create ~peek_opts:true term_args args with - | Error (e, cl) -> - begin match try_eval_stdopts ~catch:true ei cl help version with - | Some e -> None, e - | None -> None, Error (`Error (true, e)) - end - | Ok cl -> - let ret = run ~catch:true ei cl f in - let v = match ret with Ok v -> Some v | Error _ -> None in - match try_eval_stdopts ~catch:true ei cl help version with - | Some e -> v, e - | None -> v, ret - in - let ret = match ret with - | Ok v -> `Ok v - | Error `Std_help _ -> `Help - | Error `Std_version -> `Version - | Error `Parse _ -> `Error `Parse - | Error `Help _ -> `Help - | Error `Exn _ -> `Error `Exn - | Error `Error _ -> `Error `Term - in - v, ret - - let do_help help_ppf err_ppf ei fmt cmd = - let ei = match cmd with - | None -> Cmdliner_info.(eval_with_term ei @@ eval_main ei) - | Some cmd -> - try - let is_cmd t = Cmdliner_info.term_name t = cmd in - let cmd = List.find is_cmd (Cmdliner_info.eval_choices ei) in - Cmdliner_info.eval_with_term ei cmd - with Not_found -> invalid_arg (err_help cmd) - in - let _, _, ei = add_stdopts ei (* may not be the originally eval'd term *) in - Cmdliner_docgen.pp_man ~errs:err_ppf fmt help_ppf ei - - let do_result help_ppf err_ppf ei = function - | Ok v -> `Ok v - | Error res -> - match res with - | `Std_help fmt -> Cmdliner_docgen.pp_man err_ppf fmt help_ppf ei; `Help - | `Std_version -> Cmdliner_msg.pp_version help_ppf ei; `Version - | `Parse err -> - Cmdliner_msg.pp_err_usage err_ppf ei ~err_lines:false ~err; - `Error `Parse - | `Help (fmt, cmd) -> do_help help_ppf err_ppf ei fmt cmd; `Help - | `Exn (e, bt) -> Cmdliner_msg.pp_backtrace err_ppf ei e bt; `Error `Exn - | `Error (usage, err) -> - (if usage - then Cmdliner_msg.pp_err_usage err_ppf ei ~err_lines:true ~err - else Cmdliner_msg.pp_err err_ppf ei ~err); - `Error `Term - - (* API *) - - let env_default v = try Some (Sys.getenv v) with Not_found -> None - let remove_exec argv = - try List.tl (Array.to_list argv) with Failure _ -> invalid_arg err_argv - - let eval - ?help:(help_ppf = Format.std_formatter) - ?err:(err_ppf = Format.err_formatter) - ?(catch = true) ?(env = env_default) ?(argv = Sys.argv) ((al, f), ti) = - let term = Cmdliner_info.term_add_args ti al in - let ei = Cmdliner_info.eval ~env (Simple term) in - let args = remove_exec argv in - let ei, res = term_eval ~catch ei f args in - do_result help_ppf err_ppf ei res - - let choose_term main choices = function - | [] -> Ok (main, [], [fst main]) - | maybe :: args' as args -> - if String.length maybe > 1 && maybe.[0] = '-' then Ok (main, args, [fst main]) else - let index = - let add acc (choice, _ as c) = - let name = Cmdliner_info.term_name choice in - match Cmdliner_trie.add acc name c with - | `New t -> t - | `Replaced (c', _) -> invalid_arg (err_multi_cmd_def name c c') - in - List.fold_left add Cmdliner_trie.empty choices - in - match Cmdliner_trie.find index maybe with - | `Ok choice -> Ok (choice, args', [fst choice ; fst main]) - | `Not_found -> - let all = Cmdliner_trie.ambiguities index "" in - let hints = Cmdliner_suggest.value maybe all in - Error (Cmdliner_base.err_unknown ~kind:"command" maybe ~hints) - | `Ambiguous -> - let ambs = Cmdliner_trie.ambiguities index maybe in - let ambs = List.sort compare ambs in - Error (Cmdliner_base.err_ambiguous ~kind:"command" maybe ~ambs) - - module Group = struct - type 'a node = - | Term of 'a Cmdliner_term.t - | Group of 'a t list - - and 'a t = 'a node * info - - let term_add_args (al, f) info = - Cmdliner_info.term_add_args info al - - let rec add_args (node, info) = - match node with - | Term (al, f) -> (Term (al, f), term_add_args (al, f) info) - | Group subs -> (Group (List.map add_args subs), info) - - let (>>=) res f = - match res with - | Error e -> Error e - | Ok x -> f x - - let parse_arg_cmd = function - | [] -> Error `No_args - | cmd :: args -> - if String.length cmd >= 1 && cmd.[0] = '-' then - Error `No_args - else - Ok (cmd, args) - - let cmd_name (_, info) = Cmdliner_info.term_name info - - let one_of (cmd, (choices : _ t list), path, args) = - let index = - let add acc c = - let name = cmd_name c in - match Cmdliner_trie.add acc name c with - | `New t -> t - | `Replaced (c', _) -> - let flip (x, y) = (y, x) in - invalid_arg (err_multi_cmd_def name (flip c) (flip c')) - in - List.fold_left add Cmdliner_trie.empty choices - in - match Cmdliner_trie.find index cmd with - | `Ok (choice, info) -> Ok ((choice, info), choices, info :: path, args) - | `Not_found -> - let all = Cmdliner_trie.ambiguities index "" in - let hints = Cmdliner_suggest.value cmd all in - Error (`Invalid_command (cmd, path, choices, hints)) - | `Ambiguous -> - let ambs = Cmdliner_trie.ambiguities index cmd in - let ambs = List.sort compare ambs in - Error (`Ambiguous (cmd, path, ambs)) - - let try_one_of choices path args = - match parse_arg_cmd args with - | Ok (cmd, args) -> one_of (cmd, choices, path, args) - | Error `No_args -> Error (`No_args (path, choices)) - - let rec try_choose_term choices path args = - try_one_of choices path args >>= choose_term - - and choose_term ((t, info), choices, path, args) = - match t with - | Term t -> Ok ((t, info), choices, path, args) - | Group subs -> try_choose_term subs path args - - let choose_term main choices args = - let path = [snd main] in - match parse_arg_cmd args with - | Error `No_args -> Ok (main, choices, path, args) - | Ok (cmd, args) -> one_of (cmd, choices, path, args) >>= choose_term - - let eval - ?help:(help_ppf = Format.std_formatter) - ?err:(err_ppf = Format.err_formatter) - ?(catch = true) ?(env = env_default) ?(argv = Sys.argv) main choices = - let choices_f = List.map add_args choices in - let to_term_f ((al, f), ti) = Cmdliner_info.term_add_args ti al, f in - let main_args = fst main in - let main_f = to_term_f main in - let main = fst main_f in - match choose_term (main_args, (fst main_f)) choices_f (remove_exec argv) with - | Error (`No_args (path, choices)) -> - let err = Cmdliner_base.err_no_sub_command in - let sibling_terms = List.map snd choices in - let ei = Cmdliner_info.eval ~env - (Sub_command { path ; main ; sibling_terms}) in - let help, version, ei = add_stdopts ei in - let term_args = Cmdliner_info.(term_args @@ eval_term ei) in - let args = remove_exec argv in - begin match Cmdliner_cline.create ~peek_opts:true term_args args with - | Ok cl - | Error (_, cl) -> - begin match try_eval_stdopts ~catch:true ei cl help version with - | Some e -> do_result help_ppf err_ppf ei e - | None -> - Cmdliner_msg.pp_err_usage err_ppf ei ~err_lines:false ~err; - `Error `Parse - end - end - | Error (`Invalid_command (maybe, path, choices, hints)) -> - let err = Cmdliner_base.err_unknown ~kind:"command" maybe ~hints in - let sibling_terms = List.map snd choices in - let ei = - Cmdliner_info.eval ~env (Sub_command { path ; main ; sibling_terms}) - in - Cmdliner_msg.pp_err_usage err_ppf ei ~err_lines:false ~err; - `Error `Parse - | Error (`Ambiguous (cmd, path, ambs)) -> - let err = Cmdliner_base.err_ambiguous ~kind:"command" cmd ~ambs in - let sibling_terms = List.map snd choices in - let ei = - Cmdliner_info.eval ~env (Sub_command { path ; main ; sibling_terms}) in - Cmdliner_msg.pp_err_usage err_ppf ei ~err_lines:false ~err; - `Error `Parse - | Ok (((_, f), info), sibling_terms, path, args) -> - let sibling_terms = List.map snd sibling_terms in - let ei = Cmdliner_info.eval ~env - (Sub_command { main ; path ; sibling_terms }) in - let ei, res = term_eval ~catch ei f args in - do_result help_ppf err_ppf ei res - end - - let eval_choice ?help ?err ?catch ?env ?argv main choices = - let choices = List.map (fun (c, nfo) -> Group.Term c, nfo) choices in - Group.eval ?help ?err ?catch ?env ?argv main choices - - let eval_peek_opts - ?(version_opt = false) ?(env = env_default) ?(argv = Sys.argv) - ((args, f) : 'a t) = - let version = if version_opt then Some "dummy" else None in - let term = Cmdliner_info.term ~args ?version "dummy" in - let ei = Cmdliner_info.eval ~env (Simple term) in - (term_eval_peek_opts ei f (remove_exec argv) :> 'a option * 'a result) - - (* Exits *) - - let exit_status_of_result ?(term_err = 1) = function - | `Ok _ | `Help | `Version -> exit_status_success - | `Error `Term -> term_err - | `Error `Exn -> exit_status_internal_error - | `Error `Parse -> exit_status_cli_error - - let exit_status_of_status_result ?term_err = function - | `Ok n -> n - | r -> exit_status_of_result ?term_err r - - let stdlib_exit = exit - let exit ?term_err r = stdlib_exit (exit_status_of_result ?term_err r) - let exit_status ?term_err r = - stdlib_exit (exit_status_of_status_result ?term_err r) - + include Cmdliner_term_deprecated +end +module Cmd = struct + module Exit = Cmdliner_info.Exit + module Env = Cmdliner_info.Env + include Cmdliner_cmd + include Cmdliner_eval end +module Arg = Cmdliner_arg (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli + Copyright (c) 2011 The cmdliner programmers Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above diff --git a/vendor/cmdliner/src/cmdliner.mli b/vendor/cmdliner/src/cmdliner.mli index 62620726afb..c6d179a9773 100644 --- a/vendor/cmdliner/src/cmdliner.mli +++ b/vendor/cmdliner/src/cmdliner.mli @@ -1,39 +1,25 @@ (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli. All rights reserved. + Copyright (c) 2011 The cmdliner programmers. All rights reserved. Distributed under the ISC license, see terms at the end of the file. - cmdliner v1.0.4-31-gb5d6161 ---------------------------------------------------------------------------*) (** Declarative definition of command line interfaces. - [Cmdliner] provides a simple and compositional mechanism - to convert command line arguments to OCaml values and pass them to - your functions. The module automatically handles syntax errors, - help messages and UNIX man page generation. It supports programs - with single or multiple commands - (like [darcs] or [git]) and respect most of the - {{:http://www.opengroup.org/onlinepubs/009695399/basedefs/xbd_chap12.html} - POSIX} and - {{:http://www.gnu.org/software/libc/manual/html_node/Argument-Syntax.html} - GNU} conventions. + Consult the {{!page-tutorial}tutorial}, details about the supported + {{!page-cli}command line syntax} and {{!page-examples}examples} of + use. - Consult the {{!basics}basics}, details about the supported - {{!cmdline}command line syntax} and {{!examples} examples} of - use. Open the module to use it, it defines only three modules in - your scope. - - {e v1.0.4-31-gb5d6161 — {{:http://erratique.ch/software/cmdliner }homepage}} *) - -(** {1:top Interface} *) + Open the module to use it, it defines only three modules in your + scope. *) (** Man page specification. Man page generation is automatically handled by [Cmdliner], - consult the {{!manual}details}. + consult the {{!page-tool_man.manual}details}. - The {!block} type is used to define a man page's content. It's a - good idea to follow the {{!standard_sections}standard} manual page - structure. + The {!Manpage.block} type is used to define a man page's + content. It's a good idea to follow the + {{!Manpage.standard_sections}standard} manual page structure. {b References.} {ul @@ -60,11 +46,11 @@ module Manpage : sig Except in [`Pre], whitespace and newlines are not significant and are all collapsed to a single space. All block strings - support the {{!doclang}documentation markup language}.*) + support the {{!page-tool_man.doclang}documentation markup language}.*) val escape : string -> string (** [escape s] escapes [s] so that it doesn't get interpreted by the - {{!doclang}documentation markup language}. *) + {{!page-tool_man.doclang}documentation markup language}. *) type title = string * int * string * string * string (** The type for man page titles. Describes the man page @@ -112,12 +98,13 @@ module Manpage : sig listed here. *) val s_options : string - (** The [OPTIONS] section. By default options and flag arguments get + (** The [OPTIONS] section. By default optional arguments get listed here. *) val s_common_options : string - (** The [COMMON OPTIONS] section. For programs with multiple commands - a section that can be used to gather options common to all commands. *) + (** The [COMMON OPTIONS] section. By default help and version options get + listed here. For programs with multiple commands, optional arguments + common to all commands can be added here. *) val s_exit_status : string (** The [EXIT STATUS] section. By default term status exit codes @@ -146,6 +133,10 @@ module Manpage : sig val s_see_also : string (** The [SEE ALSO] section. *) + val s_none : string + (** [s_none] is a special section named ["cmdliner-none"] that can be used + whenever you do not want something to be listed. *) + (** {1:output Output} The {!print} function can be useful if the client wants to define @@ -172,8 +163,8 @@ end (** Terms. - A term is evaluated by a program to produce a {{!result}result}, - which can be turned into an {{!exits}exit status}. A term made of terms + A term is evaluated by a program to produce a {{!Term.result}result}, + which can be turned into an {{!Term.exits}exit status}. A term made of terms referring to {{!Arg}command line arguments} implicitly defines a command line syntax. *) module Term : sig @@ -186,14 +177,6 @@ module Term : sig val const : 'a -> 'a t (** [const v] is a term that evaluates to [v]. *) - (**/**) - val pure : 'a -> 'a t - (** @deprecated use {!const} instead. *) - - val man_format : Manpage.format t - (** @deprecated Use {!Arg.man_format} instead. *) - (**/**) - val ( $ ) : ('a -> 'b) t -> 'a t -> 'b t (** [f $ v] is a term that evaluates to the result of applying the evaluation of [v] to the one of [f]. *) @@ -203,105 +186,137 @@ module Term : sig (** {1 Interacting with Cmdliner's evaluation} *) - type 'a ret = - [ `Help of Manpage.format * string option - | `Error of (bool * string) - | `Ok of 'a ] - (** The type for command return values. See {!ret}. *) - - val ret : 'a ret t -> 'a t - (** [ret v] is a term whose evaluation depends on the case - to which [v] evaluates. With : - {ul - {- [`Ok v], it evaluates to [v].} - {- [`Error (usage, e)], the evaluation fails and [Cmdliner] prints - the error [e] and the term's usage if [usage] is [true].} - {- [`Help (format, name)], the evaluation fails and [Cmdliner] prints the - term's man page in the given [format] (or the man page for a - specific [name] term in case of multiple term evaluation).}} *) - val term_result : ?usage:bool -> ('a, [`Msg of string]) result t -> 'a t (** [term_result ~usage t] evaluates to {ul {- [`Ok v] if [t] evaluates to [Ok v]} {- [`Error `Term] with the error message [e] and usage shown according to [usage] (defaults to [false]), if [t] evaluates to - [Error (`Msg e)].}} *) + [Error (`Msg e)].}} + + See also {!term_result'}. *) + + val term_result' : ?usage:bool -> ('a, string) result t -> 'a t + (** [term_result'] is like {!term_result} but with a [string] + error case. *) val cli_parse_result : ('a, [`Msg of string]) result t -> 'a t (** [cli_parse_result t] is a term that evaluates to: {ul {- [`Ok v] if [t] evaluates to [Ok v].} {- [`Error `Parse] with the error message [e] - if [t] evaluates to [Error (`Msg e)].}} *) + if [t] evaluates to [Error (`Msg e)].}} + + See also {!cli_parse_result'}. *) + + val cli_parse_result' : ('a, string) result t -> 'a t + (** [cli_parse_result'] is like {!cli_parse_result} but with a [string] + error case. *) val main_name : string t - (** [main_name] is a term that evaluates to the "main" term's name. *) + (** [main_name] is a term that evaluates to the main command name; + that is the name of the tool. *) val choice_names : string list t - (** [choice_names] is a term that evaluates to the names of the terms - to choose from. *) + (** [choice_names] is a term that evaluates to the names of the commands + that are children of the main command. *) val with_used_args : 'a t -> ('a * string list) t (** [with_used_args t] is a term that evaluates to [t] tupled with the arguments from the command line that where used to evaluate [t]. *) - (** {1:tinfo Term information} + type 'a ret = + [ `Help of Manpage.format * string option + | `Error of (bool * string) + | `Ok of 'a ] + (** The type for command return values. See {!val-ret}. *) + + val ret : 'a ret t -> 'a t + (** [ret v] is a term whose evaluation depends on the case + to which [v] evaluates. With : + {ul + {- [`Ok v], it evaluates to [v].} + {- [`Error (usage, e)], the evaluation fails and [Cmdliner] prints + the error [e] and the term's usage if [usage] is [true].} + {- [`Help (format, name)], the evaluation fails and [Cmdliner] prints + a manpage in format [format]. If [name] is [None] this is the + the main command's manpage. If [name] is [Some c] this is + the man page of the sub command [c] of the main command.}} + + {b Note.} While not deprecated you are encouraged not use this API. *) + + (** {1:deprecated Deprecated Term evaluation interface} + + This interface is deprecated in favor of {!Cmdliner.Cmd}. Follow + the compiler deprecation warning hints to transition. *) + + (** {2:tinfo Term information} Term information defines the name and man page of a term. For simple evaluation this is the name of the program and its man page. For multiple term evaluation, this is the name of a command and its man page. *) + [@@@alert "-deprecated"] (* Need to be able to mention them ! *) + type exit_info + [@@ocaml.deprecated "Use Cmd.Exit.info instead."] (** The type for exit status information. *) val exit_info : ?docs:string -> ?doc:string -> ?max:int -> int -> exit_info + [@@ocaml.deprecated "Use Cmd.Exit.info instead."] (** [exit_info ~docs ~doc min ~max] describe the range of exit statuses from [min] to [max] (defaults to [min]). [doc] is the man page information for the statuses, defaults to ["undocumented"]. [docs] is the title of the man page section in which the statuses will be listed, it defaults to {!Manpage.s_exit_status}. - In [doc] the {{!doclang}documentation markup language} can be - used with following variables: + In [doc] the {{!page-tool_man.doclang}documentation markup language} + can be used with following variables: {ul {- [$(status)], the value of [min].} {- [$(status_max)], the value of [max].} - {- The variables mentioned in {!info}}} *) + {- The variables mentioned in {!val-info}}} *) val default_exits : exit_info list + [@@ocaml.deprecated + "Use Cmd.Exit.defaults or Cmd.info's defaults ~exits value instead."] (** [default_exits] is information for exit status {!exit_status_success} added to {!default_error_exits}. *) val default_error_exits : exit_info list + [@@ocaml.deprecated "List.filter the Cmd.Exit.defaults value instead."] (** [default_error_exits] is information for exit statuses {!exit_status_cli_error} and {!exit_status_internal_error}. *) type env_info + [@@ocaml.deprecated "Use Cmd.Env.info instead."] (** The type for environment variable information. *) val env_info : ?docs:string -> ?doc:string -> string -> env_info + [@@ocaml.deprecated "Use Cmd.Env.info instead."] (** [env_info ~docs ~doc var] describes an environment variable [var]. [doc] is the man page information of the environment variable, defaults to ["undocumented"]. [docs] is the title of the man page section in which the environment variable will be - listed, it defaults to {!Manpage.s_environment}. + listed, it defaults to {!Cmdliner.Manpage.s_environment}. - In [doc] the {{!doclang}documentation markup language} can be - used with following variables: + In [doc] the {{!page-tool_man.doclang}documentation markup language} + can be used with following variables: {ul {- [$(env)], the value of [var].} - {- The variables mentioned in {!info}}} *) + {- The variables mentioned in {!val-info}}} *) type info + [@@ocaml.deprecated "Use Cmd.info instead."] (** The type for term information. *) val info : ?man_xrefs:Manpage.xref list -> ?man:Manpage.block list -> ?envs:env_info list -> ?exits:exit_info list -> ?sdocs:string -> ?docs:string -> ?doc:string -> ?version:string -> string -> info + [@@ocaml.deprecated "Use Cmd.info instead."] (** [info sdocs man docs doc version name] is a term information such that: {ul @@ -325,16 +340,17 @@ module Term : sig {- [man] is the text of the man page for the term.} {- [man_xrefs] are cross-references to other manual pages. These are used to generate a {!Manpage.s_see_also} section.}} - [doc], [man], [envs] support the {{!doclang}documentation markup - language} in which the following variables are recognized: + [doc], [man], [envs] support the {{!page-tool_man.doclang}documentation + markup language} in which the following variables are recognized: {ul {- [$(tname)] the term's name.} {- [$(mname)] the main term's name.}} *) val name : info -> string + [@@ocaml.deprecated "Use Cmd.info_name instead."] (** [name ti] is the name of the term information. *) - (** {1:evaluation Evaluation} *) + (** {2:evaluation Evaluation} *) type 'a result = [ `Ok of 'a | `Error of [`Parse | `Term | `Exn ] | `Version | `Help ] @@ -347,7 +363,7 @@ module Term : sig {- [`Error `Parse], a command line parse error occurred and was reported on the error formatter.} {- [`Error `Term], a term evaluation error occurred and was reported - on the error formatter (see {!Term.ret}).} + on the error formatter (see {!Term.val-ret}').} {- [`Error `Exn], an exception [e] was caught and reported on the error formatter (see the [~catch] parameter of {!eval}).}} *) @@ -355,6 +371,7 @@ module Term : sig ?help:Format.formatter -> ?err:Format.formatter -> ?catch:bool -> ?env:(string -> string option) -> ?argv:string array -> ('a t * info) -> 'a result + [@@ocaml.deprecated "Use Cmd.v and one of Cmd.eval* instead."] (** [eval help err catch argv (t,i)] is the evaluation result of [t] with command line arguments [argv] (defaults to {!Sys.argv}). @@ -373,6 +390,7 @@ module Term : sig ?help:Format.formatter -> ?err:Format.formatter -> ?catch:bool -> ?env:(string -> string option) -> ?argv:string array -> 'a t * info -> ('a t * info) list -> 'a result + [@@ocaml.deprecated "Use Cmd.group and one of Cmd.eval* instead."] (** [eval_choice help err catch argv (t,i) choices] is like {!eval} except that if the first argument on the command line is not an option name it will look in [choices] for a term whose information has this @@ -382,34 +400,10 @@ module Term : sig is unspecified the "main" term [t] is evaluated. [i] defines the name and man page of the program. *) - module Group : sig - type 'a term - - type 'a node = - | Term of 'a term - | Group of 'a t list - (** The type for an individual command or a command group. - {ul - {- [Term], individual command term.} - {- [Group], a list of command terms in the same group.}} *) - - and 'a t = 'a node * info - (** An individual command or a command group annotated with an [info] *) - - val eval : - ?help:Format.formatter -> ?err:Format.formatter -> ?catch:bool -> - ?env:(string -> string option) -> ?argv:string array -> - 'a term * info -> 'a t list -> 'a result - (** [eval help err catch argv (t, i) choices] is like {!eval_choice} - except that it will search for term inside the command group [choices] - - If a command group is selected without a sub command, the program will - exit with an error message. *) - end with type 'a term := 'a t - val eval_peek_opts : ?version_opt:bool -> ?env:(string -> string option) -> ?argv:string array -> 'a t -> 'a option * 'a result + [@@ocaml.deprecated "Use Cmd.eval_peek_opts instead."] (** [eval_peek_opts version_opt argv t] evaluates [t], a term made of optional arguments only, with the command line [argv] (defaults to {!Sys.argv}). In this evaluation, unknown optional @@ -437,11 +431,11 @@ module Term : sig positional argument from the value of an unknown optional argument. *) - (** {1:exits Turning evaluation results into exit codes} + (** {2:exits Turning evaluation results into exit codes} {b Note.} If you are using the following functions to handle the evaluation result of a term you should add {!default_exits} to - the term's information {{!info}[~exits]} argument. + the term's information {{!val-info}[~exits]} argument. {b WARNING.} You should avoid status codes strictly greater than 125 as those may be used by @@ -449,36 +443,336 @@ module Term : sig some} shells. *) val exit_status_success : int + [@@ocaml.deprecated "Use Cmd.Exit.ok instead."] (** [exit_status_success] is 0, the exit status for success. *) val exit_status_cli_error : int + [@@ocaml.deprecated "Use Cmd.Exit.cli_error instead."] (** [exit_status_cli_error] is 124, an exit status for command line parsing errors. *) val exit_status_internal_error : int + [@@ocaml.deprecated "Use Cmd.Exit.internal_error instead."] (** [exit_status_internal_error] is 125, an exit status for unexpected internal errors. *) - val exit_status_of_result : ?term_err:int -> 'a result -> int + val exit_status_of_result : ?term_err:int -> unit result -> int + [@@ocaml.deprecated "Use Cmd.eval instead."] (** [exit_status_of_result ~term_err r] is an [exit(3)] status code determined from [r] as follows: {ul - {- {!exit_status_success} if [r] is one of [`Ok _], [`Version], [`Help]} + {- {!exit_status_success} if [r] is one of [`Ok ()], [`Version], [`Help]} {- [term_err] if [r] is [`Error `Term], [term_err] defaults to [1].} {- {!exit_status_cli_error} if [r] is [`Error `Parse]} {- {!exit_status_internal_error} if [r] is [`Error `Exn]}} *) val exit_status_of_status_result : ?term_err:int -> int result -> int + [@@ocaml.deprecated "Use Cmd.eval' instead."] (** [exit_status_of_status_result] is like {!exit_status_of_result} except for [`Ok n] where [n] is used as the status exit code. *) - val exit : ?term_err:int -> 'a result -> unit + val exit : ?term_err:int -> unit result -> unit + [@@ocaml.deprecated "Use Stdlib.exit and Cmd.eval instead."] (** [exit ~term_err r] is [Stdlib.exit @@ exit_status_of_result ~term_err r] *) val exit_status : ?term_err:int -> int result -> unit + [@@ocaml.deprecated "Use Stdlib.exit and Cmd.eval' instead."] (** [exit_status ~term_err r] is [Stdlib.exit @@ exit_status_of_status_result ~term_err r] *) + + (**/**) + val pure : 'a -> 'a t + [@@ocaml.deprecated "Use Term.const instead."] + (** @deprecated use {!const} instead. *) + + val man_format : Manpage.format t + [@@ocaml.deprecated "Use Arg.man_format instead."] + (** @deprecated Use {!Arg.man_format} instead. *) + (**/**) +end + +(** Commands. + + Command line syntaxes are implicitely defined by {!Term}s. A command + value binds a syntax and its documentation to a command name. + + A command can group a list of sub commands (and recursively). In this + case your tool defines a tree of commands, each with its own command + line syntax. The root of that tree is called the {e main command}; + it represents your tool and its name. *) +module Cmd : sig + + (** {1:info Command information} + + Command information defines the name and documentation of a command. *) + + (** Exit codes and their information. *) + module Exit : sig + + (** {1:codes Exit codes} *) + + type code = int + (** The type for exit codes. + + {b Warning.} You should avoid status codes strictly greater than 125 + as those may be used by + {{:https://www.gnu.org/software/bash/manual/html_node/Exit-Status.html} + some} shells. *) + + val ok : code + (** [ok] is [0], the exit status for success. *) + + val some_error : code + (** [some_error] is [123], an exit status for indisciminate errors + reported on stderr. *) + + val cli_error : code + (** [cli_error] is [124], an exit status for command line parsing + errors. *) + + val internal_error : code + (** [internal_error] is [125], an exit status for unexpected internal + errors. *) + + (** {1:info Exit code information} *) + + type info + (** The type for exit code information. *) + + val info : ?docs:string -> ?doc:string -> ?max:code -> code -> info + (** [exit_info ~docs ~doc min ~max] describe the range of exit + statuses from [min] to [max] (defaults to [min]). [doc] is the + man page information for the statuses, defaults to ["undocumented"]. + [docs] is the title of the man page section in which the statuses + will be listed, it defaults to {!Manpage.s_exit_status}. + + In [doc] the {{!page-tool_man.doclang}documentation markup language} + can be used with following variables: + {ul + {- [$(status)], the value of [min].} + {- [$(status_max)], the value of [max].} + {- The variables mentioned in the {!Cmd.val-info}}} *) + + val info_code : info -> code + (** [info_code i] is the minimal code of [i]. *) + + val defaults : info list + (** [defaults] are exit code information for {!ok}, {!some_error} + {!cli_error} and {!internal_error}. *) + end + + (** Environment variable and their information. *) + module Env : sig + + (** {1:envvars Environment variables} *) + + type var = string + (** The type for environment names. *) + + (** {1:info Environment variable information} *) + + [@@@alert "-deprecated"] + + type info = Term.env_info (* because of Arg. *) + (** The type for environment variable information. *) + + [@@@alert "+deprecated"] + + val info : ?deprecated:string -> ?docs:string -> ?doc:string -> var -> info + (** [info ~docs ~doc var] describes an environment variable + [var] such that: + {ul + {- [doc] is the man page information of the environment + variable, defaults to ["undocumented"].} + {- [docs] is the title of the man page section in which the environment + variable will be listed, it defaults to + {!Cmdliner.Manpage.s_environment}.} + {- [deprecated], if specified the environment is deprecated and the + string is a message output on standard error when the environment + variable gets used to lookup the default value of an argument.}} + In [doc] the {{!page-tool_man.doclang}documentation markup language} + can be used with following variables: + {ul + {- [$(env)], the value of [var].} + {- The variables mentioned in {!val-info}.}} *) + end + + type info + (** The type for information about commands. *) + + val info : + ?deprecated:string -> ?man_xrefs:Manpage.xref list -> + ?man:Manpage.block list -> ?envs:Env.info list -> ?exits:Exit.info list -> + ?sdocs:string -> ?docs:string -> ?doc:string -> ?version:string -> + string -> info + (** [info name ?sdocs ?man ?docs ?doc ?version] is a term information + such that: + {ul + {- [name] is the name of the command.} + {- [version] is the version string of the command line tool, this + is only relevant for the main command and ignored otherwise.} + {- [deprecated], if specified the command is deprecated and the + string is a message output on standard error when the command + is used.} + {- [doc] is a one line description of the command used + for the [NAME] section of the command's man page and in command + group listings.} + {- [docs], for commands that are part of a group, the title of the + section of the parent's command man page where it should be listed + (defaults to {!Manpage.s_commands}).} + {- [sdocs] defines the title of the section in which the + standard [--help] and [--version] arguments are listed + (defaults to {!Manpage.s_common_options}).} + {- [exits] is a list of exit statuses that the command evaluation + may produce, defaults to {!Exit.defaults}.} + {- [envs] is a list of environment variables that influence + the command's evaluation.} + {- [man] is the text of the man page for the command.} + {- [man_xrefs] are cross-references to other manual pages. These + are used to generate a {!Manpage.s_see_also} section.}} + + [doc], [man], [envs] support the {{!page-tool_man.doclang}documentation + markup language} in which the following variables are recognized: + {ul + {- [$(tname)] the (term's) command's name.} + {- [$(mname)] the main command name.}} *) + + (** {1:cmds Commands} *) + + type 'a t + (** The type for commands whose evaluation result in a value of + type ['a]. *) + + val v : info -> 'a Term.t -> 'a t + (** [v i t] is a command with information [i] and command line syntax + parsed by [t]. *) + + val group : ?default:'a Term.t -> info -> 'a t list -> 'a t + (** [group i ?default cmds] is a command with information [i] that + groups sub commands [cmds]. [default] is the command line syntax + to parse if no sub command is specified on the command line. If + [default] is [None] (default), the tool errors when no sub + command is specified. *) + + val name : 'a t -> string + (** [name c] is the name of [c]. *) + + (** {1:eval Evaluation} + + These functions are meant to be composed with {!Stdlib.exit}. + The following exit codes may be returned by all these functions: + {ul + {- {!Exit.cli_error} if a parse error occurs.} + {- {!Exit.internal_error} if the [~catch] argument is [true] (default) + and an uncaught exception is raised.} + {- The value of [~term_err] (defaults to {!Exit.cli_error}) if + a term error occurs.}} + + These exit codes are described in {!Exit.defaults} which is the + default value of the [?exits] argument of function {!val-info}. *) + + val eval : + ?help:Format.formatter -> ?err:Format.formatter -> ?catch:bool -> + ?env:(string -> string option) -> ?argv:string array -> + ?term_err:Exit.code -> unit t -> Exit.code + (** [eval cmd] is {!Exit.ok} if [cmd] evaluates to [()]. + See {!eval_value} for other arguments. *) + + val eval' : + ?help:Format.formatter -> ?err:Format.formatter -> ?catch:bool -> + ?env:(string -> string option) -> ?argv:string array -> + ?term_err:Exit.code -> Exit.code t -> Exit.code + (** [eval' cmd] is [c] if [cmd] evaluates to the exit code [c]. + See {!eval_value} for other arguments. *) + + val eval_result : + ?help:Format.formatter -> ?err:Format.formatter -> ?catch:bool -> + ?env:(string -> string option) -> ?argv:string array -> + ?term_err:Exit.code -> (unit, string) result t -> Exit.code + (** [eval_result cmd] is: + {ul + {- {!Exit.ok} if [cmd] evaluates to [Ok ()].} + {- {!Exit.some_error} if [cmd] evaluates to [Error msg]. In this + case [msg] is printed on [err].}} + See {!eval_value} for other arguments. *) + + val eval_result' : + ?help:Format.formatter -> ?err:Format.formatter -> ?catch:bool -> + ?env:(string -> string option) -> ?argv:string array -> + ?term_err:Exit.code -> (Exit.code, string) result t -> Exit.code + (** [eval_result' cmd] is: + {ul + {- [c] if [cmd] evaluates to [Ok c].} + {- {!Exit.some_error} if [cmd] evaluates to [Error msg]. In this + case [msg] is printed on [err].}} + See {!eval_value} for other arguments. *) + + (** {2:eval_low Low level evaluation} + + This interface gives more information on command evaluation results + and lets you choose how to map evaluation results to exit codes. *) + + type 'a eval_ok = + [ `Ok of 'a (** The term of the command evaluated to this value. *) + | `Version (** The version of the main cmd was requested. *) + | `Help (** Help was requested. *) ] + (** The type for successful evaluation results. *) + + type eval_error = + [ `Parse (** A parse error occured. *) + | `Term (** A term evaluation error occured. *) + | `Exn (** An uncaught exception occured. *) ] + (** The type for erroring evaluation results. *) + + val eval_value : + ?help:Format.formatter -> ?err:Format.formatter -> ?catch:bool -> + ?env:(string -> string option) -> ?argv:string array -> 'a t -> + ('a eval_ok, eval_error) result + (** [eval ~help ~err ~catch ~env ~argv cmd] is the evaluation result + of [cmd] with: + {ul + {- [argv] the command line arguments to parse (defaults to {!Sys.argv})} + {- [env] the function used for environment variable lookup (defaults + to {!Sys.getenv}.} + {- [catch] if [true] (default) uncaught exceptions + are intercepted and their stack trace is written to the [err] + formatter} + {- [help] is the formatter used to print help or version messages + (defaults to {!Format.std_formatter})} + {- [err] is the formatter used to print error messages + (defaults to {!Format.err_formatter}.}} *) + + val eval_peek_opts : + ?version_opt:bool -> ?env:(string -> string option) -> + ?argv:string array -> 'a Term.t -> + 'a option * ('a eval_ok, eval_error) result + (** [eval_peek_opts version_opt argv t] evaluates [t], a term made + of optional arguments only, with the command line [argv] + (defaults to {!Sys.argv}). In this evaluation, unknown optional + arguments and positional arguments are ignored. + + The evaluation returns a pair. The first component is + the result of parsing the command line [argv] stripped from + any help and version option if [version_opt] is [true] (defaults + to [false]). It results in: + {ul + {- [Some _] if the command line would be parsed correctly given the + {e partial} knowledge in [t].} + {- [None] if a parse error would occur on the options of [t]}} + + The second component is the result of parsing the command line + [argv] without stripping the help and version options. It + indicates what the evaluation would result in on [argv] given + the partial knowledge in [t] (for example it would return + [`Help] if there's a help option in [argv]). However in + contrasts to {!val-eval_value} no side effects like error + reporting or help output occurs. + + {b Note.} Positional arguments can't be peeked without the full + specification of the command line: we can't tell apart a + positional argument from the value of an unknown optional + argument. *) end (** Terms for command line arguments. @@ -487,8 +781,8 @@ end to the arguments provided on the command line. Basic constraints, like the argument type or repeatability, are - specified by defining a value of type {!t}. Further constraints can - be specified during the {{!argterms}conversion} to a term. *) + specified by defining a value of type {!Arg.t}. Further constraints can + be specified during the {{!Arg.argterms}conversion} to a term. *) module Arg : sig (** {1:argconv Argument converters} @@ -498,50 +792,50 @@ module Arg : sig are provided for many types of the standard library. *) type 'a parser = string -> [ `Ok of 'a | `Error of string ] + [@@ocaml.deprecated "Use Arg.conv or Arg.conv' instead."] (** The type for argument parsers. - @deprecated Use a parser with [('a, [ `Msg of string]) result] results - and {!conv}. *) + {b Deprecated.} Use parser signatures of {!val-conv} or {!val-conv'}. *) type 'a printer = Format.formatter -> 'a -> unit (** The type for converted argument printers. *) + [@@@alert "-deprecated"] (* Need to be able to mention them ! *) + type 'a conv = 'a parser * 'a printer (** The type for argument converters. - {b WARNING.} This type will become abstract in the next - major version of cmdliner, use {!val:conv} or {!pconv} - to construct values of this type. *) + {b Warning.} Do not use directly, use {!val-conv} or {!val-conv'}. + This type will become abstract in the next major version of cmdliner. *) - type 'a converter = 'a conv - (** @deprecated Use the {!type:conv} type via the {!val:conv} and {!pconv} - functions. *) + [@@@alert "+deprecated"] (* Need to be able to mention them ! *) val conv : ?docv:string -> (string -> ('a, [`Msg of string]) result) * 'a printer -> 'a conv - (** [converter ~docv (parse, print)] is an argument converter + (** [conv ~docv (parse, print)] is an argument converter parsing values with [parse] and printing them with [print]. [docv] is a documentation meta-variable used in the documentation to stand for the argument value, defaults to ["VALUE"]. *) - val pconv : - ?docv:string -> 'a parser * 'a printer -> 'a conv - (** [pconv] is like {!converter}, but uses a deprecated {!parser} - signature. *) + val conv' : + ?docv:string -> (string -> ('a, string) result) * 'a printer -> + 'a conv + (** [conv'] is like {!val-conv} but the [Error] case has an unlabelled + string. *) val conv_parser : 'a conv -> (string -> ('a, [`Msg of string]) result) - (** [conv_parser c] 's [c]'s parser. *) + (** [conv_parser c] is the parser of [c]. *) val conv_printer : 'a conv -> 'a printer - (** [conv_printer c] is [c]'s printer. *) + (** [conv_printer c] is the printer of [c]. *) val conv_docv : 'a conv -> string (** [conv_docv c] is [c]'s documentation meta-variable. - {b WARNING.} Currently always returns ["VALUE"] in the future - will return the value given to {!conv} or {!pconv}. *) + {b Warning.} Currently always returns ["VALUE"] in the future + will return the value given to {!val-conv} or {!val-conv'}. *) val parser_of_kind_of_string : kind:string -> (string -> 'a option) -> @@ -550,11 +844,16 @@ module Arg : sig parser using the [kind_of_string] function for parsing and [kind] to report errors (e.g. could be ["an integer"] for an [int] parser.). *) + val some' : ?none:'a -> 'a conv -> 'a option conv + (** [some' ?none c] is like the converter [c] except it returns + [Some] value. It is used for command line arguments that default + to [None] when absent. If provided, [none] is used with [conv]'s + printer to document the value taken on absence; to document + a more complex behaviour use the [absent] argument of {!val-info}. *) + val some : ?none:string -> 'a conv -> 'a option conv - (** [some none c] is like the converter [c] except it returns - [Some] value. It is used for command line arguments - that default to [None] when absent. [none] is what to print to - document the absence (defaults to [""]). *) + (** [some ?none c] is like [some'] but [none] is described as a + string that will be rendered in bold. *) (** {1:arginfo Arguments and their information} @@ -564,18 +863,6 @@ module Arg : sig if the argument is absent from the command line and the variable is defined. *) - type env = Term.env_info - (** The type for environment variables and their documentation. *) - - val env_var : ?docs:string -> ?doc:string -> string -> env - (** [env_var docs doc var] is an environment variables [var]. [doc] - is the man page information of the environment variable, the - {{!doclang}documentation markup language} with the variables - mentioned in {!info} be used; it defaults to ["See option - $(opt)."]. [docs] is the title of the man page section in which - the environment variable will be listed, it defaults to - {!Manpage.s_environment}. *) - type 'a t (** The type for arguments holding data of type ['a]. *) @@ -583,8 +870,8 @@ module Arg : sig (** The type for information about command line arguments. *) val info : - ?docs:string -> ?docv:string -> ?doc:string -> ?env:env -> string list -> - info + ?deprecated:string -> ?absent:string -> ?docs:string -> ?docv:string -> + ?doc:string -> ?env:Cmd.Env.info -> string list -> info (** [info docs docv doc env names] defines information for an argument. {ul @@ -595,10 +882,10 @@ module Arg : sig for positional arguments.} {- [env] defines the name of an environment variable which is looked up for defining the argument if it is absent from the - command line. See {{!envlookup}environment variables} for + command line. See {{!page-cli.envlookup}environment variables} for details.} {- [doc] is the man page information of the argument. - The {{!doclang}documentation language} can be used and + The {{!page-tool_man.doclang}documentation language} can be used and the following variables are recognized: {ul {- ["$(docv)"] the value of [docv] (see below).} @@ -613,7 +900,14 @@ module Arg : sig will be listed. For optional arguments this defaults to {!Manpage.s_options}. For positional arguments this defaults to {!Manpage.s_arguments}. However a positional argument is only - listed if it has both a [doc] and [docv] specified.}} *) + listed if it has both a [doc] and [docv] specified.} + {- [deprecated], if specified the argument is deprecated and the + string is a message output on standard error when the argument + is used.} + {- [absent], if specified a documentation string that indicates + what happens when the argument is absent. The document language + can be used like in [doc]. This overrides the automatic default + value rendering that is performed by the combinators.}} *) val ( & ) : ('a -> 'b) -> 'a -> 'b (** [f & v] is [f v], a right associative composition operator for @@ -637,7 +931,7 @@ module Arg : sig is absent from the command line. *) val vflag : 'a -> ('a * info) list -> 'a t - (** [vflag v \[v]{_0}[,i]{_0}[;...\]] is an ['a] argument defined + (** [vflag v \[v]{_0}[,i]{_0}[;…\]] is an ['a] argument defined by an optional flag that may appear {e at most} once on the command line under one of the names specified in the [i]{_k} values. The argument holds [v] if the flag is absent from the @@ -657,7 +951,6 @@ module Arg : sig {b Note.} Environment variable lookup is unsupported for for these arguments. *) - val alias : string list -> info -> bool t (** [alias l i] is a [flag i] except the arguments [l] are also parsed as if they appeared in place of the option. *) @@ -785,7 +1078,7 @@ module Arg : sig (** [enum l p] converts values such that unambiguous prefixes of string names in [l] map to the corresponding value of type ['a]. - {b Warning.} The type ['a] must be comparable with {!Pervasives.compare}. + {b Warning.} The type ['a] must be comparable with {!Stdlib.compare}. @raise Invalid_argument if [l] is empty. *) @@ -837,812 +1130,49 @@ module Arg : sig (** [doc_quote s] quotes the string [s]. *) val doc_alts : ?quoted:bool -> string list -> string - (** [doc_alts alts] documents the alternative tokens [alts] according - the number of alternatives. If [quoted] is [true] (default) - the tokens are quoted. The resulting string can be used in - sentences of the form ["$(docv) must be %s"]. + (** [doc_alts alts] documents the alternative tokens [alts] + according the number of alternatives. If [quoted] is: + {ul + {- [None], the tokens are enclosed in manpage markup directives + to render them in bold (manpage convention).} + {- [Some true], the tokens are quoted with {!doc_quote}.} + {- [Some false], the tokens are written as is}} + The resulting string can be used in sentences of + the form ["$(docv) must be %s"]. - @raise Invalid_argument if [alts] is the empty string. *) + @raise Invalid_argument if [alts] is the empty list. *) val doc_alts_enum : ?quoted:bool -> (string * 'a) list -> string (** [doc_alts_enum quoted alts] is [doc_alts quoted (List.map fst alts)]. *) -end - -(** {1:basics Basics} - - With [Cmdliner] your program evaluates a term. A {e term} is a value - of type {!Term.t}. The type parameter indicates the type of the - result of the evaluation. - -One way to create terms is by lifting regular OCaml values with -{!Term.const}. Terms can be applied to terms evaluating to functional -values with {!Term.( $ )}. For example for the function: -{[ -let revolt () = print_endline "Revolt!" -]} + (** {1:deprecated Deprecated} *) -the term : + [@@@alert "-deprecated"] -{[ -open Cmdliner - -let revolt_t = Term.(const revolt $ const ()) -]} - -is a term that evaluates to the result (and effect) of the [revolt] -function. Terms are evaluated with {!Term.eval}: - -{[ -let () = Term.exit @@ Term.eval (revolt_t, Term.info "revolt") -]} - -This defines a command line program named ["revolt"], without command -line arguments, that just prints ["Revolt!"] on [stdout]. - -{[ -> ./revolt -Revolt! -]} - -The combinators in the {!Arg} module allow to extract command line -argument data as terms. These terms can then be applied to lifted -OCaml functions to be evaluated by the program. - -Terms corresponding to command line argument data that are part of a -term evaluation implicitly define a command line syntax. We show this -on an concrete example. - -Consider the [chorus] function that prints repeatedly a given message : - -{[ -let chorus count msg = - for i = 1 to count do print_endline msg done -]} - -we want to make it available from the command line with the synopsis: - -{[ -chorus [-c COUNT | --count=COUNT] [MSG] -]} - -where [COUNT] defaults to [10] and [MSG] defaults to ["Revolt!"]. We -first define a term corresponding to the [--count] option: - -{[ -let count = - let doc = "Repeat the message $(docv) times." in - Arg.(value & opt int 10 & info ["c"; "count"] ~docv:"COUNT" ~doc) -]} - -This says that [count] is a term that evaluates to the value of an -optional argument of type [int] that defaults to [10] if unspecified -and whose option name is either [-c] or [--count]. The arguments [doc] -and [docv] are used to generate the option's man page information. - -The term for the positional argument [MSG] is: - -{[ -let msg = - let doc = "Overrides the default message to print." in - let env = Arg.env_var "CHORUS_MSG" ~doc in - let doc = "The message to print." in - Arg.(value & pos 0 string "Revolt!" & info [] ~env ~docv:"MSG" ~doc) -]} - -which says that [msg] is a term whose value is the positional argument -at index [0] of type [string] and defaults to ["Revolt!"] or the -value of the environment variable [CHORUS_MSG] if the argument is -unspecified on the command line. Here again [doc] and [docv] are used -for the man page information. - -The term for executing [chorus] with these command line arguments is : - -{[ -let chorus_t = Term.(const chorus $ count $ msg) -]} - -and we are now ready to define our program: - -{[ -let info = - let doc = "print a customizable message repeatedly" in - let man = [ - `S Manpage.s_bugs; - `P "Email bug reports to ." ] - in - Term.info "chorus" ~version:"%‌%VERSION%%" ~doc ~exits:Term.default_exits ~man + type 'a converter = 'a conv + [@@ocaml.deprecated "Use Arg.conv' function instead."] + (** See {!Arg.conv'}. *) -let () = Term.exit @@ Term.eval (chorus_t, info)) -]} + val pconv : + ?docv:string -> 'a parser * 'a printer -> 'a conv + [@@ocaml.deprecated "Use Arg.conv or Arg.conv' function instead."] + (** [pconv] is like {!val-conv} or {!val-conv'}, but uses a + deprecated {!parser} signature. *) -The [info] value created with {!Term.info} gives more information -about the term we execute and is used to generate the program's man -page. Since we provided a [~version] string, the program will -automatically respond to the [--version] option by printing this -string. -A program using {!Term.eval} always responds to the [--help] option by -showing the man page about the program generated using the information -you provided with {!Term.info} and {!Arg.info}. Here is the output -generated by our example : + type env = Cmd.Env.info + [@@ocaml.deprecated "Use Cmd.Env.info instead."] + (** See {!Cmd.Env.type-info} *) -{v -> ./chorus --help -NAME - chorus - print a customizable message repeatedly - -SYNOPSIS - chorus [OPTION]... [MSG] - -ARGUMENTS - MSG (absent=Revolt! or CHORUS_MSG env) - The message to print. - -OPTIONS - -c COUNT, --count=COUNT (absent=10) - Repeat the message COUNT times. - - --help[=FMT] (default=auto) - Show this help in format FMT. The value FMT must be one of `auto', - `pager', `groff' or `plain'. With `auto', the format is `pager` or - `plain' whenever the TERM env var is `dumb' or undefined. - - --version - Show version information. - -EXIT STATUS - chorus exits with the following status: - - 0 on success. - - 124 on command line parsing errors. - - 125 on unexpected internal errors (bugs). - -ENVIRONMENT - These environment variables affect the execution of chorus: - - CHORUS_MSG - Overrides the default message to print. - -BUGS - Email bug reports to . -v} - -If a pager is available, this output is written to a pager. This help -is also available in plain text or in the -{{:http://www.gnu.org/software/groff/groff.html}groff} man page format -by invoking the program with the option [--help=plain] or -[--help=groff]. - -For examples of more complex command line definitions look and run -the {{!examples}examples}. - -{2:multiterms Multiple terms} - -[Cmdliner] also provides support for programs like [darcs] or [git] -that have multiple commands each with their own syntax: - -{[prog COMMAND [OPTION]... ARG...]} - -A command is defined by coupling a term with {{!Term.tinfo}term -information}. The term information defines the command name and its -man page. Given a list of commands the function {!Term.eval_choice} -will execute the term corresponding to the [COMMAND] argument or a -specific "main" term if there is no [COMMAND] argument. - -{2:doclang Documentation markup language} - -Manpage {{!Manpage.block}blocks} and doc strings support the following -markup language. - -{ul -{- Markup directives [$(i,text)] and [$(b,text)], where [text] is raw - text respectively rendered in italics and bold.} -{- Outside markup directives, context dependent variables of the form - [$(var)] are substituted by marked up data. For example in a term's - man page [$(tname)] is substituted by the term name in bold.} -{- Characters $, (, ) and \ can respectively be escaped by \$, \(, \) - and \\ (in OCaml strings this will be ["\\$"], ["\\("], ["\\)"], - ["\\\\"]). Escaping $ and \ is mandatory everywhere. Escaping ) is - mandatory only in markup directives. Escaping ( is only here for - your symmetric pleasure. Any other sequence of characters starting - with a \ is an illegal character sequence.} -{- Refering to unknown markup directives or variables will generate - errors on standard error during documentation generation.}} - -{2:manual Manual} - -Man page sections for a term are printed in the order specified by the -term manual as given to {!Term.info}. Unless specified explicitely in -the term's manual the following sections are automaticaly created and -populated for you: - -{ul -{- {{!Manpage.s_name}[NAME]} section.} -{- {{!Manpage.s_synopsis}[SYNOPSIS]} section.}} - -The various [doc] documentation strings specified by the term's -subterms and additional metadata get inserted at the end of the -documentation section name [docs] they respectively mention, in the -following order: - -{ol -{- Commands, see {!Term.info}.} -{- Positional arguments, see {!Arg.info}. Those are listed iff - both the [docv] and [doc] string is specified by {!Arg.info}.} -{- Optional arguments, see {!Arg.info}.} -{- Exit statuses, see {!Term.exit_info}.} -{- Environment variables, see {!Arg.env_var} and {!Term.env_info}.}} - -If a [docs] section name is mentioned and does not exist in the term's -manual, an empty section is created for it, after which the [doc] strings -are inserted, possibly prefixed by boilerplate text (e.g. for -{!Manpage.s_environment} and {!Manpage.s_exit_status}). - -If the created section is: -{ul -{- {{!Manpage.standard_sections}standard}, it - is inserted at the right place in the order specified - {{!Manpage.standard_sections}here}, but after a possible non-standard - section explicitely specified by the term since the latter get the - order number of the last previously specified standard section - or the order of {!Manpage.s_synopsis} if there is no such section.} -{- non-standard, it is inserted before the {!Manpage.s_commands} - section or the first subsequent existing standard section if it - doesn't exist. Taking advantage of this behaviour is discouraged, - you should declare manually your non standard section in the term's - manual.}} - -Ideally all manual strings should be UTF-8 encoded. However at the -moment macOS (until at least 10.12) is stuck with [groff 1.19.2] which -doesn't support `preconv(1)`. Regarding UTF-8 output, generating the -man page with [-Tutf8] maps the hyphen-minus [U+002D] to the minus -sign [U+2212] which makes it difficult to search it in the pager, so -[-Tascii] is used for now. Conclusion is that it is better to stick -to the ASCII set for now. Please contact the author if something seems -wrong in this reasoning or if you know a work around this. - -{2:misc Miscellaneous} - -{ul -{- The option name [--cmdliner] is reserved by the library.} -{- The option name [--help], (and [--version] if you specify a version - string) is reserved by the library. Using it as a term or option - name may result in undefined behaviour.} -{- Defining the same option or command name via two different - arguments or terms is illegal and raises [Invalid_argument].}} - -{1:cmdline Command line syntax} - -For programs evaluating a single term the most general form of invocation is: - -{[ -prog [OPTION]... [ARG]... -]} - -The program automatically reponds to the [--help] option by printing -the help. If a version string is provided in the {{!Term.tinfo}term -information}, it also automatically responds to the [--version] option -by printing this string. - -Command line arguments are either {{!optargs}{e optional}} or -{{!posargs}{e positional}}. Both can be freely interleaved but since -[Cmdliner] accepts many optional forms this may result in -ambiguities. The special {{!posargs} token [--]} can be used to -resolve them. - -Programs evaluating multiple terms also add this form of invocation: - -{[ -prog COMMAND [OPTION]... [ARG]... -]} - -Commands automatically respond to the [--help] option by printing -their help. The [COMMAND] string must be the first string following -the program name and may be specified by a prefix as long as it is not -ambiguous. - -{2:optargs Optional arguments} - -An optional argument is specified on the command line by a {e name} -possibly followed by a {e value}. - -The name of an option can be short or long. - -{ul -{- A {e short} name is a dash followed by a single alphanumeric - character: ["-h"], ["-q"], ["-I"].} -{- A {e long} name is two dashes followed by alphanumeric - characters and dashes: ["--help"], ["--silent"], ["--ignore-case"].}} - -More than one name may refer to the same optional argument. For -example in a given program the names ["-q"], ["--quiet"] and -["--silent"] may all stand for the same boolean argument indicating -the program to be quiet. Long names can be specified by any non -ambiguous prefix. - -The value of an option can be specified in three different ways. - -{ul -{- As the next token on the command line: ["-o a.out"], ["--output a.out"].} -{- Glued to a short name: ["-oa.out"].} -{- Glued to a long name after an equal character: ["--output=a.out"].}} - -Glued forms are especially useful if the value itself starts with a -dash as is the case for negative numbers, ["--min=-10"]. - -An optional argument without a value is either a {e flag} (see -{!Arg.flag}, {!Arg.vflag}) or an optional argument with an optional -value (see the [~vopt] argument of {!Arg.opt}). - -Short flags can be grouped together to share a single dash and the -group can end with a short option. For example assuming ["-v"] and -["-x"] are flags and ["-f"] is a short option: - -{ul -{- ["-vx"] will be parsed as ["-v -x"].} -{- ["-vxfopt"] will be parsed as ["-v -x -fopt"].} -{- ["-vxf opt"] will be parsed as ["-v -x -fopt"].} -{- ["-fvx"] will be parsed as ["-f=vx"].}} - -{2:posargs Positional arguments} - -Positional arguments are tokens on the command line that are not -option names and are not the value of an optional argument. They are -numbered from left to right starting with zero. - -Since positional arguments may be mistaken as the optional value of an -optional argument or they may need to look like option names, anything -that follows the special token ["--"] on the command line is -considered to be a positional argument. - -{2:envlookup Environment variables} - -Non-required command line arguments can be backed up by an environment -variable. If the argument is absent from the command line and that -the environment variable is defined, its value is parsed using the -argument converter and defines the value of the argument. - -For {!Arg.flag} and {!Arg.flag_all} that do not have an argument converter a -boolean is parsed from the lowercased variable value as follows: - - -{ul -{- [""], ["false"], ["no"], ["n"] or ["0"] is [false].} -{- ["true"], ["yes"], ["y"] or ["1"] is [true].} -{- Any other string is an error.}} - -Note that environment variables are not supported for {!Arg.vflag} and -{!Arg.vflag_all}. - -{1:examples Examples} - -These examples are in the [test] directory of the distribution. - -{2:exrm A [rm] command} - -We define the command line interface of a [rm] command with the synopsis: - -{[ -rm [OPTION]... FILE... -]} - -The [-f], [-i] and [-I] flags define the prompt behaviour of [rm], -represented in our program by the [prompt] type. If more than one of -these flags is present on the command line the last one takes -precedence. - -To implement this behaviour we map the presence of these flags to -values of the [prompt] type by using {!Arg.vflag_all}. This argument -will contain all occurrences of the flag on the command line and we -just take the {!Arg.last} one to define our term value (if there's no -occurrence the last value of the default list [[Always]] is taken, -i.e. the default is [Always]). - -{[ -(* Implementation of the command, we just print the args. *) - -type prompt = Always | Once | Never -let prompt_str = function -| Always -> "always" | Once -> "once" | Never -> "never" - -let rm prompt recurse files = - Printf.printf "prompt = %s\nrecurse = %B\nfiles = %s\n" - (prompt_str prompt) recurse (String.concat ", " files) - -(* Command line interface *) - -open Cmdliner - -let files = Arg.(non_empty & pos_all file [] & info [] ~docv:"FILE") -let prompt = - let doc = "Prompt before every removal." in - let always = Always, Arg.info ["i"] ~doc in - let doc = "Ignore nonexistent files and never prompt." in - let never = Never, Arg.info ["f"; "force"] ~doc in - let doc = "Prompt once before removing more than three files, or when - removing recursively. Less intrusive than $(b,-i), while - still giving protection against most mistakes." - in - let once = Once, Arg.info ["I"] ~doc in - Arg.(last & vflag_all [Always] [always; never; once]) - -let recursive = - let doc = "Remove directories and their contents recursively." in - Arg.(value & flag & info ["r"; "R"; "recursive"] ~doc) - -let cmd = - let doc = "remove files or directories" in - let man = [ - `S Manpage.s_description; - `P "$(tname) removes each specified $(i,FILE). By default it does not - remove directories, to also remove them and their contents, use the - option $(b,--recursive) ($(b,-r) or $(b,-R))."; - `P "To remove a file whose name starts with a `-', for example - `-foo', use one of these commands:"; - `P "rm -- -foo"; `Noblank; - `P "rm ./-foo"; - `P "$(tname) removes symbolic links, not the files referenced by the - links."; - `S Manpage.s_bugs; `P "Report bugs to ."; - `S Manpage.s_see_also; `P "$(b,rmdir)(1), $(b,unlink)(2)" ] - in - Term.(const rm $ prompt $ recursive $ files), - Term.info "rm" ~version:"v1.0.4-31-gb5d6161" ~doc ~exits:Term.default_exits ~man - -let () = Term.(exit @@ eval cmd) -]} - -{2:excp A [cp] command} - -We define the command line interface of a [cp] command with the synopsis: -{[ -cp [OPTION]... SOURCE... DEST -]} - -The [DEST] argument must be a directory if there is more than one -[SOURCE]. This constraint is too complex to be expressed by the -combinators of {!Arg}. Hence we just give it the {!Arg.string} type -and verify the constraint at the beginning of the [cp] -implementation. If unsatisfied we return an [`Error] and by using -{!Term.ret} on the lifted result [cp_t] of [cp], [Cmdliner] handles -the error reporting. - -{[ -(* Implementation, we check the dest argument and print the args *) - -let cp verbose recurse force srcs dest = - if List.length srcs > 1 && - (not (Sys.file_exists dest) || not (Sys.is_directory dest)) - then - `Error (false, dest ^ " is not a directory") - else - `Ok (Printf.printf - "verbose = %B\nrecurse = %B\nforce = %B\nsrcs = %s\ndest = %s\n" - verbose recurse force (String.concat ", " srcs) dest) - -(* Command line interface *) - -open Cmdliner - -let verbose = - let doc = "Print file names as they are copied." in - Arg.(value & flag & info ["v"; "verbose"] ~doc) - -let recurse = - let doc = "Copy directories recursively." in - Arg.(value & flag & info ["r"; "R"; "recursive"] ~doc) - -let force = - let doc = "If a destination file cannot be opened, remove it and try again."in - Arg.(value & flag & info ["f"; "force"] ~doc) - -let srcs = - let doc = "Source file(s) to copy." in - Arg.(non_empty & pos_left ~rev:true 0 file [] & info [] ~docv:"SOURCE" ~doc) - -let dest = - let doc = "Destination of the copy. Must be a directory if there is more - than one $(i,SOURCE)." in - Arg.(required & pos ~rev:true 0 (some string) None & info [] ~docv:"DEST" - ~doc) - -let cmd = - let doc = "copy files" in - let man_xrefs = - [ `Tool "mv"; `Tool "scp"; `Page (2, "umask"); `Page (7, "symlink") ] - in - let exits = Term.default_exits in - let man = - [ `S Manpage.s_bugs; - `P "Email them to ."; ] - in - Term.(ret (const cp $ verbose $ recurse $ force $ srcs $ dest)), - Term.info "cp" ~version:"v1.0.4-31-gb5d6161" ~doc ~exits ~man ~man_xrefs - -let () = Term.(exit @@ eval cmd) -]} - -{2:extail A [tail] command} - -We define the command line interface of a [tail] command with the -synopsis: - -{[ -tail [OPTION]... [FILE]... -]} - -The [--lines] option whose value specifies the number of last lines to -print has a special syntax where a [+] prefix indicates to start -printing from that line number. In the program this is represented by -the [loc] type. We define a custom [loc] {{!Arg.argconv}argument -converter} for this option. - -The [--follow] option has an optional enumerated value. The argument -converter [follow], created with {!Arg.enum} parses the option value -into the enumeration. By using {!Arg.some} and the [~vopt] argument of -{!Arg.opt}, the term corresponding to the option [--follow] evaluates -to [None] if [--follow] is absent from the command line, to [Some -Descriptor] if present but without a value and to [Some v] if present -with a value [v] specified. - -{[ -(* Implementation of the command, we just print the args. *) - -type loc = bool * int -type verb = Verbose | Quiet -type follow = Name | Descriptor - -let str = Printf.sprintf -let opt_str sv = function None -> "None" | Some v -> str "Some(%s)" (sv v) -let loc_str (rev, k) = if rev then str "%d" k else str "+%d" k -let follow_str = function Name -> "name" | Descriptor -> "descriptor" -let verb_str = function Verbose -> "verbose" | Quiet -> "quiet" - -let tail lines follow verb pid files = - Printf.printf "lines = %s\nfollow = %s\nverb = %s\npid = %s\nfiles = %s\n" - (loc_str lines) (opt_str follow_str follow) (verb_str verb) - (opt_str string_of_int pid) (String.concat ", " files) - -(* Command line interface *) - -open Cmdliner - -let lines = - let loc = - let parse s = - try - if s <> "" && s.[0] <> '+' then Ok (true, int_of_string s) else - Ok (false, int_of_string (String.sub s 1 (String.length s - 1))) - with Failure _ -> Error (`Msg "unable to parse integer") - in - let print ppf p = Format.fprintf ppf "%s" (loc_str p) in - Arg.conv ~docv:"N" (parse, print) - in - Arg.(value & opt loc (true, 10) & info ["n"; "lines"] ~docv:"N" - ~doc:"Output the last $(docv) lines or use $(i,+)$(docv) to start - output after the $(i,N)-1th line.") - -let follow = - let doc = "Output appended data as the file grows. $(docv) specifies how the - file should be tracked, by its `name' or by its `descriptor'." in - let follow = Arg.enum ["name", Name; "descriptor", Descriptor] in - Arg.(value & opt (some follow) ~vopt:(Some Descriptor) None & - info ["f"; "follow"] ~docv:"ID" ~doc) - -let verb = - let doc = "Never output headers giving file names." in - let quiet = Quiet, Arg.info ["q"; "quiet"; "silent"] ~doc in - let doc = "Always output headers giving file names." in - let verbose = Verbose, Arg.info ["v"; "verbose"] ~doc in - Arg.(last & vflag_all [Quiet] [quiet; verbose]) - -let pid = - let doc = "With -f, terminate after process $(docv) dies." in - Arg.(value & opt (some int) None & info ["pid"] ~docv:"PID" ~doc) - -let files = Arg.(value & (pos_all non_dir_file []) & info [] ~docv:"FILE") - -let cmd = - let doc = "display the last part of a file" in - let man = [ - `S Manpage.s_description; - `P "$(tname) prints the last lines of each $(i,FILE) to standard output. If - no file is specified reads standard input. The number of printed - lines can be specified with the $(b,-n) option."; - `S Manpage.s_bugs; - `P "Report them to ."; - `S Manpage.s_see_also; - `P "$(b,cat)(1), $(b,head)(1)" ] - in - Term.(const tail $ lines $ follow $ verb $ pid $ files), - Term.info "tail" ~version:"%‌%VERSION%%" ~doc ~exits:Term.default_exits ~man - -let () = Term.(exit @@ eval cmd) -]} - -{2:exdarcs A [darcs] command} - -We define the command line interface of a [darcs] command with the -synopsis: - -{[ -darcs [COMMAND] ... -]} - -The [--debug], [-q], [-v] and [--prehook] options are available in -each command. To avoid having to pass them individually to each -command we gather them in a record of type [copts]. By lifting the -record constructor [copts] into the term [copts_t] we now have a term -that we can pass to the commands to stand for an argument of type -[copts]. These options are documented in a section called [COMMON -OPTIONS], since we also want to put [--help] and [--version] in this -section, the term information of commands makes a judicious use of the -[sdocs] parameter of {!Term.info}. - -The [help] command shows help about commands or other topics. The help -shown for commands is generated by [Cmdliner] by making an appropriate -use of {!Term.ret} on the lifted [help] function. - -If the program is invoked without a command we just want to show the -help of the program as printed by [Cmdliner] with [--help]. This is -done by the [default_cmd] term. - -{[ -(* Implementations, just print the args. *) - -type verb = Normal | Quiet | Verbose -type copts = { debug : bool; verb : verb; prehook : string option } - -let str = Printf.sprintf -let opt_str sv = function None -> "None" | Some v -> str "Some(%s)" (sv v) -let opt_str_str = opt_str (fun s -> s) -let verb_str = function - | Normal -> "normal" | Quiet -> "quiet" | Verbose -> "verbose" - -let pr_copts oc copts = Printf.fprintf oc - "debug = %B\nverbosity = %s\nprehook = %s\n" - copts.debug (verb_str copts.verb) (opt_str_str copts.prehook) - -let initialize copts repodir = Printf.printf - "%arepodir = %s\n" pr_copts copts repodir - -let record copts name email all ask_deps files = Printf.printf - "%aname = %s\nemail = %s\nall = %B\nask-deps = %B\nfiles = %s\n" - pr_copts copts (opt_str_str name) (opt_str_str email) all ask_deps - (String.concat ", " files) - -let help copts man_format cmds topic = match topic with -| None -> `Help (`Pager, None) (* help about the program. *) -| Some topic -> - let topics = "topics" :: "patterns" :: "environment" :: cmds in - let conv, _ = Cmdliner.Arg.enum (List.rev_map (fun s -> (s, s)) topics) in - match conv topic with - | `Error e -> `Error (false, e) - | `Ok t when t = "topics" -> List.iter print_endline topics; `Ok () - | `Ok t when List.mem t cmds -> `Help (man_format, Some t) - | `Ok t -> - let page = (topic, 7, "", "", ""), [`S topic; `P "Say something";] in - `Ok (Cmdliner.Manpage.print man_format Format.std_formatter page) - -open Cmdliner - -(* Help sections common to all commands *) - -let help_secs = [ - `S Manpage.s_common_options; - `P "These options are common to all commands."; - `S "MORE HELP"; - `P "Use `$(mname) $(i,COMMAND) --help' for help on a single command.";`Noblank; - `P "Use `$(mname) help patterns' for help on patch matching."; `Noblank; - `P "Use `$(mname) help environment' for help on environment variables."; - `S Manpage.s_bugs; `P "Check bug reports at http://bugs.example.org.";] - -(* Options common to all commands *) - -let copts debug verb prehook = { debug; verb; prehook } -let copts_t = - let docs = Manpage.s_common_options in - let debug = - let doc = "Give only debug output." in - Arg.(value & flag & info ["debug"] ~docs ~doc) - in - let verb = - let doc = "Suppress informational output." in - let quiet = Quiet, Arg.info ["q"; "quiet"] ~docs ~doc in - let doc = "Give verbose output." in - let verbose = Verbose, Arg.info ["v"; "verbose"] ~docs ~doc in - Arg.(last & vflag_all [Normal] [quiet; verbose]) - in - let prehook = - let doc = "Specify command to run before this $(mname) command." in - Arg.(value & opt (some string) None & info ["prehook"] ~docs ~doc) - in - Term.(const copts $ debug $ verb $ prehook) - -(* Commands *) - -let initialize_cmd = - let repodir = - let doc = "Run the program in repository directory $(docv)." in - Arg.(value & opt file Filename.current_dir_name & info ["repodir"] - ~docv:"DIR" ~doc) - in - let doc = "make the current directory a repository" in - let exits = Term.default_exits in - let man = [ - `S Manpage.s_description; - `P "Turns the current directory into a Darcs repository. Any - existing files and subdirectories become ..."; - `Blocks help_secs; ] - in - Term.(const initialize $ copts_t $ repodir), - Term.info "initialize" ~doc ~sdocs:Manpage.s_common_options ~exits ~man - -let record_cmd = - let pname = - let doc = "Name of the patch." in - Arg.(value & opt (some string) None & info ["m"; "patch-name"] ~docv:"NAME" - ~doc) - in - let author = - let doc = "Specifies the author's identity." in - Arg.(value & opt (some string) None & info ["A"; "author"] ~docv:"EMAIL" - ~doc) - in - let all = - let doc = "Answer yes to all patches." in - Arg.(value & flag & info ["a"; "all"] ~doc) - in - let ask_deps = - let doc = "Ask for extra dependencies." in - Arg.(value & flag & info ["ask-deps"] ~doc) - in - let files = Arg.(value & (pos_all file) [] & info [] ~docv:"FILE or DIR") in - let doc = "create a patch from unrecorded changes" in - let exits = Term.default_exits in - let man = - [`S Manpage.s_description; - `P "Creates a patch from changes in the working tree. If you specify - a set of files ..."; - `Blocks help_secs; ] - in - Term.(const record $ copts_t $ pname $ author $ all $ ask_deps $ files), - Term.info "record" ~doc ~sdocs:Manpage.s_common_options ~exits ~man - -let help_cmd = - let topic = - let doc = "The topic to get help on. `topics' lists the topics." in - Arg.(value & pos 0 (some string) None & info [] ~docv:"TOPIC" ~doc) - in - let doc = "display help about darcs and darcs commands" in - let man = - [`S Manpage.s_description; - `P "Prints help about darcs commands and other subjects..."; - `Blocks help_secs; ] - in - Term.(ret - (const help $ copts_t $ Arg.man_format $ Term.choice_names $topic)), - Term.info "help" ~doc ~exits:Term.default_exits ~man - -let default_cmd = - let doc = "a revision control system" in - let sdocs = Manpage.s_common_options in - let exits = Term.default_exits in - let man = help_secs in - Term.(ret (const (fun _ -> `Help (`Pager, None)) $ copts_t)), - Term.info "darcs" ~version:"v1.0.4-31-gb5d6161" ~doc ~sdocs ~exits ~man - -let cmds = [initialize_cmd; record_cmd; help_cmd] - -let () = Term.(exit @@ eval_choice default_cmd cmds) -]} -*) + val env_var : + ?deprecated:string -> ?docs:string -> ?doc:string -> Cmd.Env.var -> + Cmd.Env.info + [@@ocaml.deprecated "Use Cmd.Env.info instead."] + (** See {!Cmd.Env.val-info}. *) +end (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli + Copyright (c) 2011 The cmdliner programmers Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above diff --git a/vendor/cmdliner/src/cmdliner_arg.ml b/vendor/cmdliner/src/cmdliner_arg.ml index 284f9e994f9..f32a36d97fa 100644 --- a/vendor/cmdliner/src/cmdliner_arg.ml +++ b/vendor/cmdliner/src/cmdliner_arg.ml @@ -1,7 +1,6 @@ (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli. All rights reserved. + Copyright (c) 2011 The cmdliner programmers. All rights reserved. Distributed under the ISC license, see terms at the end of the file. - cmdliner v1.0.4-31-gb5d6161 ---------------------------------------------------------------------------*) let rev_compare n0 n1 = compare n1 n0 @@ -33,6 +32,10 @@ let conv ?docv (parse, print) = let parse s = match parse s with Ok v -> `Ok v | Error (`Msg e) -> `Error e in parse, print +let conv' ?docv (parse, print) = + let parse s = match parse s with Ok v -> `Ok v | Error e -> `Error e in + parse, print + let pconv ?docv conv = conv let conv_parser (parse, _) = @@ -48,15 +51,16 @@ let parser_of_kind_of_string ~kind k_of_string = | Some v -> Ok v let some = Cmdliner_base.some +let some' = Cmdliner_base.some' (* Argument information *) -type env = Cmdliner_info.env -let env_var = Cmdliner_info.env +type env = Cmdliner_info.Env.info +let env_var = Cmdliner_info.Env.info type 'a t = 'a Cmdliner_term.t -type info = Cmdliner_info.arg -let info = Cmdliner_info.arg +type info = Cmdliner_info.Arg.t +let info = Cmdliner_info.Arg.v (* Arguments *) @@ -68,29 +72,37 @@ let parse_to_list parser s = match parser s with | `Ok v -> `Ok [v] | `Error _ as e -> e -let try_env ei a parse ~absent = match Cmdliner_info.arg_env a with +let report_deprecated_env ei e = match Cmdliner_info.Env.info_deprecated e with +| None -> () +| Some msg -> + let var = Cmdliner_info.Env.info_var e in + let msg = String.concat "" ["environment variable "; var; ": "; msg ] in + let err_fmt = Cmdliner_info.Eval.err_ppf ei in + Cmdliner_msg.pp_err err_fmt ei ~err:msg + +let try_env ei a parse ~absent = match Cmdliner_info.Arg.env a with | None -> Ok absent | Some env -> - let var = Cmdliner_info.env_var env in - match Cmdliner_info.(eval_env_var ei var) with + let var = Cmdliner_info.Env.info_var env in + match Cmdliner_info.Eval.env_var ei var with | None -> Ok absent | Some v -> match parse v with - | `Ok v -> Ok v | `Error e -> err (Cmdliner_msg.err_env_parse env ~err:e) + | `Ok v -> report_deprecated_env ei env; Ok v -let arg_to_args = Cmdliner_info.Args.singleton +let arg_to_args = Cmdliner_info.Arg.Set.singleton let list_to_args f l = - let add acc v = Cmdliner_info.Args.add (f v) acc in - List.fold_left add Cmdliner_info.Args.empty l + let add acc v = Cmdliner_info.Arg.Set.add (f v) acc in + List.fold_left add Cmdliner_info.Arg.Set.empty l let alias_opt aliases a = - let a = Cmdliner_info.arg_make_opt ~absent:Err ~kind:Opt a in + let a = Cmdliner_info.Arg.make_opt ~absent:Err ~kind:Opt a in let aliases = (fun f -> function | None -> Error (Cmdliner_msg.err_opt_value_missing f) | Some o -> Ok (aliases o)) in - let a = Cmdliner_info.arg_aliases ~aliases a in - if Cmdliner_info.arg_is_pos a then invalid_arg err_not_opt else + let a = Cmdliner_info.Arg.aliases ~aliases a in + if Cmdliner_info.Arg.is_pos a then invalid_arg err_not_opt else let convert ei cl = match Cmdliner_cline.opt_arg cl a with | [] -> try_env ei a Cmdliner_base.env_bool_parse ~absent:false | [_, _, None] -> Ok true @@ -103,8 +115,8 @@ let alias aliases a = let aliases = (fun f -> function | Some v -> Error (Cmdliner_msg.err_flag_value f v) | None -> Ok aliases) in - let a = Cmdliner_info.arg_aliases ~aliases a in - if Cmdliner_info.arg_is_pos a then invalid_arg err_not_opt else + let a = Cmdliner_info.Arg.aliases ~aliases a in + if Cmdliner_info.Arg.is_pos a then invalid_arg err_not_opt else let convert ei cl = match Cmdliner_cline.opt_arg cl a with | [] -> try_env ei a Cmdliner_base.env_bool_parse ~absent:false | [_, _, None] -> Ok true @@ -114,7 +126,7 @@ let alias aliases a = arg_to_args a, convert let flag a = - if Cmdliner_info.arg_is_pos a then invalid_arg err_not_opt else + if Cmdliner_info.Arg.is_pos a then invalid_arg err_not_opt else let convert ei cl = match Cmdliner_cline.opt_arg cl a with | [] -> try_env ei a Cmdliner_base.env_bool_parse ~absent:false | [_, _, None] -> Ok true @@ -124,8 +136,8 @@ let flag a = arg_to_args a, convert let flag_all a = - if Cmdliner_info.arg_is_pos a then invalid_arg err_not_opt else - let a = Cmdliner_info.arg_make_all_opts a in + if Cmdliner_info.Arg.is_pos a then invalid_arg err_not_opt else + let a = Cmdliner_info.Arg.make_all_opts a in let convert ei cl = match Cmdliner_cline.opt_arg cl a with | [] -> try_env ei a (parse_to_list Cmdliner_base.env_bool_parse) ~absent:[] @@ -160,7 +172,7 @@ let vflag v l = try Ok (aux None l) with Failure e -> err e in let flag (_, a) = - if Cmdliner_info.arg_is_pos a then invalid_arg err_not_opt else a + if Cmdliner_info.Arg.is_pos a then invalid_arg err_not_opt else a in list_to_args flag l, convert @@ -183,23 +195,26 @@ let vflag_all v l = try Ok (aux [] l) with Failure e -> err e in let flag (_, a) = - if Cmdliner_info.arg_is_pos a then invalid_arg err_not_opt else - Cmdliner_info.arg_make_all_opts a + if Cmdliner_info.Arg.is_pos a then invalid_arg err_not_opt else + Cmdliner_info.Arg.make_all_opts a in list_to_args flag l, convert let parse_opt_value parse f v = match parse v with | `Ok v -> v -| `Error e -> failwith (Cmdliner_msg.err_opt_parse f e) +| `Error err -> failwith (Cmdliner_msg.err_opt_parse f ~err) let opt ?vopt (parse, print) v a = - if Cmdliner_info.arg_is_pos a then invalid_arg err_not_opt else - let absent = Cmdliner_info.Val (lazy (str_of_pp print v)) in + if Cmdliner_info.Arg.is_pos a then invalid_arg err_not_opt else + let absent = match Cmdliner_info.Arg.absent a with + | Cmdliner_info.Arg.Doc d as a when d <> "" -> a + | _ -> Cmdliner_info.Arg.Val (lazy (str_of_pp print v)) + in let kind = match vopt with - | None -> Cmdliner_info.Opt - | Some dv -> Cmdliner_info.Opt_vopt (str_of_pp print dv) + | None -> Cmdliner_info.Arg.Opt + | Some dv -> Cmdliner_info.Arg.Opt_vopt (str_of_pp print dv) in - let a = Cmdliner_info.arg_make_opt ~absent ~kind a in + let a = Cmdliner_info.Arg.make_opt ~absent ~kind a in let convert ei cl = match Cmdliner_cline.opt_arg cl a with | [] -> try_env ei a parse ~absent:v | [_, f, Some v] -> @@ -214,13 +229,16 @@ let opt ?vopt (parse, print) v a = arg_to_args a, convert let opt_all ?vopt (parse, print) v a = - if Cmdliner_info.arg_is_pos a then invalid_arg err_not_opt else - let absent = Cmdliner_info.Val (lazy "") in + if Cmdliner_info.Arg.is_pos a then invalid_arg err_not_opt else + let absent = match Cmdliner_info.Arg.absent a with + | Cmdliner_info.Arg.Doc d as a when d <> "" -> a + | _ -> Cmdliner_info.Arg.Val (lazy "") + in let kind = match vopt with - | None -> Cmdliner_info.Opt - | Some dv -> Cmdliner_info.Opt_vopt (str_of_pp print dv) + | None -> Cmdliner_info.Arg.Opt + | Some dv -> Cmdliner_info.Arg.Opt_vopt (str_of_pp print dv) in - let a = Cmdliner_info.arg_make_opt_all ~absent ~kind a in + let a = Cmdliner_info.Arg.make_opt_all ~absent ~kind a in let convert ei cl = match Cmdliner_cline.opt_arg cl a with | [] -> try_env ei a (parse_to_list parse) ~absent:v | l -> @@ -240,13 +258,16 @@ let opt_all ?vopt (parse, print) v a = let parse_pos_value parse a v = match parse v with | `Ok v -> v -| `Error e -> failwith (Cmdliner_msg.err_pos_parse a e) +| `Error err -> failwith (Cmdliner_msg.err_pos_parse a ~err) let pos ?(rev = false) k (parse, print) v a = - if Cmdliner_info.arg_is_opt a then invalid_arg err_not_pos else - let absent = Cmdliner_info.Val (lazy (str_of_pp print v)) in - let pos = Cmdliner_info.pos ~rev ~start:k ~len:(Some 1) in - let a = Cmdliner_info.arg_make_pos_abs ~absent ~pos a in + if Cmdliner_info.Arg.is_opt a then invalid_arg err_not_pos else + let absent = match Cmdliner_info.Arg.absent a with + | Cmdliner_info.Arg.Doc d as a when d <> "" -> a + | _ -> Cmdliner_info.Arg.Val (lazy (str_of_pp print v)) + in + let pos = Cmdliner_info.Arg.pos ~rev ~start:k ~len:(Some 1) in + let a = Cmdliner_info.Arg.make_pos_abs ~absent ~pos a in let convert ei cl = match Cmdliner_cline.pos_arg cl a with | [] -> try_env ei a parse ~absent:v | [v] -> @@ -256,8 +277,8 @@ let pos ?(rev = false) k (parse, print) v a = arg_to_args a, convert let pos_list pos (parse, _) v a = - if Cmdliner_info.arg_is_opt a then invalid_arg err_not_pos else - let a = Cmdliner_info.arg_make_pos pos a in + if Cmdliner_info.Arg.is_opt a then invalid_arg err_not_pos else + let a = Cmdliner_info.Arg.make_pos ~pos a in let convert ei cl = match Cmdliner_cline.pos_arg cl a with | [] -> try_env ei a (parse_to_list parse) ~absent:v | l -> @@ -266,32 +287,32 @@ let pos_list pos (parse, _) v a = in arg_to_args a, convert -let all = Cmdliner_info.pos ~rev:false ~start:0 ~len:None +let all = Cmdliner_info.Arg.pos ~rev:false ~start:0 ~len:None let pos_all c v a = pos_list all c v a let pos_left ?(rev = false) k = let start = if rev then k + 1 else 0 in let len = if rev then None else Some k in - pos_list (Cmdliner_info.pos ~rev ~start ~len) + pos_list (Cmdliner_info.Arg.pos ~rev ~start ~len) let pos_right ?(rev = false) k = let start = if rev then 0 else k + 1 in let len = if rev then Some k else None in - pos_list (Cmdliner_info.pos ~rev ~start ~len) + pos_list (Cmdliner_info.Arg.pos ~rev ~start ~len) (* Arguments as terms *) let absent_error args = let make_req a acc = - let req_a = Cmdliner_info.arg_make_req a in - Cmdliner_info.Args.add req_a acc + let req_a = Cmdliner_info.Arg.make_req a in + Cmdliner_info.Arg.Set.add req_a acc in - Cmdliner_info.Args.fold make_req args Cmdliner_info.Args.empty + Cmdliner_info.Arg.Set.fold make_req args Cmdliner_info.Arg.Set.empty let value a = a let err_arg_missing args = - err @@ Cmdliner_msg.err_arg_missing (Cmdliner_info.Args.choose args) + err @@ Cmdliner_msg.err_arg_missing (Cmdliner_info.Arg.Set.choose args) let required (args, convert) = let args = absent_error args in @@ -319,14 +340,6 @@ let last (args, convert) = in args, convert -let last_or_none (args, convert) = - let convert ei cl = match convert ei cl with - | Ok [] -> Ok None - | Ok l -> Ok (Some (List.hd (List.rev l))) - | Error _ as e -> e - in - args, convert - (* Predefined arguments *) let man_fmts = @@ -336,9 +349,9 @@ let man_fmt_docv = "FMT" let man_fmts_enum = Cmdliner_base.enum man_fmts let man_fmts_alts = doc_alts_enum man_fmts let man_fmts_doc kind = - strf "Show %s in format $(docv). The value $(docv) must be %s. With `auto', - the format is `pager` or `plain' whenever the $(b,TERM) env var is - `dumb' or undefined." + strf "Show %s in format $(docv). The value $(docv) must be %s. \ + With $(b,auto), the format is $(b,pager) or $(b,plain) whenever \ + the $(b,TERM) env var is $(b,dumb) or undefined." kind man_fmts_alts let man_format = @@ -377,7 +390,7 @@ let t3 = Cmdliner_base.t3 let t4 = Cmdliner_base.t4 (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli + Copyright (c) 2011 The cmdliner programmers Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above diff --git a/vendor/cmdliner/src/cmdliner_arg.mli b/vendor/cmdliner/src/cmdliner_arg.mli index dbd2f0cfdbc..4375b41aad1 100644 --- a/vendor/cmdliner/src/cmdliner_arg.mli +++ b/vendor/cmdliner/src/cmdliner_arg.mli @@ -1,7 +1,6 @@ (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli. All rights reserved. + Copyright (c) 2011 The cmdliner programmers. All rights reserved. Distributed under the ISC license, see terms at the end of the file. - cmdliner v1.0.4-31-gb5d6161 ---------------------------------------------------------------------------*) (** Command line arguments as terms. *) @@ -15,6 +14,9 @@ val conv : ?docv:string -> (string -> ('a, [`Msg of string]) result) * 'a printer -> 'a conv +val conv' : + ?docv:string -> (string -> ('a, string) result) * 'a printer -> 'a conv + val pconv : ?docv:string -> 'a parser * 'a printer -> 'a conv val conv_parser : 'a conv -> (string -> ('a, [`Msg of string]) result) val conv_printer : 'a conv -> 'a printer @@ -25,15 +27,17 @@ val parser_of_kind_of_string : (string -> ('a, [`Msg of string]) result) val some : ?none:string -> 'a converter -> 'a option converter +val some' : ?none:'a -> 'a converter -> 'a option converter -type env = Cmdliner_info.env -val env_var : ?docs:string -> ?doc:string -> string -> env +type env = Cmdliner_info.Env.info +val env_var : ?deprecated:string -> ?docs:string -> ?doc:string -> string -> env type 'a t = 'a Cmdliner_term.t type info val info : - ?docs:string -> ?docv:string -> ?doc:string -> ?env:env -> string list -> info + ?deprecated:string -> ?absent:string -> ?docs:string -> ?docv:string -> + ?doc:string -> ?env:env -> string list -> info val ( & ) : ('a -> 'b) -> 'a -> 'b @@ -97,7 +101,7 @@ val doc_alts_enum : ?quoted:bool -> (string * 'a) list -> string (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli + Copyright (c) 2011 The cmdliner programmers Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above diff --git a/vendor/cmdliner/src/cmdliner_base.ml b/vendor/cmdliner/src/cmdliner_base.ml index 5e84dfc25ba..c1a4d217a41 100644 --- a/vendor/cmdliner/src/cmdliner_base.ml +++ b/vendor/cmdliner/src/cmdliner_base.ml @@ -1,17 +1,58 @@ (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli. All rights reserved. + Copyright (c) 2011 The cmdliner programmers. All rights reserved. Distributed under the ISC license, see terms at the end of the file. - cmdliner v1.0.4-31-gb5d6161 ---------------------------------------------------------------------------*) +let strf = Printf.sprintf + +(* Unique ids *) + +let uid = + (* Thread-safe UIDs, Oo.id (object end) was used before. + Note this won't be thread-safe in multicore, we should use + Atomic but this is >= 4.12 and we have 4.08 for now. *) + let c = ref 0 in + fun () -> + let id = !c in + incr c; if id > !c then assert false (* too many ids *) else id + +(* Edit distance *) + +let edit_distance s0 s1 = + let minimum (a : int) (b : int) (c : int) : int = min a (min b c) in + let s0,s1 = if String.length s0 <= String.length s1 then s0,s1 else s1,s0 in + let m = String.length s0 and n = String.length s1 in + let rec rows row0 row i = match i > n with + | true -> row0.(m) + | false -> + row.(0) <- i; + for j = 1 to m do + if s0.[j - 1] = s1.[i - 1] then row.(j) <- row0.(j - 1) else + row.(j) <- minimum (row0.(j - 1) + 1) (row0.(j) + 1) (row.(j - 1) + 1) + done; + rows row row0 (i + 1) + in + rows (Array.init (m + 1) (fun x -> x)) (Array.make (m + 1) 0) 1 + +let suggest s candidates = + let add (min, acc) name = + let d = edit_distance s name in + if d = min then min, (name :: acc) else + if d < min then d, [name] else + min, acc + in + let dist, suggs = List.fold_left add (max_int, []) candidates in + if dist < 3 (* suggest only if not too far *) then suggs else [] + (* Invalid argument strings *) let err_empty_list = "empty list" -let err_incomplete_enum = "Incomplete enumeration for the type" +let err_incomplete_enum ss = + strf "Arg.enum: missing printable string for a value, other strings are: %s" + (String.concat ", " ss) (* Formatting tools *) -let strf = Printf.sprintf let pp = Format.fprintf let pp_sp = Format.pp_print_space let pp_str = Format.pp_print_string @@ -58,9 +99,12 @@ let pp_tokens ~spaces ppf s = (* collapse white and hint spaces (maybe) *) (* Converter (end-user) error messages *) -let quote s = strf "`%s'" s -let alts_str ?(quoted = true) alts = - let quote = if quoted then quote else (fun s -> s) in +let quote s = strf "'%s'" s +let alts_str ?quoted alts = + let quote = match quoted with + | None -> strf "$(b,%s)" + | Some quoted -> if quoted then quote else (fun s -> s) + in match alts with | [] -> invalid_arg err_empty_list | [a] -> (quote a) @@ -76,26 +120,27 @@ let err_multi_def ~kind name doc v v' = kind name (doc v) (doc v') let err_ambiguous ~kind s ~ambs = - strf "%s %s ambiguous and could be %s" kind (quote s) (alts_str ambs) - -let err_unknown ?(hints = []) ~kind v = - let did_you_mean s = strf ", did you mean %s ?" s in - let hints = match hints with [] -> "." | hs -> did_you_mean (alts_str hs) in + strf "%s %s ambiguous and could be %s" kind (quote s) + (alts_str ~quoted:true ambs) + +let err_unknown ?(dom = []) ?(hints = []) ~kind v = + let hints = match hints, dom with + | [], [] -> "." + | [], dom -> strf ", must be %s." (alts_str ~quoted:true dom) + | hints, _ -> strf ", did you mean %s?" (alts_str ~quoted:true hints) + in strf "unknown %s %s%s" kind (quote v) hints -let err_no_sub_command = - "is a command group and requires a command argument." - let err_no kind s = strf "no %s %s" (quote s) kind let err_not_dir s = strf "%s is not a directory" (quote s) let err_is_dir s = strf "%s is a directory" (quote s) let err_element kind s exp = - strf "invalid element in %s (`%s'): %s" kind s exp + strf "invalid element in %s ('%s'): %s" kind s exp let err_invalid kind s exp = strf "invalid %s %s, %s" kind (quote s) exp let err_invalid_val = err_invalid "value" let err_sep_miss sep s = - err_invalid_val s (strf "missing a `%c' separator" sep) + err_invalid_val s (strf "missing a '%c' separator" sep) (* Converters *) @@ -104,20 +149,25 @@ type 'a printer = Format.formatter -> 'a -> unit type 'a conv = 'a parser * 'a printer let some ?(none = "") (parse, print) = - let parse s = match parse s with - | `Ok v -> `Ok (Some v) - | `Error _ as e -> e - in + let parse s = match parse s with `Ok v -> `Ok (Some v) | `Error _ as e -> e in let print ppf v = match v with | None -> Format.pp_print_string ppf none | Some v -> print ppf v in parse, print +let some' ?none (parse, print) = + let parse s = match parse s with `Ok v -> `Ok (Some v) | `Error _ as e -> e in + let print ppf = function + | None -> (match none with None -> () | Some v -> print ppf v) + | Some v -> print ppf v + in + parse, print + let bool = let parse s = try `Ok (bool_of_string s) with | Invalid_argument _ -> - `Error (err_invalid_val s (alts_str ["true"; "false"])) + `Error (err_invalid_val s (alts_str ~quoted:true ["true"; "false"])) in parse, Format.pp_print_bool @@ -158,15 +208,15 @@ let enum sl = | `Ok _ as r -> r | `Ambiguous -> let ambs = List.sort compare (Cmdliner_trie.ambiguities t s) in - `Error (err_ambiguous "enum value" s ambs) + `Error (err_ambiguous ~kind:"enum value" s ~ambs) | `Not_found -> let alts = List.rev (List.rev_map (fun (s, _) -> s) sl) in - `Error (err_invalid_val s ("expected " ^ (alts_str alts))) + `Error (err_invalid_val s ("expected " ^ (alts_str ~quoted:true alts))) in let print ppf v = let sl_inv = List.rev_map (fun (s,v) -> (v,s)) sl in try pp_str ppf (List.assoc v sl_inv) - with Not_found -> invalid_arg err_incomplete_enum + with Not_found -> invalid_arg (err_incomplete_enum (List.map fst sl)) in parse, print @@ -286,10 +336,12 @@ let t4 ?(sep = ',') (pa0, pr0) (pa1, pr1) (pa2, pr2) (pa3, pr3) = let env_bool_parse s = match String.lowercase_ascii s with | "" | "false" | "no" | "n" | "0" -> `Ok false | "true" | "yes" | "y" | "1" -> `Ok true -| s -> `Error (err_invalid_val s (alts_str ["true"; "yes"; "false"; "no" ])) +| s -> + let alts = alts_str ~quoted:true ["true"; "yes"; "false"; "no" ] in + `Error (err_invalid_val s alts) (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli + Copyright (c) 2011 The cmdliner programmers Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above diff --git a/vendor/cmdliner/src/cmdliner_base.mli b/vendor/cmdliner/src/cmdliner_base.mli index 039b3f94d3c..2c3f3d94e2d 100644 --- a/vendor/cmdliner/src/cmdliner_base.mli +++ b/vendor/cmdliner/src/cmdliner_base.mli @@ -1,11 +1,17 @@ (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli. All rights reserved. + Copyright (c) 2011 The cmdliner programmers. All rights reserved. Distributed under the ISC license, see terms at the end of the file. - cmdliner v1.0.4-31-gb5d6161 ---------------------------------------------------------------------------*) (** A few helpful base definitions. *) +val uid : unit -> int +(** [uid ()] is new unique for the program run. *) + +val suggest : string -> string list -> string list +(** [suggest near candidates] suggest values from [candidates] + not too far from [near]. *) + (** {1:fmt Formatting helpers} *) val pp_text : Format.formatter -> string -> unit @@ -17,10 +23,10 @@ val pp_tokens : spaces:bool -> Format.formatter -> string -> unit val quote : string -> string val alts_str : ?quoted:bool -> string list -> string val err_ambiguous : kind:string -> string -> ambs:string list -> string -val err_unknown : ?hints:string list -> kind:string -> string -> string +val err_unknown : + ?dom:string list -> ?hints:string list -> kind:string -> string -> string val err_multi_def : kind:string -> string -> ('b -> string) -> 'b -> 'b -> string - val err_no_sub_command : string (** {1:conv Textual OCaml value converters} *) @@ -29,6 +35,7 @@ type 'a printer = Format.formatter -> 'a -> unit type 'a conv = 'a parser * 'a printer val some : ?none:string -> 'a conv -> 'a option conv +val some' : ?none:'a -> 'a conv -> 'a option conv val bool : bool conv val char : char conv val int : int conv @@ -53,7 +60,7 @@ val t4 : val env_bool_parse : bool parser (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli + Copyright (c) 2011 The cmdliner programmers Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above diff --git a/vendor/cmdliner/src/cmdliner_cline.ml b/vendor/cmdliner/src/cmdliner_cline.ml index c2f00bd3f62..2b8108c68d6 100644 --- a/vendor/cmdliner/src/cmdliner_cline.ml +++ b/vendor/cmdliner/src/cmdliner_cline.ml @@ -1,7 +1,6 @@ (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli. All rights reserved. + Copyright (c) 2011 The cmdliner programmers. All rights reserved. Distributed under the ISC license, see terms at the end of the file. - cmdliner v1.0.4-31-gb5d6161 ---------------------------------------------------------------------------*) (* A command line stores pre-parsed information about the command @@ -14,7 +13,7 @@ let err_multi_opt_name_def name a a' = Cmdliner_base.err_multi_def - ~kind:"option name" name Cmdliner_info.arg_doc a a' + ~kind:"option name" name Cmdliner_info.Arg.doc a a' module Amap = Map.Make (Cmdliner_info.Arg) @@ -42,18 +41,18 @@ let arg_info_indexes args = let rec loop optidx posidx cl = function | [] -> optidx, posidx, cl | a :: l -> - match Cmdliner_info.arg_is_pos a with + match Cmdliner_info.Arg.is_pos a with | true -> loop optidx (a :: posidx) (Amap.add a (P []) cl) l | false -> let add t name = match Cmdliner_trie.add t name a with | `New t -> t | `Replaced (a', _) -> invalid_arg (err_multi_opt_name_def name a a') in - let names = Cmdliner_info.arg_opt_names a in + let names = Cmdliner_info.Arg.opt_names a in let optidx = List.fold_left add optidx names in loop optidx posidx (Amap.add a (O []) cl) l in - loop Cmdliner_trie.empty [] Amap.empty (Cmdliner_info.Args.elements args) + loop Cmdliner_trie.empty [] Amap.empty (Cmdliner_info.Arg.Set.elements args) (* Optional argument parsing *) @@ -82,7 +81,7 @@ let hint_matching_opt optidx s = let short_opt, _ = parse_opt_arg short_opt in let long_opt, _ = parse_opt_arg long_opt in let all = Cmdliner_trie.ambiguities optidx "-" in - match List.mem short_opt all, Cmdliner_suggest.value long_opt all with + match List.mem short_opt all, Cmdliner_base.suggest long_opt all with | false, [] -> [] | false, l -> l | true, [] -> [short_opt] @@ -100,11 +99,11 @@ let parse_opt_args ~peek_opts optidx cl args = let name, value = parse_opt_arg s in match Cmdliner_trie.find optidx name with | `Ok a -> - let value, args = match value, Cmdliner_info.arg_opt_kind a with - | Some v, (Cmdliner_info.Flag) when is_short_opt name -> - None, ("-" ^ v) :: args + let value, args = match value, Cmdliner_info.Arg.opt_kind a with + | Some v, Cmdliner_info.Arg.Flag when is_short_opt name -> + None, ("-" ^ v) :: args | Some _, _ -> value, args - | None, Cmdliner_info.Flag -> value, args + | None, Cmdliner_info.Arg.Flag -> value, args | None, _ -> match args with | [] -> None, args @@ -112,7 +111,7 @@ let parse_opt_args ~peek_opts optidx cl args = in let arg = O ((k, name, value) :: opt_arg cl a) in let errs,args = - match Cmdliner_info.arg_alias a name value with + match Cmdliner_info.Arg.alias a name value with | Ok l -> errs,l@args | Error err -> err::errs,args in @@ -125,7 +124,7 @@ let parse_opt_args ~peek_opts optidx cl args = | `Ambiguous -> let ambs = Cmdliner_trie.ambiguities optidx name in let ambs = List.sort compare ambs in - let err = Cmdliner_base.err_ambiguous "option" name ambs in + let err = Cmdliner_base.err_ambiguous ~kind:"option" name ~ambs in loop (err :: errs) (k + 1) cl pargs args in let errs, cl, pargs = loop [] 0 cl [] args in @@ -148,7 +147,7 @@ let process_pos_args posidx cl pargs = in the list index posidx, is given a value according the list of positional arguments values [pargs]. *) if pargs = [] then - let misses = List.filter Cmdliner_info.arg_is_req posidx in + let misses = List.filter Cmdliner_info.Arg.is_req posidx in if misses = [] then Ok cl else Error (Cmdliner_msg.err_pos_misses misses, cl) else @@ -157,18 +156,18 @@ let process_pos_args posidx cl pargs = let rec loop misses cl max_spec = function | [] -> misses, cl, max_spec | a :: al -> - let apos = Cmdliner_info.arg_pos a in - let rev = Cmdliner_info.pos_rev apos in - let start = pos rev (Cmdliner_info.pos_start apos) in - let stop = match Cmdliner_info.pos_len apos with + let apos = Cmdliner_info.Arg.pos_kind a in + let rev = Cmdliner_info.Arg.pos_rev apos in + let start = pos rev (Cmdliner_info.Arg.pos_start apos) in + let stop = match Cmdliner_info.Arg.pos_len apos with | None -> pos rev last - | Some n -> pos rev (Cmdliner_info.pos_start apos + n - 1) + | Some n -> pos rev (Cmdliner_info.Arg.pos_start apos + n - 1) in let start, stop = if rev then stop, start else start, stop in let args = take_range start stop pargs in let max_spec = max stop max_spec in let cl = Amap.add a (P args) cl in - let misses = match Cmdliner_info.arg_is_req a && args = [] with + let misses = match Cmdliner_info.Arg.is_req a && args = [] with | true -> a :: misses | false -> misses in @@ -187,8 +186,29 @@ let create ?(peek_opts = false) al args = | Ok (cl, pargs) -> process_pos_args posidx cl pargs | Error (errs, cl, _) -> Error (errs, cl) +let deprecated_msgs cl = + let add i arg acc = match Cmdliner_info.Arg.deprecated i with + | None -> acc + | Some msg -> + let plural l = if List.length l > 1 then "s " else " " in + match arg with + | O [] | P [] -> acc (* Should not happen *) + | O os -> + let plural = plural os in + let names = List.map (fun (_, n, _) -> n) os in + let names = String.concat " " (List.map Cmdliner_base.quote names) in + let msg = "option" :: plural :: names :: ": " :: msg :: [] in + String.concat "" msg :: acc + | P args -> + let plural = plural args in + let args = String.concat " " (List.map Cmdliner_base.quote args) in + let msg = "argument" :: plural :: args :: ": " :: msg :: [] in + String.concat "" msg :: acc + in + Amap.fold add cl [] + (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli + Copyright (c) 2011 The cmdliner programmers Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above diff --git a/vendor/cmdliner/src/cmdliner_cline.mli b/vendor/cmdliner/src/cmdliner_cline.mli index f4f976d23fa..5651bda2dd1 100644 --- a/vendor/cmdliner/src/cmdliner_cline.mli +++ b/vendor/cmdliner/src/cmdliner_cline.mli @@ -1,7 +1,6 @@ (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli. All rights reserved. + Copyright (c) 2011 The cmdliner programmers. All rights reserved. Distributed under the ISC license, see terms at the end of the file. - cmdliner v1.0.4-31-gb5d6161 ---------------------------------------------------------------------------*) (** Command lines. *) @@ -9,16 +8,19 @@ type t val create : - ?peek_opts:bool -> Cmdliner_info.args -> string list -> + ?peek_opts:bool -> Cmdliner_info.Arg.Set.t -> string list -> (t, string * t) result -val opt_arg : t -> Cmdliner_info.arg -> (int * string * (string option)) list -val pos_arg : t -> Cmdliner_info.arg -> string list -val actual_args : t -> Cmdliner_info.arg -> string list +val opt_arg : t -> Cmdliner_info.Arg.t -> (int * string * (string option)) list +val pos_arg : t -> Cmdliner_info.Arg.t -> string list +val actual_args : t -> Cmdliner_info.Arg.t -> string list (** Actual command line arguments from the command line *) +val is_opt : string -> bool +val deprecated_msgs : t -> string list + (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli + Copyright (c) 2011 The cmdliner programmers Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above diff --git a/vendor/cmdliner/src/cmdliner_cmd.ml b/vendor/cmdliner/src/cmdliner_cmd.ml new file mode 100644 index 00000000000..5a156f3fdd6 --- /dev/null +++ b/vendor/cmdliner/src/cmdliner_cmd.ml @@ -0,0 +1,46 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2022 The cmdliner programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +(* Commands *) + +(* Command info *) + +type info = Cmdliner_info.Cmd.t +let info = Cmdliner_info.Cmd.v + +type 'a t = +| Cmd of info * 'a Cmdliner_term.parser +| Group of info * ('a Cmdliner_term.parser option * 'a t list) + +let get_info = function Cmd (i, _) | Group (i, _) -> i +let children_infos = function +| Cmd _ -> [] | Group (_, (_, cs)) -> List.map get_info cs + +let v i (args, p) = Cmd (Cmdliner_info.Cmd.add_args i args, p) +let group ?default i cmds = + let args, parser = match default with + | None -> None, None | Some (args, p) -> Some args, Some p + in + let children = List.map get_info cmds in + let i = Cmdliner_info.Cmd.with_children i ~args ~children in + Group (i, (parser, cmds)) + +let name c = Cmdliner_info.Cmd.name (get_info c) + +(*--------------------------------------------------------------------------- + Copyright (c) 2022 The cmdliner programmers + + Permission to use, copy, modify, and/or distribute this software for any + purpose with or without fee is hereby granted, provided that the above + copyright notice and this permission notice appear in all copies. + + THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + ---------------------------------------------------------------------------*) diff --git a/vendor/cmdliner/src/cmdliner_cmd.mli b/vendor/cmdliner/src/cmdliner_cmd.mli new file mode 100644 index 00000000000..54da1535d8a --- /dev/null +++ b/vendor/cmdliner/src/cmdliner_cmd.mli @@ -0,0 +1,40 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2022 The cmdliner programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +(** Commands and their information. *) + +type info = Cmdliner_info.Cmd.t + +val info : + ?deprecated:string -> + ?man_xrefs:Cmdliner_manpage.xref list -> ?man:Cmdliner_manpage.block list -> + ?envs:Cmdliner_info.Env.info list -> ?exits:Cmdliner_info.Exit.info list -> + ?sdocs:string -> ?docs:string -> ?doc:string -> ?version:string -> + string -> info + +type 'a t = +| Cmd of info * 'a Cmdliner_term.parser +| Group of info * ('a Cmdliner_term.parser option * 'a t list) + +val v : info -> 'a Cmdliner_term.t -> 'a t +val group : ?default:'a Cmdliner_term.t -> info -> 'a t list -> 'a t +val name : 'a t -> string +val get_info : 'a t -> info + +(*--------------------------------------------------------------------------- + Copyright (c) 2022 The cmdliner programmers + + Permission to use, copy, modify, and/or distribute this software for any + purpose with or without fee is hereby granted, provided that the above + copyright notice and this permission notice appear in all copies. + + THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + ---------------------------------------------------------------------------*) diff --git a/vendor/cmdliner/src/cmdliner_docgen.ml b/vendor/cmdliner/src/cmdliner_docgen.ml index 80cf9f075dc..d452ae830a0 100644 --- a/vendor/cmdliner/src/cmdliner_docgen.ml +++ b/vendor/cmdliner/src/cmdliner_docgen.ml @@ -1,14 +1,31 @@ (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli. All rights reserved. + Copyright (c) 2011 The cmdliner programmers. All rights reserved. Distributed under the ISC license, see terms at the end of the file. - cmdliner v1.0.4-31-gb5d6161 ---------------------------------------------------------------------------*) let rev_compare n0 n1 = compare n1 n0 let strf = Printf.sprintf +let order_args a0 a1 = + match Cmdliner_info.Arg.is_opt a0, Cmdliner_info.Arg.is_opt a1 with + | true, true -> (* optional by name *) + let key names = + let k = List.hd (List.sort rev_compare names) in + let k = String.lowercase_ascii k in + if k.[1] = '-' then String.sub k 1 (String.length k - 1) else k + in + compare + (key @@ Cmdliner_info.Arg.opt_names a0) + (key @@ Cmdliner_info.Arg.opt_names a1) + | false, false -> (* positional by variable *) + compare + (String.lowercase_ascii @@ Cmdliner_info.Arg.docv a0) + (String.lowercase_ascii @@ Cmdliner_info.Arg.docv a1) + | true, false -> -1 (* positional first *) + | false, true -> 1 (* optional after *) + let esc = Cmdliner_manpage.escape -let term_name t = esc @@ Cmdliner_info.term_name t +let cmd_name t = esc @@ Cmdliner_info.Cmd.name t let sorted_items_to_blocks ~boilerplate:b items = (* Items are sorted by section and then rev. sorted by appearance. @@ -31,87 +48,117 @@ let sorted_items_to_blocks ~boilerplate:b items = (* Doc string variables substitutions. *) let env_info_subst ~subst e = function -| "env" -> Some (strf "$(b,%s)" @@ esc (Cmdliner_info.env_var e)) +| "env" -> Some (strf "$(b,%s)" @@ esc (Cmdliner_info.Env.info_var e)) | id -> subst id let exit_info_subst ~subst e = function -| "status" -> Some (strf "%d" (fst @@ Cmdliner_info.exit_statuses e)) -| "status_max" -> Some (strf "%d" (snd @@ Cmdliner_info.exit_statuses e)) +| "status" -> Some (strf "%d" (fst @@ Cmdliner_info.Exit.info_codes e)) +| "status_max" -> Some (strf "%d" (snd @@ Cmdliner_info.Exit.info_codes e)) | id -> subst id let arg_info_subst ~subst a = function | "docv" -> - Some (strf "$(i,%s)" @@ esc (Cmdliner_info.arg_docv a)) -| "opt" when Cmdliner_info.arg_is_opt a -> - Some (strf "$(b,%s)" @@ esc (Cmdliner_info.arg_opt_name_sample a)) + Some (strf "$(i,%s)" @@ esc (Cmdliner_info.Arg.docv a)) +| "opt" when Cmdliner_info.Arg.is_opt a -> + Some (strf "$(b,%s)" @@ esc (Cmdliner_info.Arg.opt_name_sample a)) | "env" as id -> - begin match Cmdliner_info.arg_env a with + begin match Cmdliner_info.Arg.env a with | Some e -> env_info_subst ~subst e id | None -> subst id end | id -> subst id -let term_info_subst ei = function -| "tname" -> Some (strf "$(b,%s)" @@ term_name (Cmdliner_info.eval_term ei)) -| "mname" -> Some (strf "$(b,%s)" @@ term_name (Cmdliner_info.eval_main ei)) +let cmd_info_subst ei = function +| "tname" -> Some (strf "$(b,%s)" @@ cmd_name (Cmdliner_info.Eval.cmd ei)) +| "mname" -> Some (strf "$(b,%s)" @@ cmd_name (Cmdliner_info.Eval.main ei)) | _ -> None (* Command docs *) -let invocation ?(sep = ' ') ei = match Cmdliner_info.eval_kind ei with -| `Simple | `Multiple_main -> term_name (Cmdliner_info.eval_main ei) -| `Multiple_group -| `Multiple_sub -> - let sep = String.make 1 sep in - Cmdliner_info.eval_terms_rev ei - |> List.rev_map Cmdliner_info.term_name - |> String.concat sep - |> strf "%s" - -let plain_invocation ei = invocation ei -let invocation ?sep ei = esc @@ invocation ?sep ei +let invocation ?(sep = " ") ?(parents = []) cmd = + let names = List.rev_map Cmdliner_info.Cmd.name (cmd :: parents) in + esc @@ String.concat sep names let synopsis_pos_arg a = - let v = match Cmdliner_info.arg_docv a with "" -> "ARG" | v -> v in + let v = match Cmdliner_info.Arg.docv a with "" -> "ARG" | v -> v in let v = strf "$(i,%s)" (esc v) in - let v = (if Cmdliner_info.arg_is_req a then strf "%s" else strf "[%s]") v in - match Cmdliner_info.(pos_len @@ arg_pos a) with - | None -> v ^ "..." + let v = (if Cmdliner_info.Arg.is_req a then strf "%s" else strf "[%s]") v in + match Cmdliner_info.Arg.(pos_len @@ pos_kind a) with + | None -> v ^ "…" | Some 1 -> v | Some n -> let rec loop n acc = if n <= 0 then acc else loop (n - 1) (v :: acc) in String.concat " " (loop n []) -let synopsis ei = match Cmdliner_info.eval_kind ei with -| `Multiple_main -> strf "$(b,%s) $(i,COMMAND) ..." @@ invocation ei -| `Multiple_group -| `Simple | `Multiple_sub -> +let synopsis_opt_arg a n = + let var = match Cmdliner_info.Arg.docv a with "" -> "VAL" | v -> v in + match Cmdliner_info.Arg.opt_kind a with + | Cmdliner_info.Arg.Flag -> strf "$(b,%s)" (esc n) + | Cmdliner_info.Arg.Opt -> + if String.length n > 2 + then strf "$(b,%s)=$(i,%s)" (esc n) (esc var) + else strf "$(b,%s) $(i,%s)" (esc n) (esc var) + | Cmdliner_info.Arg.Opt_vopt _ -> + if String.length n > 2 + then strf "$(b,%s)[=$(i,%s)]" (esc n) (esc var) + else strf "$(b,%s) [$(i,%s)]" (esc n) (esc var) + +let deprecated cmd = match Cmdliner_info.Cmd.deprecated cmd with +| None -> "" | Some _ -> "(Deprecated) " + +let synopsis ?parents cmd = match Cmdliner_info.Cmd.children cmd with +| [] -> let rev_cli_order (a0, _) (a1, _) = - Cmdliner_info.rev_arg_pos_cli_order a0 a1 + Cmdliner_info.Arg.rev_pos_cli_order a0 a1 + in + let args = Cmdliner_info.Cmd.args cmd in + let oargs, pargs = Cmdliner_info.Arg.(Set.partition is_opt args) in + let oargs = + (* Keep only those that are listed in the s_options section and + that are not [--version] or [--help]. * *) + let keep a = + let drop_names n = n = "--help" || n = "--version" in + Cmdliner_info.Arg.docs a = Cmdliner_manpage.s_options && + not (List.exists drop_names (Cmdliner_info.Arg.opt_names a)) + in + let oargs = Cmdliner_info.Arg.Set.(elements (filter keep oargs)) in + let count = List.length oargs in + let any_option = "[$(i,OPTION)]…" in + if count = 0 || count > 3 then any_option else + let syn a = + strf "[%s]" (synopsis_opt_arg a (Cmdliner_info.Arg.opt_name_sample a)) + in + let oargs = List.sort order_args oargs in + let oargs = String.concat " " (List.map syn oargs) in + String.concat " " [oargs; any_option] + in + let pargs = + let pargs = Cmdliner_info.Arg.Set.elements pargs in + if pargs = [] then "" else + let pargs = List.map (fun a -> a, synopsis_pos_arg a) pargs in + let pargs = List.sort rev_cli_order pargs in + String.concat " " ("" (* add a space *) :: List.rev_map snd pargs) in - let add_pos a acc = match Cmdliner_info.arg_is_opt a with - | true -> acc - | false -> (a, synopsis_pos_arg a) :: acc + strf "%s$(b,%s) %s%s" + (deprecated cmd) (invocation ?parents cmd) oargs pargs +| _cmds -> + let subcmd = match Cmdliner_info.Cmd.has_args cmd with + | false -> "$(i,COMMAND)" | true -> "[$(i,COMMAND)]" in - let args = Cmdliner_info.(term_args @@ eval_term ei) in - let pargs = Cmdliner_info.Args.fold add_pos args [] in - let pargs = List.sort rev_cli_order pargs in - let pargs = String.concat " " (List.rev_map snd pargs) in - strf "$(b,%s) [$(i,OPTION)]... %s" (invocation ei) pargs - -let cmd_docs ei = match Cmdliner_info.eval_kind ei with -| `Simple | `Multiple_sub -> [] -| `Multiple_group -| `Multiple_main -> - let add_cmd acc t = - let cmd = strf "$(b,%s)" @@ term_name t in - (Cmdliner_info.term_docs t, `I (cmd, Cmdliner_info.term_doc t)) :: acc + strf "%s$(b,%s) %s …" (deprecated cmd) (invocation ?parents cmd) subcmd + +let cmd_docs ei = match Cmdliner_info.(Cmd.children (Eval.cmd ei)) with +| [] -> [] +| cmds -> + let add_cmd acc cmd = + let syn = synopsis cmd in + (Cmdliner_info.Cmd.docs cmd, `I (syn, Cmdliner_info.Cmd.doc cmd)) :: acc in let by_sec_by_rev_name (s0, `I (c0, _)) (s1, `I (c1, _)) = let c = compare s0 s1 in if c <> 0 then c else compare c1 c0 (* N.B. reverse *) in - let cmds = List.fold_left add_cmd [] (Cmdliner_info.eval_choices ei) in + let cmds = List.fold_left add_cmd [] cmds in let cmds = List.sort by_sec_by_rev_name cmds in let cmds = (cmds :> (string * Cmdliner_manpage.block) list) in sorted_items_to_blocks ~boilerplate:None cmds @@ -119,42 +166,36 @@ let cmd_docs ei = match Cmdliner_info.eval_kind ei with (* Argument docs *) let arg_man_item_label a = - if Cmdliner_info.arg_is_pos a - then strf "$(i,%s)" (esc @@ Cmdliner_info.arg_docv a) else - let fmt_name var = match Cmdliner_info.arg_opt_kind a with - | Cmdliner_info.Flag -> fun n -> strf "$(b,%s)" (esc n) - | Cmdliner_info.Opt -> - fun n -> - if String.length n > 2 - then strf "$(b,%s)=$(i,%s)" (esc n) (esc var) - else strf "$(b,%s) $(i,%s)" (esc n) (esc var) - | Cmdliner_info.Opt_vopt _ -> - fun n -> - if String.length n > 2 - then strf "$(b,%s)[=$(i,%s)]" (esc n) (esc var) - else strf "$(b,%s) [$(i,%s)]" (esc n) (esc var) + let s = match Cmdliner_info.Arg.is_pos a with + | true -> strf "$(i,%s)" (esc @@ Cmdliner_info.Arg.docv a) + | false -> + let names = List.sort compare (Cmdliner_info.Arg.opt_names a) in + String.concat ", " (List.rev_map (synopsis_opt_arg a) names) in - let var = match Cmdliner_info.arg_docv a with "" -> "VAL" | v -> v in - let names = List.sort compare (Cmdliner_info.arg_opt_names a) in - let s = String.concat ", " (List.rev_map (fmt_name var) names) in - s + match Cmdliner_info.Arg.deprecated a with + | None -> s | Some _ -> "(Deprecated) " ^ s let arg_to_man_item ~errs ~subst ~buf a = - let or_env ~value a = match Cmdliner_info.arg_env a with + let subst = arg_info_subst ~subst a in + let or_env ~value a = match Cmdliner_info.Arg.env a with | None -> "" | Some e -> let value = if value then " or" else "absent " in - strf "%s $(b,%s) env" value (esc @@ Cmdliner_info.env_var e) + strf "%s $(b,%s) env" value (esc @@ Cmdliner_info.Env.info_var e) in - let absent = match Cmdliner_info.arg_absent a with - | Cmdliner_info.Err -> "required" - | Cmdliner_info.Val v -> + let absent = match Cmdliner_info.Arg.absent a with + | Cmdliner_info.Arg.Err -> "required" + | Cmdliner_info.Arg.Doc "" -> strf "%s" (or_env ~value:false a) + | Cmdliner_info.Arg.Doc s -> + let s = Cmdliner_manpage.subst_vars ~errs ~subst buf s in + strf "absent=%s%s" s (or_env ~value:true a) + | Cmdliner_info.Arg.Val v -> match Lazy.force v with | "" -> strf "%s" (or_env ~value:false a) - | v -> strf "absent=%s%s" (esc v) (or_env ~value:true a) + | v -> strf "absent=$(b,%s)%s" (esc v) (or_env ~value:true a) in - let optvopt = match Cmdliner_info.arg_opt_kind a with - | Cmdliner_info.Opt_vopt v -> strf "default=%s" v + let optvopt = match Cmdliner_info.Arg.opt_kind a with + | Cmdliner_info.Arg.Opt_vopt v -> strf "default=$(b,%s)" (esc v) | _ -> "" in let argvdoc = match optvopt, absent with @@ -162,38 +203,28 @@ let arg_to_man_item ~errs ~subst ~buf a = | s, "" | "", s -> strf " (%s)" s | s, s' -> strf " (%s) (%s)" s s' in - let subst = arg_info_subst ~subst a in - let doc = Cmdliner_info.arg_doc a in + let doc = Cmdliner_info.Arg.doc a in let doc = Cmdliner_manpage.subst_vars ~errs ~subst buf doc in - (Cmdliner_info.arg_docs a, `I (arg_man_item_label a ^ argvdoc, doc)) + (Cmdliner_info.Arg.docs a, `I (arg_man_item_label a ^ argvdoc, doc)) let arg_docs ~errs ~subst ~buf ei = let by_sec_by_arg a0 a1 = - let c = compare (Cmdliner_info.arg_docs a0) (Cmdliner_info.arg_docs a1) in + let c = compare (Cmdliner_info.Arg.docs a0) (Cmdliner_info.Arg.docs a1) in if c <> 0 then c else - match Cmdliner_info.arg_is_opt a0, Cmdliner_info.arg_is_opt a1 with - | true, true -> (* optional by name *) - let key names = - let k = List.hd (List.sort rev_compare names) in - let k = String.lowercase_ascii k in - if k.[1] = '-' then String.sub k 1 (String.length k - 1) else k - in - compare - (key @@ Cmdliner_info.arg_opt_names a0) - (key @@ Cmdliner_info.arg_opt_names a1) - | false, false -> (* positional by variable *) - compare - (String.lowercase_ascii @@ Cmdliner_info.arg_docv a0) - (String.lowercase_ascii @@ Cmdliner_info.arg_docv a1) - | true, false -> -1 (* positional first *) - | false, true -> 1 (* optional after *) + let c = + match Cmdliner_info.Arg.deprecated a0, Cmdliner_info.Arg.deprecated a1 + with + | None, None | Some _, Some _ -> 0 + | None, Some _ -> -1 | Some _, None -> 1 + in + if c <> 0 then c else order_args a0 a1 in let keep_arg a acc = - if not Cmdliner_info.(arg_is_pos a && (arg_docv a = "" || arg_doc a = "")) + if not Cmdliner_info.Arg.(is_pos a && (docv a = "" || doc a = "")) then (a :: acc) else acc in - let args = Cmdliner_info.(term_args @@ eval_term ei) in - let args = Cmdliner_info.Args.fold keep_arg args [] in + let args = Cmdliner_info.Cmd.args @@ Cmdliner_info.Eval.cmd ei in + let args = Cmdliner_info.Arg.Set.fold keep_arg args [] in let args = List.sort by_sec_by_arg args in let args = List.rev_map (arg_to_man_item ~errs ~subst ~buf) args in sorted_items_to_blocks ~boilerplate:None args @@ -208,14 +239,14 @@ let exit_docs ~errs ~subst ~buf ~has_sexit ei = let by_sec (s0, _) (s1, _) = compare s0 s1 in let add_exit_item acc e = let subst = exit_info_subst ~subst e in - let min, max = Cmdliner_info.exit_statuses e in - let doc = Cmdliner_info.exit_doc e in + let min, max = Cmdliner_info.Exit.info_codes e in + let doc = Cmdliner_info.Exit.info_doc e in let label = if min = max then strf "%d" min else strf "%d-%d" min max in let item = `I (label, Cmdliner_manpage.subst_vars ~errs ~subst buf doc) in - Cmdliner_info.(exit_docs e, item) :: acc + (Cmdliner_info.Exit.info_docs e, item) :: acc in - let exits = Cmdliner_info.(term_exits @@ eval_term ei) in - let exits = List.sort Cmdliner_info.exit_order exits in + let exits = Cmdliner_info.Cmd.exits @@ Cmdliner_info.Eval.cmd ei in + let exits = List.sort Cmdliner_info.Exit.info_order exits in let exits = List.fold_left add_exit_item [] exits in let exits = List.stable_sort by_sec (* sort by section *) exits in let boilerplate = if has_sexit then None else Some exit_boilerplate in @@ -229,15 +260,17 @@ let env_boilerplate sec = match sec = Cmdliner_manpage.s_environment with let env_docs ~errs ~subst ~buf ~has_senv ei = let add_env_item ~subst (seen, envs as acc) e = - if Cmdliner_info.Envs.mem e seen then acc else - let seen = Cmdliner_info.Envs.add e seen in - let var = strf "$(b,%s)" @@ esc (Cmdliner_info.env_var e) in - let doc = Cmdliner_info.env_doc e in + if Cmdliner_info.Env.Set.mem e seen then acc else + let seen = Cmdliner_info.Env.Set.add e seen in + let var = strf "$(b,%s)" @@ esc (Cmdliner_info.Env.info_var e) in + let var = match Cmdliner_info.Env.info_deprecated e with + | None -> var | Some _ -> "(Deprecated) " ^ var in + let doc = Cmdliner_info.Env.info_doc e in let doc = Cmdliner_manpage.subst_vars ~errs ~subst buf doc in - let envs = (Cmdliner_info.env_docs e, `I (var, doc)) :: envs in + let envs = (Cmdliner_info.Env.info_docs e, `I (var, doc)) :: envs in seen, envs in - let add_arg_env a acc = match Cmdliner_info.arg_env a with + let add_arg_env a acc = match Cmdliner_info.Arg.env a with | None -> acc | Some e -> add_env_item ~subst:(arg_info_subst ~subst a) acc e in @@ -248,10 +281,10 @@ let env_docs ~errs ~subst ~buf ~has_senv ei = in (* Arg envs before term envs is important here: if the same is mentioned both in an arg and in a term the substs of the arg are allowed. *) - let args = Cmdliner_info.(term_args @@ eval_term ei) in - let tenvs = Cmdliner_info.(term_envs @@ eval_term ei) in - let init = Cmdliner_info.Envs.empty, [] in - let acc = Cmdliner_info.Args.fold add_arg_env args init in + let args = Cmdliner_info.Cmd.args @@ Cmdliner_info.Eval.cmd ei in + let tenvs = Cmdliner_info.Cmd.envs @@ Cmdliner_info.Eval.cmd ei in + let init = Cmdliner_info.Env.Set.empty, [] in + let acc = Cmdliner_info.Arg.Set.fold add_arg_env args init in let _, envs = List.fold_left add_env acc tenvs in let envs = List.sort by_sec_by_rev_name envs in let envs = (envs :> (string * Cmdliner_manpage.block) list) in @@ -261,17 +294,25 @@ let env_docs ~errs ~subst ~buf ~has_senv ei = (* xref doc *) let xref_docs ~errs ei = - let main = Cmdliner_info.(term_name @@ eval_main ei) in + let main = Cmdliner_info.Eval.main ei in let to_xref = function - | `Main -> main, 1 + | `Main -> Cmdliner_info.Cmd.name main, 1 | `Tool tool -> tool, 1 | `Page (name, sec) -> name, sec | `Cmd c -> - if Cmdliner_info.eval_has_choice ei c then strf "%s-%s" main c, 1 else - (Format.fprintf errs "xref %s: no such term name@." c; "doc-err", 0) + (* N.B. we are handling only the first subcommand level here *) + let cmds = Cmdliner_info.Cmd.children main in + let mname = Cmdliner_info.Cmd.name main in + let is_cmd cmd = Cmdliner_info.Cmd.name cmd = c in + if List.exists is_cmd cmds then strf "%s-%s" mname c, 1 else + (Format.fprintf errs "xref %s: no such command name@." c; "doc-err", 0) in let xref_str (name, sec) = strf "%s(%d)" (esc name) sec in - let xrefs = Cmdliner_info.(term_man_xrefs @@ eval_term ei) in + let xrefs = Cmdliner_info.Cmd.man_xrefs @@ Cmdliner_info.Eval.cmd ei in + let xrefs = match main == Cmdliner_info.Eval.cmd ei with + | true -> List.filter (fun x -> x <> `Main) xrefs (* filter out default *) + | false -> xrefs + in let xrefs = List.fold_left (fun acc x -> to_xref x :: acc) [] xrefs in let xrefs = List.(rev_map xref_str (sort rev_compare xrefs)) in if xrefs = [] then [] else @@ -280,24 +321,28 @@ let xref_docs ~errs ei = (* Man page construction *) let ensure_s_name ei sm = - if Cmdliner_manpage.(smap_has_section sm s_name) then sm else - let tname = invocation ~sep:'-' ei in - let tdoc = Cmdliner_info.(term_doc @@ eval_term ei) in + if Cmdliner_manpage.(smap_has_section sm ~sec:s_name) then sm else + let cmd = Cmdliner_info.Eval.cmd ei in + let parents = Cmdliner_info.Eval.parents ei in + let tname = (deprecated cmd) ^ invocation ~sep:"-" ~parents cmd in + let tdoc = Cmdliner_info.Cmd.doc cmd in let tagline = if tdoc = "" then "" else strf " - %s" tdoc in let tagline = `P (strf "%s%s" tname tagline) in Cmdliner_manpage.(smap_append_block sm ~sec:s_name tagline) let ensure_s_synopsis ei sm = if Cmdliner_manpage.(smap_has_section sm ~sec:s_synopsis) then sm else - let synopsis = `P (synopsis ei) in + let cmd = Cmdliner_info.Eval.cmd ei in + let parents = Cmdliner_info.Eval.parents ei in + let synopsis = `P (synopsis ~parents cmd) in Cmdliner_manpage.(smap_append_block sm ~sec:s_synopsis synopsis) -let insert_term_man_docs ~errs ei sm = +let insert_cmd_man_docs ~errs ei sm = let buf = Buffer.create 200 in - let subst = term_info_subst ei in - let ins sm (s, b) = Cmdliner_manpage.smap_append_block sm s b in - let has_senv = Cmdliner_manpage.(smap_has_section sm s_environment) in - let has_sexit = Cmdliner_manpage.(smap_has_section sm s_exit_status) in + let subst = cmd_info_subst ei in + let ins sm (sec, b) = Cmdliner_manpage.smap_append_block sm ~sec b in + let has_senv = Cmdliner_manpage.(smap_has_section sm ~sec:s_environment) in + let has_sexit = Cmdliner_manpage.(smap_has_section sm ~sec:s_exit_status) in let sm = List.fold_left ins sm (cmd_docs ei) in let sm = List.fold_left ins sm (arg_docs ~errs ~subst ~buf ei) in let sm = List.fold_left ins sm (exit_docs ~errs ~subst ~buf ~has_sexit ei)in @@ -306,20 +351,22 @@ let insert_term_man_docs ~errs ei sm = sm let text ~errs ei = - let man = Cmdliner_info.(term_man @@ eval_term ei) in + let man = Cmdliner_info.Cmd.man @@ Cmdliner_info.Eval.cmd ei in let sm = Cmdliner_manpage.smap_of_blocks man in let sm = ensure_s_name ei sm in let sm = ensure_s_synopsis ei sm in - let sm = insert_term_man_docs ei ~errs sm in + let sm = insert_cmd_man_docs ei ~errs sm in Cmdliner_manpage.smap_to_blocks sm let title ei = - let main = Cmdliner_info.eval_main ei in - let exec = String.capitalize_ascii (Cmdliner_info.term_name main) in - let name = String.uppercase_ascii (invocation ~sep:'-' ei) in + let main = Cmdliner_info.Eval.main ei in + let exec = String.capitalize_ascii (Cmdliner_info.Cmd.name main) in + let cmd = Cmdliner_info.Eval.cmd ei in + let parents = Cmdliner_info.Eval.parents ei in + let name = String.uppercase_ascii (invocation ~sep:"-" ~parents cmd) in let center_header = esc @@ strf "%s Manual" exec in let left_footer = - let version = match Cmdliner_info.term_version main with + let version = match Cmdliner_info.Cmd.version main with | None -> "" | Some v -> " " ^ v in esc @@ strf "%s%s" exec version @@ -330,18 +377,21 @@ let man ~errs ei = title ei, text ~errs ei let pp_man ~errs fmt ppf ei = Cmdliner_manpage.print - ~errs ~subst:(term_info_subst ei) fmt ppf (man ~errs ei) + ~errs ~subst:(cmd_info_subst ei) fmt ppf (man ~errs ei) (* Plain synopsis for usage *) let pp_plain_synopsis ~errs ppf ei = let buf = Buffer.create 100 in - let subst = term_info_subst ei in - let syn = Cmdliner_manpage.doc_to_plain ~errs ~subst buf (synopsis ei) in + let subst = cmd_info_subst ei in + let cmd = Cmdliner_info.Eval.cmd ei in + let parents = Cmdliner_info.Eval.parents ei in + let synopsis = synopsis ~parents cmd in + let syn = Cmdliner_manpage.doc_to_plain ~errs ~subst buf synopsis in Format.fprintf ppf "@[%s@]" syn (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli + Copyright (c) 2011 The cmdliner programmers Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above diff --git a/vendor/cmdliner/src/cmdliner_docgen.mli b/vendor/cmdliner/src/cmdliner_docgen.mli index 59d473fe48e..826bfacae73 100644 --- a/vendor/cmdliner/src/cmdliner_docgen.mli +++ b/vendor/cmdliner/src/cmdliner_docgen.mli @@ -1,20 +1,17 @@ (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli. All rights reserved. + Copyright (c) 2011 The cmdliner programmers. All rights reserved. Distributed under the ISC license, see terms at the end of the file. - cmdliner v1.0.4-31-gb5d6161 ---------------------------------------------------------------------------*) -val plain_invocation : Cmdliner_info.eval -> string - val pp_man : errs:Format.formatter -> Cmdliner_manpage.format -> Format.formatter -> - Cmdliner_info.eval -> unit + Cmdliner_info.Eval.t -> unit val pp_plain_synopsis : - errs:Format.formatter -> Format.formatter -> Cmdliner_info.eval -> unit + errs:Format.formatter -> Format.formatter -> Cmdliner_info.Eval.t -> unit (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli + Copyright (c) 2011 The cmdliner programmers Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above diff --git a/vendor/cmdliner/src/cmdliner_eval.ml b/vendor/cmdliner/src/cmdliner_eval.ml new file mode 100644 index 00000000000..c3747bf8c39 --- /dev/null +++ b/vendor/cmdliner/src/cmdliner_eval.ml @@ -0,0 +1,292 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2022 The cmdliner programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +type 'a eval_ok = [ `Ok of 'a | `Version | `Help ] +type eval_error = [ `Parse | `Term | `Exn ] + +let err_help s = "Term error, help requested for unknown command " ^ s +let err_argv = "argv array must have at least one element" + +let add_stdopts ei = + let docs = Cmdliner_info.Cmd.stdopts_docs @@ Cmdliner_info.Eval.cmd ei in + let vargs, vers = + match Cmdliner_info.Cmd.version @@ Cmdliner_info.Eval.main ei with + | None -> Cmdliner_info.Arg.Set.empty, None + | Some _ -> + let args, _ as vers = Cmdliner_arg.stdopt_version ~docs in + args, Some vers + in + let help = Cmdliner_arg.stdopt_help ~docs in + let args = Cmdliner_info.Arg.Set.union vargs (fst help) in + let cmd = Cmdliner_info.Cmd.add_args (Cmdliner_info.Eval.cmd ei) args in + help, vers, Cmdliner_info.Eval.with_cmd ei cmd + +let parse_error_term err ei cl = Error (`Parse err) + +type 'a eval_result = + ('a, [ Cmdliner_term.term_escape + | `Exn of exn * Printexc.raw_backtrace + | `Parse of string + | `Std_help of Cmdliner_manpage.format | `Std_version ]) result + +let run_parser ~catch ei cl f = try (f ei cl :> 'a eval_result) with +| exn when catch -> + let bt = Printexc.get_raw_backtrace () in + Error (`Exn (exn, bt)) + +let try_eval_stdopts ~catch ei cl help version = + match run_parser ~catch ei cl (snd help) with + | Ok (Some fmt) -> Some (Error (`Std_help fmt)) + | Error _ as err -> Some err + | Ok None -> + match version with + | None -> None + | Some version -> + match run_parser ~catch ei cl (snd version) with + | Ok false -> None + | Ok true -> Some (Error (`Std_version)) + | Error _ as err -> Some err + +let do_help help_ppf err_ppf ei fmt cmd = + let ei = match cmd with + | None (* help of main command requested *) -> + let env _ = assert false in + let cmd = Cmdliner_info.Eval.main ei in + let ei' = Cmdliner_info.Eval.v ~cmd ~parents:[] ~env ~err_ppf in + begin match Cmdliner_info.Eval.parents ei with + | [] -> (* [ei] is an evaluation of main, [cmd] has stdopts *) ei' + | _ -> let _, _, ei = add_stdopts ei' in ei + end + | Some cmd -> + try + (* For now we simply keep backward compat. [cmd] should be + a name from main's children. *) + let main = Cmdliner_info.Eval.main ei in + let is_cmd t = Cmdliner_info.Cmd.name t = cmd in + let children = Cmdliner_info.Cmd.children main in + let cmd = List.find is_cmd children in + let _, _, ei = add_stdopts (Cmdliner_info.Eval.with_cmd ei cmd) in + ei + with Not_found -> invalid_arg (err_help cmd) + in + Cmdliner_docgen.pp_man ~errs:err_ppf fmt help_ppf ei + +let do_result help_ppf err_ppf ei = function +| Ok v -> Ok (`Ok v) +| Error res -> + match res with + | `Std_help fmt -> + Cmdliner_docgen.pp_man ~errs:err_ppf fmt help_ppf ei; Ok `Help + | `Std_version -> + Cmdliner_msg.pp_version help_ppf ei; Ok `Version + | `Parse err -> + Cmdliner_msg.pp_err_usage err_ppf ei ~err_lines:false ~err; + Error `Parse + | `Help (fmt, cmd) -> do_help help_ppf err_ppf ei fmt cmd; Ok `Help + | `Exn (e, bt) -> Cmdliner_msg.pp_backtrace err_ppf ei e bt; (Error `Exn) + | `Error (usage, err) -> + (if usage + then Cmdliner_msg.pp_err_usage err_ppf ei ~err_lines:true ~err + else Cmdliner_msg.pp_err err_ppf ei ~err); + (Error `Term) + +let cmd_name_trie cmds = + let add acc cmd = + let i = Cmdliner_cmd.get_info cmd in + let name = Cmdliner_info.Cmd.name i in + match Cmdliner_trie.add acc name cmd with + | `New t -> t + | `Replaced (cmd', _) -> + let i' = Cmdliner_cmd.get_info cmd' and kind = "command" in + invalid_arg @@ + Cmdliner_base.err_multi_def ~kind name Cmdliner_info.Cmd.doc i i' + in + List.fold_left add Cmdliner_trie.empty cmds + +let cmd_name_dom cmds = + let cmd_name c = Cmdliner_info.Cmd.name (Cmdliner_cmd.get_info c) in + List.sort String.compare (List.rev_map cmd_name cmds) + +let find_term args cmd = + let never_term _ _ = assert false in + let stop args_rest args_rev parents cmd = + let args = List.rev_append args_rev args_rest in + match (cmd : 'a Cmdliner_cmd.t) with + | Cmd (i, t) -> + args, t, i, parents, Ok () + | Group (i, (Some t, children)) -> + args, t, i, parents, Ok () + | Group (i, (None, children)) -> + let dom = cmd_name_dom children in + let err = Cmdliner_msg.err_cmd_missing ~dom in + args, never_term, i, parents, Error err + in + let rec loop args_rev parents cmd = function + | ("--" :: _ | [] as rest) -> stop rest args_rev parents cmd + | (arg :: _ as rest) when Cmdliner_cline.is_opt arg -> + stop rest args_rev parents cmd + | arg :: args -> + match cmd with + | Cmd (i, t) -> + let args = List.rev_append args_rev (arg :: args) in + args, t, i, parents, Ok () + | Group (i, (t, children)) -> + let index = cmd_name_trie children in + match Cmdliner_trie.find index arg with + | `Ok cmd -> loop args_rev (i :: parents) cmd args + | `Not_found -> + let args = List.rev_append args_rev (arg :: args) in + let all = Cmdliner_trie.ambiguities index "" in + let hints = Cmdliner_base.suggest arg all in + let dom = cmd_name_dom children in + let kind = "command" in + let err = Cmdliner_base.err_unknown ~kind ~dom ~hints arg in + args, never_term, i, parents, Error err + | `Ambiguous -> + let args = List.rev_append args_rev (arg :: args) in + let ambs = Cmdliner_trie.ambiguities index arg in + let ambs = List.sort compare ambs in + let err = Cmdliner_base.err_ambiguous ~kind:"command" arg ~ambs in + args, never_term, i, parents, Error err + in + loop [] [] cmd args + +let env_default v = try Some (Sys.getenv v) with Not_found -> None +let remove_exec argv = + try List.tl (Array.to_list argv) with Failure _ -> invalid_arg err_argv + +let do_deprecated_msgs err_ppf cl ei = + let cmd = Cmdliner_info.Eval.cmd ei in + let msgs = Cmdliner_cline.deprecated_msgs cl in + let msgs = match Cmdliner_info.Cmd.deprecated cmd with + | None -> msgs + | Some msg -> + let name = Cmdliner_base.quote (Cmdliner_info.Cmd.name cmd) in + String.concat "" ("command " :: name :: ": " :: msg :: []) :: msgs + in + if msgs <> [] + then Cmdliner_msg.pp_err err_ppf ei ~err:(String.concat "\n" msgs) + +let eval_value + ?help:(help_ppf = Format.std_formatter) + ?err:(err_ppf = Format.err_formatter) + ?(catch = true) ?(env = env_default) ?(argv = Sys.argv) cmd + = + let args, f, cmd, parents, res = find_term (remove_exec argv) cmd in + let ei = Cmdliner_info.Eval.v ~cmd ~parents ~env ~err_ppf in + let help, version, ei = add_stdopts ei in + let term_args = Cmdliner_info.Cmd.args @@ Cmdliner_info.Eval.cmd ei in + let res = match res with + | Error msg -> (* Command lookup error, we still prioritize stdargs *) + let cl = match Cmdliner_cline.create term_args args with + | Error (_, cl) -> cl | Ok cl -> cl + in + begin match try_eval_stdopts ~catch ei cl help version with + | Some e -> e + | None -> Error (`Error (true, msg)) + end + | Ok () -> + match Cmdliner_cline.create term_args args with + | Error (e, cl) -> + begin match try_eval_stdopts ~catch ei cl help version with + | Some e -> e + | None -> Error (`Error (true, e)) + end + | Ok cl -> + match try_eval_stdopts ~catch ei cl help version with + | Some e -> e + | None -> + do_deprecated_msgs err_ppf cl ei; + run_parser ~catch ei cl f + in + do_result help_ppf err_ppf ei res + +let eval_peek_opts + ?(version_opt = false) ?(env = env_default) ?(argv = Sys.argv) t + : 'a option * ('a eval_ok, eval_error) result + = + let args, f = t in + let version = if version_opt then Some "dummy" else None in + let cmd = Cmdliner_info.Cmd.v ?version "dummy" in + let cmd = Cmdliner_info.Cmd.add_args cmd args in + let null_ppf = Format.make_formatter (fun _ _ _ -> ()) (fun () -> ()) in + let ei = Cmdliner_info.Eval.v ~cmd ~parents:[] ~env ~err_ppf:null_ppf in + let help, version, ei = add_stdopts ei in + let term_args = Cmdliner_info.Cmd.args @@ Cmdliner_info.Eval.cmd ei in + let cli_args = remove_exec argv in + let v, ret = + match Cmdliner_cline.create ~peek_opts:true term_args cli_args with + | Error (e, cl) -> + begin match try_eval_stdopts ~catch:true ei cl help version with + | Some e -> None, e + | None -> None, Error (`Error (true, e)) + end + | Ok cl -> + let ret = run_parser ~catch:true ei cl f in + let v = match ret with Ok v -> Some v | Error _ -> None in + match try_eval_stdopts ~catch:true ei cl help version with + | Some e -> v, e + | None -> v, ret + in + let ret = match ret with + | Ok v -> Ok (`Ok v) + | Error `Std_help _ -> Ok `Help + | Error `Std_version -> Ok `Version + | Error `Parse _ -> Error `Parse + | Error `Help _ -> Ok `Help + | Error `Exn _ -> Error `Exn + | Error `Error _ -> Error `Term + in + (v, ret) + +let exit_status_of_result ?(term_err = Cmdliner_info.Exit.cli_error) = function +| Ok (`Ok _ | `Help | `Version) -> Cmdliner_info.Exit.ok +| Error `Term -> term_err +| Error `Parse -> Cmdliner_info.Exit.cli_error +| Error `Exn -> Cmdliner_info.Exit.internal_error + +let eval ?help ?err ?catch ?env ?argv ?term_err cmd = + exit_status_of_result ?term_err @@ + eval_value ?help ?err ?catch ?env ?argv cmd + +let eval' ?help ?err ?catch ?env ?argv ?term_err cmd = + match eval_value ?help ?err ?catch ?env ?argv cmd with + | Ok (`Ok c) -> c + | r -> exit_status_of_result ?term_err r + +let pp_err ppf cmd ~msg = (* FIXME move that to Cmdliner_msgs *) + let name = Cmdliner_cmd.name cmd in + Format.fprintf ppf "%s: @[%a@]@." name Cmdliner_base.pp_lines msg + +let eval_result + ?help ?(err = Format.err_formatter) ?catch ?env ?argv ?term_err cmd + = + match eval_value ?help ~err ?catch ?env ?argv cmd with + | Ok (`Ok (Error msg)) -> pp_err err cmd ~msg; Cmdliner_info.Exit.some_error + | r -> exit_status_of_result ?term_err r + +let eval_result' + ?help ?(err = Format.err_formatter) ?catch ?env ?argv ?term_err cmd + = + match eval_value ?help ~err ?catch ?env ?argv cmd with + | Ok (`Ok (Ok c)) -> c + | Ok (`Ok (Error msg)) -> pp_err err cmd ~msg; Cmdliner_info.Exit.some_error + | r -> exit_status_of_result ?term_err r + +(*--------------------------------------------------------------------------- + Copyright (c) 2022 The cmdliner programmers + + Permission to use, copy, modify, and/or distribute this software for any + purpose with or without fee is hereby granted, provided that the above + copyright notice and this permission notice appear in all copies. + + THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + ---------------------------------------------------------------------------*) diff --git a/vendor/cmdliner/src/cmdliner_eval.mli b/vendor/cmdliner/src/cmdliner_eval.mli new file mode 100644 index 00000000000..18746d96fb6 --- /dev/null +++ b/vendor/cmdliner/src/cmdliner_eval.mli @@ -0,0 +1,60 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2022 The cmdliner programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +(** Command evaluation *) + +(** {1:eval Evaluating commands} *) + +type 'a eval_ok = [ `Ok of 'a | `Version | `Help ] +type eval_error = [ `Parse | `Term | `Exn ] + +val eval_value : + ?help:Format.formatter -> ?err:Format.formatter -> ?catch:bool -> + ?env:(string -> string option) -> ?argv:string array -> 'a Cmdliner_cmd.t -> + ('a eval_ok, eval_error) result + +val eval_peek_opts : + ?version_opt:bool -> ?env:(string -> string option) -> + ?argv:string array -> 'a Cmdliner_term.t -> + 'a option * ('a eval_ok, eval_error) result + +val eval : + ?help:Format.formatter -> ?err:Format.formatter -> ?catch:bool -> + ?env:(string -> string option) -> ?argv:string array -> + ?term_err:int -> unit Cmdliner_cmd.t -> Cmdliner_info.Exit.code + +val eval' : + ?help:Format.formatter -> ?err:Format.formatter -> ?catch:bool -> + ?env:(string -> string option) -> ?argv:string array -> + ?term_err:int -> int Cmdliner_cmd.t -> Cmdliner_info.Exit.code + +val eval_result : + ?help:Format.formatter -> ?err:Format.formatter -> ?catch:bool -> + ?env:(string -> string option) -> ?argv:string array -> + ?term_err:Cmdliner_info.Exit.code -> (unit, string) result Cmdliner_cmd.t -> + Cmdliner_info.Exit.code + +val eval_result' : + ?help:Format.formatter -> ?err:Format.formatter -> ?catch:bool -> + ?env:(string -> string option) -> ?argv:string array -> + ?term_err:Cmdliner_info.Exit.code -> + (Cmdliner_info.Exit.code, string) result Cmdliner_cmd.t -> + Cmdliner_info.Exit.code + +(*--------------------------------------------------------------------------- + Copyright (c) 2022 The cmdliner programmers + + Permission to use, copy, modify, and/or distribute this software for any + purpose with or without fee is hereby granted, provided that the above + copyright notice and this permission notice appear in all copies. + + THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + ---------------------------------------------------------------------------*) diff --git a/vendor/cmdliner/src/cmdliner_suggest.mli b/vendor/cmdliner/src/cmdliner_exit.ml similarity index 80% rename from vendor/cmdliner/src/cmdliner_suggest.mli rename to vendor/cmdliner/src/cmdliner_exit.ml index 189bc94c081..5a9fe7928dc 100644 --- a/vendor/cmdliner/src/cmdliner_suggest.mli +++ b/vendor/cmdliner/src/cmdliner_exit.ml @@ -1,15 +1,11 @@ (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli. All rights reserved. + Copyright (c) 2011 The cmdliner programmers. All rights reserved. Distributed under the ISC license, see terms at the end of the file. - cmdliner v1.0.4-31-gb5d6161 ---------------------------------------------------------------------------*) -val value : string -> string list -> string list -(** [value near candidates] suggests values from [candidates] - not to far from near. *) (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli + Copyright (c) 2011 The cmdliner programmers Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above diff --git a/vendor/cmdliner/src/cmdliner_exit.mli b/vendor/cmdliner/src/cmdliner_exit.mli new file mode 100644 index 00000000000..5a9fe7928dc --- /dev/null +++ b/vendor/cmdliner/src/cmdliner_exit.mli @@ -0,0 +1,21 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2011 The cmdliner programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + + +(*--------------------------------------------------------------------------- + Copyright (c) 2011 The cmdliner programmers + + Permission to use, copy, modify, and/or distribute this software for any + purpose with or without fee is hereby granted, provided that the above + copyright notice and this permission notice appear in all copies. + + THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + ---------------------------------------------------------------------------*) diff --git a/vendor/cmdliner/src/cmdliner_info.ml b/vendor/cmdliner/src/cmdliner_info.ml index 64b8fb28b3d..87dec769f69 100644 --- a/vendor/cmdliner/src/cmdliner_info.ml +++ b/vendor/cmdliner/src/cmdliner_info.ml @@ -1,258 +1,237 @@ (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli. All rights reserved. + Copyright (c) 2011 The cmdliner programmers. All rights reserved. Distributed under the ISC license, see terms at the end of the file. - cmdliner v1.0.4-31-gb5d6161 ---------------------------------------------------------------------------*) +(* Exit codes *) + +module Exit = struct + type code = int + + let ok = 0 + let some_error = 123 + let cli_error = 124 + let internal_error = 125 + + type info = + { codes : code * code; (* min, max *) + doc : string; (* help. *) + docs : string; } (* title of help section where listed. *) + + let info + ?(docs = Cmdliner_manpage.s_exit_status) ?(doc = "undocumented") ?max min + = + let max = match max with None -> min | Some max -> max in + { codes = (min, max); doc; docs } + + let info_codes i = i.codes + let info_code i = fst i.codes + let info_doc i = i.doc + let info_docs i = i.docs + let info_order i0 i1 = compare i0.codes i1.codes + let defaults = + [ info ok ~doc:"on success."; + info some_error + ~doc:"on indiscriminate errors reported on standard error."; + info cli_error ~doc:"on command line parsing errors."; + info internal_error ~doc:"on unexpected internal errors (bugs)."; ] +end -let new_id = (* thread-safe UIDs, Oo.id (object end) was used before. *) - let c = ref 0 in - fun () -> - let id = !c in - incr c; if id > !c then assert false (* too many ids *) else id - -(* Environments *) - -type env = (* information about an environment variable. *) - { env_id : int; (* unique id for the env var. *) - env_var : string; (* the variable. *) - env_doc : string; (* help. *) - env_docs : string; } (* title of help section where listed. *) - -let env - ?docs:(env_docs = Cmdliner_manpage.s_environment) - ?doc:(env_doc = "See option $(opt).") env_var = - { env_id = new_id (); env_var; env_doc; env_docs } - -let env_var e = e.env_var -let env_doc e = e.env_doc -let env_docs e = e.env_docs - +(* Environment variables *) module Env = struct - type t = env - let compare a0 a1 = (compare : int -> int -> int) a0.env_id a1.env_id + type var = string + type info = (* information about an environment variable. *) + { id : int; (* unique id for the env var. *) + deprecated : string option; + var : string; (* the variable. *) + doc : string; (* help. *) + docs : string; } (* title of help section where listed. *) + + let info + ?deprecated + ?(docs = Cmdliner_manpage.s_environment) ?(doc = "See option $(opt).") var + = + { id = Cmdliner_base.uid (); deprecated; var; doc; docs } + + let info_deprecated i = i.deprecated + let info_var i = i.var + let info_doc i = i.doc + let info_docs i = i.docs + let info_compare i0 i1 = Int.compare i0.id i1.id + + module Set = Set.Make (struct type t = info let compare = info_compare end) end -module Envs = Set.Make (Env) -type envs = Envs.t - (* Arguments *) -type arg_absence = Err | Val of string Lazy.t -type opt_kind = Flag | Opt | Opt_vopt of string - -type pos_kind = (* information about a positional argument. *) - { pos_rev : bool; (* if [true] positions are counted from the end. *) - pos_start : int; (* start positional argument. *) - pos_len : int option } (* number of arguments or [None] if unbounded. *) - -let pos ~rev:pos_rev ~start:pos_start ~len:pos_len = - { pos_rev; pos_start; pos_len} - -let pos_rev p = p.pos_rev -let pos_start p = p.pos_start -let pos_len p = p.pos_len - -type arg = (* information about a command line argument. *) - { id : int; (* unique id for the argument. *) - absent : arg_absence; (* behaviour if absent. *) - env : env option; (* environment variable. *) - doc : string; (* help. *) - docv : string; (* variable name for the argument in help. *) - docs : string; (* title of help section where listed. *) - pos : pos_kind; (* positional arg kind. *) - opt_kind : opt_kind; (* optional arg kind. *) - opt_names : string list; (* names (for opt args). *) - opt_all : bool; (* repeatable (for opt args). *) - opt_alias: string -> string option -> (string list, string) Result.t; - (* [opt_alias arg value], [arg] is the name of the argument, +module Arg = struct + type absence = Err | Val of string Lazy.t | Doc of string + type opt_kind = Flag | Opt | Opt_vopt of string + + type pos_kind = (* information about a positional argument. *) + { pos_rev : bool; (* if [true] positions are counted from the end. *) + pos_start : int; (* start positional argument. *) + pos_len : int option } (* number of arguments or [None] if unbounded. *) + + let pos ~rev:pos_rev ~start:pos_start ~len:pos_len = + { pos_rev; pos_start; pos_len} + + let pos_rev p = p.pos_rev + let pos_start p = p.pos_start + let pos_len p = p.pos_len + + type t = (* information about a command line argument. *) + { id : int; (* unique id for the argument. *) + deprecated : string option; (* deprecation message *) + absent : absence; (* behaviour if absent. *) + env : Env.info option; (* environment variable for default value. *) + doc : string; (* help. *) + docv : string; (* variable name for the argument in help. *) + docs : string; (* title of help section where listed. *) + pos : pos_kind; (* positional arg kind. *) + opt_kind : opt_kind; (* optional arg kind. *) + opt_names : string list; (* names (for opt args). *) + opt_all : bool; (* repeatable (for opt args). *) + opt_alias: string -> string option -> (string list, string) Result.t; (* [opt_alias arg value], [arg] is the name of the argument, and [value] is the possible value *) - } - -let dumb_pos = pos ~rev:false ~start:(-1) ~len:None - -let arg ?docs ?(docv = "") ?(doc = "") ?env names = - let dash n = if String.length n = 1 then "-" ^ n else "--" ^ n in - let opt_names = List.map dash names in - let docs = match docs with - | Some s -> s - | None -> - match names with - | [] -> Cmdliner_manpage.s_arguments - | _ -> Cmdliner_manpage.s_options - in - { id = new_id (); absent = Val (lazy ""); env; doc; docv; docs; - pos = dumb_pos; opt_kind = Flag; opt_names; opt_all = false; + } + + let dumb_pos = pos ~rev:false ~start:(-1) ~len:None + + let v ?deprecated ?(absent = "") ?docs ?(docv = "") ?(doc = "") ?env names = + let dash n = if String.length n = 1 then "-" ^ n else "--" ^ n in + let opt_names = List.map dash names in + let docs = match docs with + | Some s -> s + | None -> + match names with + | [] -> Cmdliner_manpage.s_arguments + | _ -> Cmdliner_manpage.s_options + in + { id = Cmdliner_base.uid (); deprecated; absent = Doc absent; + env; doc; docv; docs; pos = dumb_pos; opt_kind = Flag; opt_names; + opt_all = false; opt_alias = fun _ _ -> Ok [] } -let arg_id a = a.id -let arg_absent a = a.absent -let arg_env a = a.env -let arg_doc a = a.doc -let arg_docv a = a.docv -let arg_docs a = a.docs -let arg_pos a = a.pos -let arg_opt_kind a = a.opt_kind -let arg_opt_names a = a.opt_names -let arg_opt_all a = a.opt_all -let arg_opt_name_sample a = - (* First long or short name (in that order) in the list; this - allows the client to control which name is shown *) - let rec find = function - | [] -> List.hd a.opt_names - | n :: ns -> if (String.length n) > 2 then n else find ns - in - find a.opt_names -let arg_alias a = a.opt_alias - -let arg_make_req a = { a with absent = Err } -let arg_make_all_opts a = { a with opt_all = true } -let arg_make_opt ~absent ~kind:opt_kind a = { a with absent; opt_kind } -let arg_make_opt_all ~absent ~kind:opt_kind a = - { a with absent; opt_kind; opt_all = true } - -let arg_make_pos ~pos a = { a with pos } -let arg_make_pos_abs ~absent ~pos a = { a with absent; pos } -let arg_aliases ~aliases a = { a with opt_alias = aliases } - -let arg_is_opt a = a.opt_names <> [] -let arg_is_pos a = a.opt_names = [] -let arg_is_req a = a.absent = Err - -let arg_pos_cli_order a0 a1 = (* best-effort order on the cli. *) - let c = compare (a0.pos.pos_rev) (a1.pos.pos_rev) in - if c <> 0 then c else - if a0.pos.pos_rev - then compare a1.pos.pos_start a0.pos.pos_start - else compare a0.pos.pos_start a1.pos.pos_start - -let rev_arg_pos_cli_order a0 a1 = arg_pos_cli_order a1 a0 + let id a = a.id + let deprecated a = a.deprecated + let absent a = a.absent + let env a = a.env + let doc a = a.doc + let docv a = a.docv + let docs a = a.docs + let pos_kind a = a.pos + let opt_kind a = a.opt_kind + let opt_names a = a.opt_names + let opt_all a = a.opt_all + let opt_name_sample a = + (* First long or short name (in that order) in the list; this + allows the client to control which name is shown *) + let rec find = function + | [] -> List.hd a.opt_names + | n :: ns -> if (String.length n) > 2 then n else find ns + in + find a.opt_names + let alias a = a.opt_alias + + let make_req a = { a with absent = Err } + let make_all_opts a = { a with opt_all = true } + let make_opt ~absent ~kind:opt_kind a = { a with absent; opt_kind } + let make_opt_all ~absent ~kind:opt_kind a = + { a with absent; opt_kind; opt_all = true } + + let make_pos ~pos a = { a with pos } + let make_pos_abs ~absent ~pos a = { a with absent; pos } + let aliases ~aliases a = { a with opt_alias = aliases } + + let is_opt a = a.opt_names <> [] + let is_pos a = a.opt_names = [] + let is_req a = a.absent = Err + + let pos_cli_order a0 a1 = (* best-effort order on the cli. *) + let c = compare (a0.pos.pos_rev) (a1.pos.pos_rev) in + if c <> 0 then c else + if a0.pos.pos_rev + then compare a1.pos.pos_start a0.pos.pos_start + else compare a0.pos.pos_start a1.pos.pos_start + + let rev_pos_cli_order a0 a1 = pos_cli_order a1 a0 + + let compare a0 a1 = Int.compare a0.id a1.id + module Set = Set.Make (struct type nonrec t = t let compare = compare end) +end -module Arg = struct - type t = arg - let compare a0 a1 = (compare : int -> int -> int) a0.id a1.id +(* Commands *) + +module Cmd = struct + type t = + { name : string; (* name of the cmd. *) + version : string option; (* version (for --version). *) + deprecated : string option; (* deprecation message *) + doc : string; (* one line description of cmd. *) + docs : string; (* title of man section where listed (commands). *) + sdocs : string; (* standard options, title of section where listed. *) + exits : Exit.info list; (* exit codes for the cmd. *) + envs : Env.info list; (* env vars that influence the cmd. *) + man : Cmdliner_manpage.block list; (* man page text. *) + man_xrefs : Cmdliner_manpage.xref list; (* man cross-refs. *) + args : Arg.Set.t; (* Command arguments. *) + has_args : bool; (* [true] if has own parsing term. *) + children : t list; } (* Children, if any. *) + + let v + ?deprecated ?(man_xrefs = [`Main]) ?(man = []) ?(envs = []) + ?(exits = Exit.defaults) ?(sdocs = Cmdliner_manpage.s_common_options) + ?(docs = Cmdliner_manpage.s_commands) ?(doc = "") ?version name + = + { name; version; deprecated; doc; docs; sdocs; exits; + envs; man; man_xrefs; args = Arg.Set.empty; + has_args = true; children = [] } + + let name t = t.name + let version t = t.version + let deprecated t = t.deprecated + let doc t = t.doc + let docs t = t.docs + let stdopts_docs t = t.sdocs + let exits t = t.exits + let envs t = t.envs + let man t = t.man + let man_xrefs t = t.man_xrefs + let args t = t.args + let has_args t = t.has_args + let children t = t.children + let add_args t args = { t with args = Arg.Set.union args t.args } + let with_children cmd ~args ~children = + let has_args, args = match args with + | None -> false, cmd.args + | Some args -> true, Arg.Set.union args cmd.args + in + { cmd with has_args; args; children } end -module Args = Set.Make (Arg) -type args = Args.t - -(* Exit info *) - -type exit = - { exit_statuses : int * int; - exit_doc : string; - exit_docs : string; } - -let exit - ?docs:(exit_docs = Cmdliner_manpage.s_exit_status) - ?doc:(exit_doc = "undocumented") ?max min = - let max = match max with None -> min | Some max -> max in - { exit_statuses = (min, max); exit_doc; exit_docs } - -let exit_statuses e = e.exit_statuses -let exit_doc e = e.exit_doc -let exit_docs e = e.exit_docs -let exit_order e0 e1 = compare e0.exit_statuses e1.exit_statuses - -(* Term info *) - -type term_info = - { term_name : string; (* name of the term. *) - term_version : string option; (* version (for --version). *) - term_doc : string; (* one line description of term. *) - term_docs : string; (* title of man section where listed (commands). *) - term_sdocs : string; (* standard options, title of section where listed. *) - term_exits : exit list; (* exit codes for the term. *) - term_envs : env list; (* env vars that influence the term. *) - term_man : Cmdliner_manpage.block list; (* man page text. *) - term_man_xrefs : Cmdliner_manpage.xref list; } (* man cross-refs. *) - -type term = - { term_info : term_info; - term_args : args; } - -let term - ?args:(term_args = Args.empty) ?man_xrefs:(term_man_xrefs = []) - ?man:(term_man = []) ?envs:(term_envs = []) ?exits:(term_exits = []) - ?sdocs:(term_sdocs = Cmdliner_manpage.s_options) - ?docs:(term_docs = "COMMANDS") ?doc:(term_doc = "") ?version:term_version - term_name = - let term_info = - { term_name; term_version; term_doc; term_docs; term_sdocs; term_exits; - term_envs; term_man; term_man_xrefs } - in - { term_info; term_args } - -let term_name t = t.term_info.term_name -let term_version t = t.term_info.term_version -let term_doc t = t.term_info.term_doc -let term_docs t = t.term_info.term_docs -let term_stdopts_docs t = t.term_info.term_sdocs -let term_exits t = t.term_info.term_exits -let term_envs t = t.term_info.term_envs -let term_man t = t.term_info.term_man -let term_man_xrefs t = t.term_info.term_man_xrefs -let term_args t = t.term_args - -let term_add_args t args = - { t with term_args = Args.union args t.term_args } - -type eval_kind = -| Simple of term -| Main of { term : term ; choices : term list } -| Sub_command of { path : term list; - main : term; - sibling_terms : term list } - -(* Eval info *) - -type eval = (* information about the evaluation context. *) - { term : term; (* term being evaluated. *) - main : term; (* main term. *) - path : term list; - choices : term list; (* all term choices. *) - env : string -> string option } (* environment variable lookup. *) - -let eval ~env kind = - let (main, term, path, choices) = - match kind with - | Simple term -> (term, term, [term], []) - | Main { term ; choices } -> (term, term, [term], choices) - | Sub_command { main ; path ; sibling_terms } -> - let term = List.hd path in - (main, term, path, sibling_terms) - in - { term; main; choices; env; path } - -let eval_term e = e.term -let eval_main e = e.main -let eval_term_path e = e.path -let eval_choices e = e.choices -let eval_env_var e v = e.env v - -let eval_kind ei = - (* subgroup *) - if ei.choices = [] then `Simple else - if (ei.term.term_info.term_name == ei.main.term_info.term_name) - then - match ei.path with - | [] -> assert false - | [_] -> `Multiple_main - | _ :: _ :: _ -> `Multiple_group - else `Multiple_sub - -let eval_terms_rev ei = ei.path - -let eval_with_term ei term = { ei with term } - -let eval_has_choice e cmd = - (* handle subgroup *) - let is_cmd t = t.term_info.term_name = cmd in - List.exists is_cmd e.choices +(* Evaluation *) + +module Eval = struct + type t = (* information about the evaluation context. *) + { cmd : Cmd.t; (* cmd being evaluated. *) + parents : Cmd.t list; (* parents of cmd, root is last. *) + env : string -> string option; (* environment variable lookup. *) + err_ppf : Format.formatter (* error formatter *) } + + let v ~cmd ~parents ~env ~err_ppf = { cmd; parents; env; err_ppf } + + let cmd e = e.cmd + let parents e = e.parents + let env_var e v = e.env v + let err_ppf e = e.err_ppf + let main e = match List.rev e.parents with [] -> e.cmd | m :: _ -> m + let with_cmd ei cmd = { ei with cmd } +end (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli + Copyright (c) 2011 The cmdliner programmers Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above diff --git a/vendor/cmdliner/src/cmdliner_info.mli b/vendor/cmdliner/src/cmdliner_info.mli index 5a6668b0cc4..2b995a2f6db 100644 --- a/vendor/cmdliner/src/cmdliner_info.mli +++ b/vendor/cmdliner/src/cmdliner_info.mli @@ -1,138 +1,147 @@ (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli. All rights reserved. + Copyright (c) 2011 The cmdliner programmers. All rights reserved. Distributed under the ISC license, see terms at the end of the file. - cmdliner v1.0.4-31-gb5d6161 ---------------------------------------------------------------------------*) -(** Terms, argument, env vars information. - - The following types keep untyped information about arguments and - terms. This data is used to parse the command line, report errors - and format man pages. *) - -(** {1:env Environment variables} *) - -type env -val env : ?docs:string -> ?doc:string -> string -> env -val env_var : env -> string -val env_doc : env -> string -val env_docs : env -> string - -module Env : Set.OrderedType with type t = env -module Envs : Set.S with type elt = env -type envs = Envs.t - -(** {1:arg Arguments} *) - -type arg_absence = -| Err (** an error is reported. *) -| Val of string Lazy.t (** if <> "", takes the given default value. *) -(** The type for what happens if the argument is absent from the cli. *) - -type opt_kind = -| Flag (** without value, just a flag. *) -| Opt (** with required value. *) -| Opt_vopt of string (** with optional value, takes given default. *) -(** The type for optional argument kinds. *) - -type pos_kind -val pos : rev:bool -> start:int -> len:int option -> pos_kind -val pos_rev : pos_kind -> bool -val pos_start : pos_kind -> int -val pos_len : pos_kind -> int option - -type arg -val arg : - ?docs:string -> ?docv:string -> ?doc:string -> ?env:env -> - string list -> arg - -val arg_id : arg -> int -val arg_absent : arg -> arg_absence -val arg_env : arg -> env option -val arg_doc : arg -> string -val arg_docv : arg -> string -val arg_docs : arg -> string -val arg_opt_names : arg -> string list (* has dashes *) -val arg_opt_name_sample : arg -> string (* warning must be an opt arg *) -val arg_opt_kind : arg -> opt_kind -val arg_pos : arg -> pos_kind -val arg_alias : arg -> string -> string option -> (string list, string) Result.t - -val arg_make_req : arg -> arg -val arg_make_all_opts : arg -> arg -val arg_make_opt : absent:arg_absence -> kind:opt_kind -> arg -> arg -val arg_make_opt_all : absent:arg_absence -> kind:opt_kind -> arg -> arg -val arg_make_pos : pos:pos_kind -> arg -> arg -val arg_make_pos_abs : absent:arg_absence -> pos:pos_kind -> arg -> arg -val arg_aliases : aliases:(string -> string option -> (string list, string) Result.t) -> arg -> arg - -val arg_is_opt : arg -> bool -val arg_is_pos : arg -> bool -val arg_is_req : arg -> bool - -val arg_pos_cli_order : arg -> arg -> int -val rev_arg_pos_cli_order : arg -> arg -> int - -module Arg : Set.OrderedType with type t = arg -module Args : Set.S with type elt = arg -type args = Args.t - -(** {1:exit Exit status} *) - -type exit -val exit : ?docs:string -> ?doc:string -> ?max:int -> int -> exit -val exit_statuses : exit -> int * int -val exit_doc : exit -> string -val exit_docs : exit -> string -val exit_order : exit -> exit -> int - -(** {1:term Term information} *) - -type term - -val term : - ?args:args -> ?man_xrefs:Cmdliner_manpage.xref list -> - ?man:Cmdliner_manpage.block list -> ?envs:env list -> ?exits:exit list -> - ?sdocs:string -> ?docs:string -> ?doc:string -> ?version:string -> - string -> term - -val term_name : term -> string -val term_version : term -> string option -val term_doc : term -> string -val term_docs : term -> string -val term_stdopts_docs : term -> string -val term_exits : term -> exit list -val term_envs : term -> env list -val term_man : term -> Cmdliner_manpage.block list -val term_man_xrefs : term -> Cmdliner_manpage.xref list -val term_args : term -> args - -val term_add_args : term -> args -> term - -(** {1:eval Evaluation information} *) - -type eval - -type eval_kind = -| Simple of term -| Main of { term : term ; choices : term list } -| Sub_command of { path : term list; - main : term; - sibling_terms : term list } - -val eval : env:(string -> string option) -> eval_kind -> eval - -val eval_term : eval -> term -val eval_main : eval -> term -val eval_choices : eval -> term list -val eval_env_var : eval -> string -> string option -val eval_kind : eval -> [> `Multiple_main | `Multiple_group | `Multiple_sub | `Simple ] -val eval_with_term : eval -> term -> eval -val eval_has_choice : eval -> string -> bool -val eval_terms_rev : eval -> term list +(** Exit codes, environment variabes, arguments, commands and eval information. + + These information types gathers untyped data used to parse command + lines report errors and format man pages. *) + +(** Exit codes. *) +module Exit : sig + type code = int + val ok : code + val some_error : code + val cli_error : code + val internal_error : code + + type info + val info : ?docs:string -> ?doc:string -> ?max:code -> code -> info + val info_code : info -> code + val info_codes : info -> code * code + val info_doc : info -> string + val info_docs : info -> string + val info_order : info -> info -> int + val defaults : info list +end + +(** Environment variables. *) +module Env : sig + type var = string + type info + val info : ?deprecated:string -> ?docs:string -> ?doc:string -> var -> info + val info_var : info -> string + val info_doc : info -> string + val info_docs : info -> string + val info_deprecated : info -> string option + + module Set : Set.S with type elt = info +end + +(** Arguments *) +module Arg : sig + + type absence = + | Err (** an error is reported. *) + | Val of string Lazy.t (** if <> "", takes the given default value. *) + | Doc of string + (** if <> "", a doc string interpreted in the doc markup language. *) + (** The type for what happens if the argument is absent from the cli. *) + + type opt_kind = + | Flag (** without value, just a flag. *) + | Opt (** with required value. *) + | Opt_vopt of string (** with optional value, takes given default. *) + (** The type for optional argument kinds. *) + + type pos_kind + val pos : rev:bool -> start:int -> len:int option -> pos_kind + val pos_rev : pos_kind -> bool + val pos_start : pos_kind -> int + val pos_len : pos_kind -> int option + + type t + val v : + ?deprecated:string -> ?absent:string -> ?docs:string -> ?docv:string -> + ?doc:string -> ?env:Env.info -> string list -> t + + val id : t -> int + val deprecated : t -> string option + val absent : t -> absence + val env : t -> Env.info option + val doc : t -> string + val docv : t -> string + val docs : t -> string + val opt_names : t -> string list (* has dashes *) + val opt_name_sample : t -> string (* warning must be an opt arg *) + val opt_kind : t -> opt_kind + val pos_kind : t -> pos_kind + val alias : t -> string -> string option -> (string list, string) Result.t + + val make_req : t -> t + val make_all_opts : t -> t + val make_opt : absent:absence -> kind:opt_kind -> t -> t + val make_opt_all : absent:absence -> kind:opt_kind -> t -> t + val make_pos : pos:pos_kind -> t -> t + val make_pos_abs : absent:absence -> pos:pos_kind -> t -> t + val aliases : aliases:(string -> string option -> (string list, string) Result.t) -> t -> t + + val is_opt : t -> bool + val is_pos : t -> bool + val is_req : t -> bool + + val pos_cli_order : t -> t -> int + val rev_pos_cli_order : t -> t -> int + + val compare : t -> t -> int + module Set : Set.S with type elt = t +end + +(** Commands. *) +module Cmd : sig + type t + val v : + ?deprecated:string -> + ?man_xrefs:Cmdliner_manpage.xref list -> ?man:Cmdliner_manpage.block list -> + ?envs:Env.info list -> ?exits:Exit.info list -> + ?sdocs:string -> ?docs:string -> ?doc:string -> ?version:string -> + string -> t + + val name : t -> string + val version : t -> string option + val deprecated : t -> string option + val doc : t -> string + val docs : t -> string + val stdopts_docs : t -> string + val exits : t -> Exit.info list + val envs : t -> Env.info list + val man : t -> Cmdliner_manpage.block list + val man_xrefs : t -> Cmdliner_manpage.xref list + val args : t -> Arg.Set.t + val has_args : t -> bool + val children : t -> t list + val add_args : t -> Arg.Set.t -> t + val with_children : t -> args:Arg.Set.t option -> children:t list -> t +end + +(** Evaluation. *) +module Eval : sig + type t + val v : + cmd:Cmd.t -> parents:Cmd.t list -> env:(string -> string option) -> + err_ppf:Format.formatter -> t + + val cmd : t -> Cmd.t + val main : t -> Cmd.t + val parents : t -> Cmd.t list + val env_var : t -> string -> string option + val err_ppf : t -> Format.formatter + val with_cmd : t -> Cmd.t -> t +end (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli + Copyright (c) 2011 The cmdliner programmers Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above diff --git a/vendor/cmdliner/src/cmdliner_manpage.ml b/vendor/cmdliner/src/cmdliner_manpage.ml index 19160fcf6d5..699564cd282 100644 --- a/vendor/cmdliner/src/cmdliner_manpage.ml +++ b/vendor/cmdliner/src/cmdliner_manpage.ml @@ -1,7 +1,6 @@ (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli. All rights reserved. + Copyright (c) 2011 The cmdliner programmers. All rights reserved. Distributed under the ISC license, see terms at the end of the file. - cmdliner v1.0.4-31-gb5d6161 ---------------------------------------------------------------------------*) (* Manpages *) @@ -40,14 +39,16 @@ let s_examples = "EXAMPLES" let s_bugs = "BUGS" let s_authors = "AUTHORS" let s_see_also = "SEE ALSO" +let s_none = "cmdliner-none" (* Section order *) let s_created = "" let order = [| s_name; s_synopsis; s_description; s_created; s_commands; - s_command_aliases; s_arguments; s_options; s_common_options; s_exit_status; - s_environment; s_files; s_examples; s_bugs; s_authors; s_see_also; |] + s_arguments; s_options; s_common_options; s_exit_status; + s_environment; s_files; s_examples; s_bugs; s_authors; s_see_also; + s_none; |] let order_synopsis = 1 let order_created = 3 @@ -95,14 +96,16 @@ let smap_to_blocks smap = (* N.B. this leaves `Blocks content untouched. *) let rec loop acc smap s = function | b :: rbs -> loop (b :: acc) smap s rbs | [] -> - let acc = if s = "" then acc else `S s :: acc in + let acc = if s = "" then acc else `S s :: acc in match smap with - | (s, (_, rbs)) :: smap -> loop acc smap s rbs | [] -> acc + | (_, (_, [])) :: smap -> loop acc smap "" [] (* skip empty section *) + | (s, (_, rbs)) :: smap -> + if s = s_none + then loop acc smap "" [] (* skip *) + else loop acc smap s rbs in - match smap with - | [] -> [] - | (s, (_, rbs)) :: smap -> loop [] smap s rbs + loop [] smap "" [] let smap_has_section smap ~sec = List.exists (fun (s, _) -> sec = s) smap let smap_append_block smap ~sec b = @@ -145,12 +148,12 @@ let pp_tokens = Cmdliner_base.pp_tokens let err e fmt = pf e ("cmdliner error: " ^^ fmt ^^ "@.") let err_unescaped ~errs c s = err errs "unescaped %C in %S" c s -let err_malformed ~errs s = err errs "Malformed $(...) in %S" s -let err_unclosed ~errs s = err errs "Unclosed $(...) in %S" s +let err_malformed ~errs s = err errs "Malformed $(…) in %S" s +let err_unclosed ~errs s = err errs "Unclosed $(…) in %S" s let err_undef ~errs id s = err errs "Undefined variable $(%s) in %S" id s let err_illegal_esc ~errs c s = err errs "Illegal escape char %C in %S" c s let err_markup ~errs dir s = - err errs "Unknown cmdliner markup $(%c,...) in %S" dir s + err errs "Unknown cmdliner markup $(%c,…) in %S" dir s let is_markup_dir = function 'i' | 'b' -> true | _ -> false let is_markup_esc = function '$' | '\\' | '(' | ')' -> true | _ -> false @@ -411,7 +414,7 @@ let pp_groff_blocks ~errs subst ppf text = List.iter pp_block text let pp_groff_page ~errs subst ppf ((n, s, a1, a2, a3), t) = - pf ppf ".\\\" Pipe this output to groff -Tutf8 | less@\n\ + pf ppf ".\\\" Pipe this output to groff -m man -K utf8 -T utf8 | less -R@\n\ .\\\"@\n\ .mso an.tmac@\n\ .TH \"%s\" %d \"%s\" \"%s\" \"%s\"@\n\ @@ -436,34 +439,42 @@ let pp_to_temp_file pp_v v = let find_cmd cmds = let test, null = match Sys.os_type with | "Win32" -> "where", " NUL" - | _ -> "type", "/dev/null" + | _ -> "command -v", "/dev/null" in - let cmd c = Sys.command (strf "%s %s 1>%s 2>%s" test c null null) = 0 in + let cmd (c, _) = Sys.command (strf "%s %s 1>%s 2>%s" test c null null) = 0 in try Some (List.find cmd cmds) with Not_found -> None let pp_to_pager print ppf v = let pager = - let cmds = ["less"; "more"] in - let cmds = try (Sys.getenv "PAGER") :: cmds with Not_found -> cmds in - let cmds = try (Sys.getenv "MANPAGER") :: cmds with Not_found -> cmds in + let cmds = ["less"," -R"; "more", ""] in + (* Fundamentally env var lookups should try to cut the exec name. *) + let cmds = try (Sys.getenv "PAGER", "") :: cmds with Not_found -> cmds in + let cmds = try (Sys.getenv "MANPAGER", "") :: cmds with Not_found -> cmds in find_cmd cmds in match pager with | None -> print `Plain ppf v - | Some pager -> - let cmd = match (find_cmd ["groff"; "nroff"]) with + | Some (pager, opts) -> + let pager = pager ^ opts in + let groffer = + let cmds = + ["mandoc", " -m man -K utf-8 -T utf8"; + "groff", " -m man -K utf8 -T utf8"; + "nroff", ""] + in + find_cmd cmds + in + let cmd = match groffer with | None -> begin match pp_to_temp_file (print `Plain) v with | None -> None | Some f -> Some (strf "%s < %s" pager f) end - | Some c -> + | Some (groffer, opts) -> + let groffer = groffer ^ opts in begin match pp_to_temp_file (print `Groff) v with | None -> None - | Some f -> - (* TODO use -Tutf8, but annoyingly maps U+002D to U+2212. *) - let xroff = if c = "groff" then c ^ " -Tascii -P-c" else c in - Some (strf "%s < %s | %s" xroff f pager) + | Some f -> Some (strf "%s < %s | %s" groffer f pager) end in match cmd with @@ -487,7 +498,7 @@ let rec print | Some _ -> print ~errs ~subst `Pager ppf page (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli + Copyright (c) 2011 The cmdliner programmers Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above diff --git a/vendor/cmdliner/src/cmdliner_manpage.mli b/vendor/cmdliner/src/cmdliner_manpage.mli index 809f19bc5d6..5d43a5bfde3 100644 --- a/vendor/cmdliner/src/cmdliner_manpage.mli +++ b/vendor/cmdliner/src/cmdliner_manpage.mli @@ -1,7 +1,6 @@ (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli. All rights reserved. + Copyright (c) 2011 The cmdliner programmers. All rights reserved. Distributed under the ISC license, see terms at the end of the file. - cmdliner v1.0.4-31-gb5d6161 ---------------------------------------------------------------------------*) (** Manpages. @@ -38,6 +37,7 @@ val s_bugs : string val s_examples : string val s_authors : string val s_see_also : string +val s_none : string (** {1 Section maps} @@ -70,7 +70,7 @@ val subst_vars : string -> string (** [subst b ~subst s], using [b], substitutes in [s] variables of the form "$(doc)" by their [subst] definition. This leaves escapes and markup - directives $(markup,...) intact. + directives $(markup,…) intact. @raise Invalid_argument in case of illegal syntax. *) @@ -84,7 +84,7 @@ val doc_to_plain : @raise Invalid_argument in case of illegal syntax. *) (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli + Copyright (c) 2011 The cmdliner programmers Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above diff --git a/vendor/cmdliner/src/cmdliner_msg.ml b/vendor/cmdliner/src/cmdliner_msg.ml index dae67561dc9..a61c8159612 100644 --- a/vendor/cmdliner/src/cmdliner_msg.ml +++ b/vendor/cmdliner/src/cmdliner_msg.ml @@ -1,7 +1,6 @@ (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli. All rights reserved. + Copyright (c) 2011 The cmdliner programmers. All rights reserved. Distributed under the ISC license, see terms at the end of the file. - cmdliner v1.0.4-31-gb5d6161 ---------------------------------------------------------------------------*) let strf = Printf.sprintf @@ -14,7 +13,7 @@ let pp_lines = Cmdliner_base.pp_lines (* Environment variable errors *) let err_env_parse env ~err = - let var = Cmdliner_info.env_var env in + let var = Cmdliner_info.Env.info_var env in strf "environment variable %s: %s" (quote var) err (* Positional argument errors *) @@ -23,7 +22,7 @@ let err_pos_excess excess = strf "too many arguments, don't know what to do with %s" (String.concat ", " (List.map quote excess)) -let err_pos_miss a = match Cmdliner_info.arg_docv a with +let err_pos_miss a = match Cmdliner_info.Arg.docv a with | "" -> "a required argument is missing" | v -> strf "required argument %s is missing" v @@ -31,21 +30,21 @@ let err_pos_misses = function | [] -> assert false | [a] -> err_pos_miss a | args -> - let add_arg acc a = match Cmdliner_info.arg_docv a with + let add_arg acc a = match Cmdliner_info.Arg.docv a with | "" -> "ARG" :: acc | argv -> argv :: acc in - let rev_args = List.sort Cmdliner_info.rev_arg_pos_cli_order args in + let rev_args = List.sort Cmdliner_info.Arg.rev_pos_cli_order args in let args = List.fold_left add_arg [] rev_args in let args = String.concat ", " args in strf "required arguments %s are missing" args -let err_pos_parse a ~err = match Cmdliner_info.arg_docv a with +let err_pos_parse a ~err = match Cmdliner_info.Arg.docv a with | "" -> err | argv -> - match Cmdliner_info.(pos_len @@ arg_pos a) with + match Cmdliner_info.Arg.(pos_len @@ pos_kind a) with | Some 1 -> strf "%s argument: %s" argv err - | None | Some _ -> strf "%s... arguments: %s" argv err + | None | Some _ -> strf "%s… arguments: %s" argv err (* Optional argument errors *) @@ -63,32 +62,31 @@ let err_opt_repeated f f' = (* Argument errors *) let err_arg_missing a = - if Cmdliner_info.arg_is_pos a then err_pos_miss a else - strf "required option %s is missing" (Cmdliner_info.arg_opt_name_sample a) + if Cmdliner_info.Arg.is_pos a then err_pos_miss a else + strf "required option %s is missing" (Cmdliner_info.Arg.opt_name_sample a) + +let err_cmd_missing ~dom = + strf "required COMMAND name is missing, must be %s." + (Cmdliner_base.alts_str ~quoted:true dom) (* Other messages *) -let exec_name_terms terms = - String.concat " " (List.rev_map Cmdliner_info.term_name terms) -let exec_name ei = exec_name_terms (Cmdliner_info.eval_terms_rev ei) - -let pp_version ppf ei = match Cmdliner_info.(term_version @@ eval_main ei) with -| None -> assert false -| Some v -> pp ppf "@[%a@]@." Cmdliner_base.pp_text v - -let pp_try_help ppf ei = match Cmdliner_info.eval_kind ei with -| `Simple | `Multiple_main -> - pp ppf "@[<2>Try `%s --help' for more information.@]" (exec_name ei) -| `Multiple_group -| `Multiple_sub -> - let exec_cmd = Cmdliner_docgen.plain_invocation ei in - let parent = - Cmdliner_info.eval_terms_rev ei - |> List.tl - |> exec_name_terms - in - pp ppf "@[<2>Try `%s --help' or `%s --help' for more information.@]" - exec_cmd parent +let exec_name ei = Cmdliner_info.Cmd.name @@ Cmdliner_info.Eval.main ei + +let pp_version ppf ei = + match Cmdliner_info.Cmd.version @@ Cmdliner_info.Eval.main ei with + | None -> assert false + | Some v -> pp ppf "@[%a@]@." Cmdliner_base.pp_text v + +let pp_try_help ppf ei = + let rcmds = Cmdliner_info.Eval.(cmd ei :: parents ei) in + match List.rev_map Cmdliner_info.Cmd.name rcmds with + | [] -> assert false + | [n] -> pp ppf "@[<2>Try '%s --help' for more information.@]" n + | n :: _ as cmds -> + let cmds = String.concat " " cmds in + pp ppf "@[<2>Try '%s --help' or '%s --help' for more information.@]" + cmds n let pp_err ppf ei ~err = pp ppf "%s: @[%a@]@." (exec_name ei) pp_lines err @@ -108,7 +106,7 @@ let pp_backtrace ppf ei e bt = (exec_name ei) pp_lines (strf "%s\n%s" (Printexc.to_string e) bt) (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli + Copyright (c) 2011 The cmdliner programmers Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above diff --git a/vendor/cmdliner/src/cmdliner_msg.mli b/vendor/cmdliner/src/cmdliner_msg.mli index f645080f179..125e1751933 100644 --- a/vendor/cmdliner/src/cmdliner_msg.mli +++ b/vendor/cmdliner/src/cmdliner_msg.mli @@ -1,20 +1,19 @@ (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli. All rights reserved. + Copyright (c) 2011 The cmdliner programmers. All rights reserved. Distributed under the ISC license, see terms at the end of the file. - cmdliner v1.0.4-31-gb5d6161 ---------------------------------------------------------------------------*) (** Messages for the end-user. *) (** {1:env_err Environment variable errors} *) -val err_env_parse : Cmdliner_info.env -> err:string -> string +val err_env_parse : Cmdliner_info.Env.info -> err:string -> string (** {1:pos_err Positional argument errors} *) val err_pos_excess : string list -> string -val err_pos_misses : Cmdliner_info.arg list -> string -val err_pos_parse : Cmdliner_info.arg -> err:string -> string +val err_pos_misses : Cmdliner_info.Arg.t list -> string +val err_pos_parse : Cmdliner_info.Arg.t -> err:string -> string (** {1:opt_err Optional argument errors} *) @@ -25,22 +24,23 @@ val err_opt_repeated : string -> string -> string (** {1:arg_err Argument errors} *) -val err_arg_missing : Cmdliner_info.arg -> string +val err_arg_missing : Cmdliner_info.Arg.t -> string +val err_cmd_missing : dom:string list -> string (** {1:msgs Other messages} *) -val pp_version : Format.formatter -> Cmdliner_info.eval -> unit -val pp_try_help : Format.formatter -> Cmdliner_info.eval -> unit -val pp_err : Format.formatter -> Cmdliner_info.eval -> err:string -> unit +val pp_version : Format.formatter -> Cmdliner_info.Eval.t -> unit +val pp_try_help : Format.formatter -> Cmdliner_info.Eval.t -> unit +val pp_err : Format.formatter -> Cmdliner_info.Eval.t -> err:string -> unit val pp_err_usage : - Format.formatter -> Cmdliner_info.eval -> err_lines:bool -> err:string -> unit + Format.formatter -> Cmdliner_info.Eval.t -> err_lines:bool -> err:string -> unit val pp_backtrace : Format.formatter -> - Cmdliner_info.eval -> exn -> Printexc.raw_backtrace -> unit + Cmdliner_info.Eval.t -> exn -> Printexc.raw_backtrace -> unit (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli + Copyright (c) 2011 The cmdliner programmers Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above diff --git a/vendor/cmdliner/src/cmdliner_suggest.ml b/vendor/cmdliner/src/cmdliner_suggest.ml deleted file mode 100644 index ea1fce2c821..00000000000 --- a/vendor/cmdliner/src/cmdliner_suggest.ml +++ /dev/null @@ -1,54 +0,0 @@ -(*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli. All rights reserved. - Distributed under the ISC license, see terms at the end of the file. - cmdliner v1.0.4-31-gb5d6161 - ---------------------------------------------------------------------------*) - -let levenshtein_distance s t = - (* As found here http://rosettacode.org/wiki/Levenshtein_distance#OCaml *) - let minimum a b c = min a (min b c) in - let m = String.length s in - let n = String.length t in - (* for all i and j, d.(i).(j) will hold the Levenshtein distance between - the first i characters of s and the first j characters of t *) - let d = Array.make_matrix (m+1) (n+1) 0 in - for i = 0 to m do d.(i).(0) <- i done; - for j = 0 to n do d.(0).(j) <- j done; - for j = 1 to n do - for i = 1 to m do - if s.[i-1] = t.[j-1] then - d.(i).(j) <- d.(i-1).(j-1) (* no operation required *) - else - d.(i).(j) <- minimum - (d.(i-1).(j) + 1) (* a deletion *) - (d.(i).(j-1) + 1) (* an insertion *) - (d.(i-1).(j-1) + 1) (* a substitution *) - done; - done; - d.(m).(n) - -let value s candidates = - let add (min, acc) name = - let d = levenshtein_distance s name in - if d = min then min, (name :: acc) else - if d < min then d, [name] else - min, acc - in - let dist, suggs = List.fold_left add (max_int, []) candidates in - if dist < 3 (* suggest only if not too far *) then suggs else [] - -(*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli - - Permission to use, copy, modify, and/or distribute this software for any - purpose with or without fee is hereby granted, provided that the above - copyright notice and this permission notice appear in all copies. - - THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES - WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF - MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR - ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES - WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN - ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF - OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. - ---------------------------------------------------------------------------*) diff --git a/vendor/cmdliner/src/cmdliner_term.ml b/vendor/cmdliner/src/cmdliner_term.ml index 7d274d6d8df..13220cfbb1d 100644 --- a/vendor/cmdliner/src/cmdliner_term.ml +++ b/vendor/cmdliner/src/cmdliner_term.ml @@ -1,7 +1,6 @@ (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli. All rights reserved. + Copyright (c) 2011 The cmdliner programmers. All rights reserved. Distributed under the ISC license, see terms at the end of the file. - cmdliner v1.0.4-31-gb5d6161 ---------------------------------------------------------------------------*) type term_escape = @@ -9,14 +8,14 @@ type term_escape = | `Help of Cmdliner_manpage.format * string option ] type 'a parser = - Cmdliner_info.eval -> Cmdliner_cline.t -> + Cmdliner_info.Eval.t -> Cmdliner_cline.t -> ('a, [ `Parse of string | term_escape ]) result -type 'a t = Cmdliner_info.args * 'a parser +type 'a t = Cmdliner_info.Arg.Set.t * 'a parser -let const v = Cmdliner_info.Args.empty, (fun _ _ -> Ok v) +let const v = Cmdliner_info.Arg.Set.empty, (fun _ _ -> Ok v) let app (args_f, f) (args_v, v) = - Cmdliner_info.Args.union args_f args_v, + Cmdliner_info.Arg.Set.union args_f args_v, fun ei cl -> match (f ei cl) with | Error _ as e -> e | Ok f -> @@ -24,8 +23,66 @@ let app (args_f, f) (args_v, v) = | Error _ as e -> e | Ok v -> Ok (f v) +(* Terms *) + +let ( $ ) = app + +type 'a ret = [ `Ok of 'a | term_escape ] + +let ret (al, v) = + al, fun ei cl -> match v ei cl with + | Ok (`Ok v) -> Ok v + | Ok (`Error _ as err) -> Error err + | Ok (`Help _ as help) -> Error help + | Error _ as e -> e + +let term_result ?(usage = false) (al, v) = + al, fun ei cl -> match v ei cl with + | Ok (Ok _ as ok) -> ok + | Ok (Error (`Msg e)) -> Error (`Error (usage, e)) + | Error _ as e -> e + +let term_result' ?usage t = + let wrap = app (const (Result.map_error (fun e -> `Msg e))) t in + term_result ?usage wrap + +let cli_parse_result (al, v) = + al, fun ei cl -> match v ei cl with + | Ok (Ok _ as ok) -> ok + | Ok (Error (`Msg e)) -> Error (`Parse e) + | Error _ as e -> e + +let cli_parse_result' t = + let wrap = app (const (Result.map_error (fun e -> `Msg e))) t in + cli_parse_result wrap + +let main_name = + Cmdliner_info.Arg.Set.empty, + (fun ei _ -> Ok (Cmdliner_info.Cmd.name @@ Cmdliner_info.Eval.main ei)) + +let choice_names = + Cmdliner_info.Arg.Set.empty, + (fun ei _ -> + (* N.B. this keeps everything backward compatible. We return the command + names of main's children *) + let name t = Cmdliner_info.Cmd.name t in + let choices = Cmdliner_info.Cmd.children (Cmdliner_info.Eval.main ei) in + Ok (List.rev_map name choices)) + +let with_used_args (al, v) : (_ * string list) t = + al, fun ei cl -> + match v ei cl with + | Ok x -> + let actual_args arg_info acc = + let args = Cmdliner_cline.actual_args cl arg_info in + List.rev_append args acc + in + let used = List.rev (Cmdliner_info.Arg.Set.fold actual_args al []) in + Ok (x, used) + | Error _ as e -> e + (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli + Copyright (c) 2011 The cmdliner programmers Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above diff --git a/vendor/cmdliner/src/cmdliner_term.mli b/vendor/cmdliner/src/cmdliner_term.mli index 8db40106da9..c9b280ecb2f 100644 --- a/vendor/cmdliner/src/cmdliner_term.mli +++ b/vendor/cmdliner/src/cmdliner_term.mli @@ -1,7 +1,6 @@ (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli. All rights reserved. + Copyright (c) 2011 The cmdliner programmers. All rights reserved. Distributed under the ISC license, see terms at the end of the file. - cmdliner v1.0.4-31-gb5d6161 ---------------------------------------------------------------------------*) (** Terms *) @@ -11,20 +10,32 @@ type term_escape = | `Help of Cmdliner_manpage.format * string option ] type 'a parser = - Cmdliner_info.eval -> Cmdliner_cline.t -> + Cmdliner_info.Eval.t -> Cmdliner_cline.t -> ('a, [ `Parse of string | term_escape ]) result (** Type type for command line parser. given static information about the command line and a command line to parse returns an OCaml value. *) -type 'a t = Cmdliner_info.args * 'a parser +type 'a t = Cmdliner_info.Arg.Set.t * 'a parser (** The type for terms. The list of arguments it can parse and the parsing function that does so. *) val const : 'a -> 'a t val app : ('a -> 'b) t -> 'a t -> 'b t +val ( $ ) : ('a -> 'b) t -> 'a t -> 'b t + +type 'a ret = [ `Ok of 'a | term_escape ] + +val ret : 'a ret t -> 'a t +val term_result : ?usage:bool -> ('a, [`Msg of string]) result t -> 'a t +val term_result' : ?usage:bool -> ('a, string) result t -> 'a t +val cli_parse_result : ('a, [`Msg of string]) result t -> 'a t +val cli_parse_result' : ('a, string) result t -> 'a t +val main_name : string t +val choice_names : string list t +val with_used_args : 'a t -> ('a * string list) t (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli + Copyright (c) 2011 The cmdliner programmers Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above diff --git a/vendor/cmdliner/src/cmdliner_term_deprecated.ml b/vendor/cmdliner/src/cmdliner_term_deprecated.ml new file mode 100644 index 00000000000..a156d3bc431 --- /dev/null +++ b/vendor/cmdliner/src/cmdliner_term_deprecated.ml @@ -0,0 +1,93 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2011 The cmdliner programmers. All rights reserved. + Distributed under the ISC license, see terms at the end of the file. + ---------------------------------------------------------------------------*) + +(* Term combinators *) + +let man_format = Cmdliner_arg.man_format +let pure = Cmdliner_term.const + +(* Term information *) + +type exit_info = Cmdliner_info.Exit.info +let exit_info = Cmdliner_info.Exit.info + +let exit_status_success = Cmdliner_info.Exit.ok +let exit_status_cli_error = Cmdliner_info.Exit.cli_error +let exit_status_internal_error = Cmdliner_info.Exit.internal_error +let default_error_exits = + [ exit_info exit_status_cli_error ~doc:"on command line parsing errors."; + exit_info exit_status_internal_error + ~doc:"on unexpected internal errors (bugs)."; ] + +let default_exits = + (exit_info exit_status_success ~doc:"on success.") :: default_error_exits + +type env_info = Cmdliner_info.Env.info +let env_info = Cmdliner_info.Env.info ?deprecated:None + +type info = Cmdliner_info.Cmd.t +let info + ?(man_xrefs = []) ?man ?envs ?(exits = []) + ?(sdocs = Cmdliner_manpage.s_options) ?docs ?doc ?version name + = + Cmdliner_info.Cmd.v + ~man_xrefs ?man ?envs ~exits ~sdocs ?docs ?doc ?version name + +let name ti = Cmdliner_info.Cmd.name ti + +(* Evaluation *) + +type 'a result = +[ `Ok of 'a | `Error of [`Parse | `Term | `Exn ] | `Version | `Help ] + +let to_legacy_result = function +| Ok (#Cmdliner_eval.eval_ok as r) -> (r : 'a result) +| Error e -> `Error e + +let eval ?help ?err ?catch ?env ?argv (t, i) = + let cmd = Cmdliner_cmd.v i t in + to_legacy_result (Cmdliner_eval.eval_value ?help ?err ?catch ?env ?argv cmd) + +let eval_choice ?help ?err ?catch ?env ?argv (t, i) choices = + let sub (t, i) = Cmdliner_cmd.v i t in + let cmd = Cmdliner_cmd.group i ~default:t (List.map sub choices) in + to_legacy_result (Cmdliner_eval.eval_value ?help ?err ?catch ?env ?argv cmd) + +let eval_peek_opts ?version_opt ?env ?argv t = + let o, r = Cmdliner_eval.eval_peek_opts ?version_opt ?env ?argv t in + o, to_legacy_result r + +(* Exits *) + +let exit_status_of_result ?(term_err = 1) = function +| `Ok () | `Help | `Version -> exit_status_success +| `Error `Term -> term_err +| `Error `Exn -> exit_status_internal_error +| `Error `Parse -> exit_status_cli_error + +let exit_status_of_status_result ?term_err = function +| `Ok n -> n +| `Help | `Version | `Error _ as r -> exit_status_of_result ?term_err r + +let stdlib_exit = exit +let exit ?term_err r = stdlib_exit (exit_status_of_result ?term_err r) +let exit_status ?term_err r = + stdlib_exit (exit_status_of_status_result ?term_err r) + +(*--------------------------------------------------------------------------- + Copyright (c) 2011 The cmdliner programmers + + Permission to use, copy, modify, and/or distribute this software for any + purpose with or without fee is hereby granted, provided that the above + copyright notice and this permission notice appear in all copies. + + THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + ---------------------------------------------------------------------------*) diff --git a/vendor/cmdliner/src/cmdliner_trie.ml b/vendor/cmdliner/src/cmdliner_trie.ml index 1147a717683..e7e6a7acde4 100644 --- a/vendor/cmdliner/src/cmdliner_trie.ml +++ b/vendor/cmdliner/src/cmdliner_trie.ml @@ -1,7 +1,6 @@ (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli. All rights reserved. + Copyright (c) 2011 The cmdliner programmers. All rights reserved. Distributed under the ISC license, see terms at the end of the file. - cmdliner v1.0.4-31-gb5d6161 ---------------------------------------------------------------------------*) module Cmap = Map.Make (Char) (* character maps. *) @@ -81,7 +80,7 @@ let of_list l = List.fold_left add empty l (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli + Copyright (c) 2011 The cmdliner programmers Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above diff --git a/vendor/cmdliner/src/cmdliner_trie.mli b/vendor/cmdliner/src/cmdliner_trie.mli index b3e629f60fb..4b77a7f166a 100644 --- a/vendor/cmdliner/src/cmdliner_trie.mli +++ b/vendor/cmdliner/src/cmdliner_trie.mli @@ -1,7 +1,6 @@ (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli. All rights reserved. + Copyright (c) 2011 The cmdliner programmers. All rights reserved. Distributed under the ISC license, see terms at the end of the file. - cmdliner v1.0.4-31-gb5d6161 ---------------------------------------------------------------------------*) (** Tries. @@ -19,7 +18,7 @@ val ambiguities : 'a t -> string -> string list val of_list : (string * 'a) list -> 'a t (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli + Copyright (c) 2011 The cmdliner programmers Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above diff --git a/vendor/update-cmdliner.sh b/vendor/update-cmdliner.sh index b7cb83b9644..d97b3ad5912 100755 --- a/vendor/update-cmdliner.sh +++ b/vendor/update-cmdliner.sh @@ -1,6 +1,6 @@ #!/bin/bash -version=b5d61616851bfb0f0c2ed64302dd5cccd39413c8 +version=c7f97d02cedc3d7e267704b987f3c1403e8152a9 set -e -o pipefail