Upgrade cmdliner fork to 1.1.1

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 (to be reviewed separately), - a port of `bin/` to the `Cmdliner.Cmd` API, - test updates, mostly typographic. Signed-off-by: Etienne Millon <[email protected]>
ocaml · Sep 5, 2022 · 0b45bad · 0b45bad
1 parent 0e0c91a
commit 0b45bad
Show file tree

Hide file tree

Showing 97 changed files with 2,252 additions and 2,376 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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 *)
@@ -809,4 +809,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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -1 +1,3 @@
-val command : unit Cmdliner.Term.t * Cmdliner.Term.info
+open Import
+
+val command : unit Cmd.t