Update cmdliner to groups fork

Signed-off-by: Rudi Grinberg <[email protected]>

Author: rgrinberg

vendor/cmdliner/src/cmdliner.ml

@@ -1,7 +1,7 @@
 (*---------------------------------------------------------------------------
    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-3-ga5ff0e8
+   cmdliner v1.0.4-12-gfb7fa13
   ---------------------------------------------------------------------------*)
 
 module Manpage = Cmdliner_manpage
@@ -216,7 +216,7 @@ module Term = struct
       ?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 ~term ~main:term ~choices:[] ~env 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
@@ -257,20 +257,111 @@ module Term = struct
     let main = fst main_f in
     match choose_term main_f choices_f (remove_exec argv) with
     | Error err ->
-        let ei = Cmdliner_info.eval ~term:main ~main ~choices ~env in
+        let ei = Cmdliner_info.eval ~env
+            (Sub_command { term = main ; path = [main] ; main
+                         ; sibling_terms = choices})
+        in
         Cmdliner_msg.pp_err_usage err_ppf ei ~err_lines:false ~err;
         `Error `Parse
     | Ok ((chosen, f), args) ->
-        let ei = Cmdliner_info.eval ~term:chosen ~main ~choices ~env in
+        let ei = Cmdliner_info.eval ~env
+            (Sub_command { term = chosen ; path = [main; chosen] ; main;
+                           sibling_terms = choices }) in
+        let ei, res = term_eval ~catch ei f args in
+        do_result help_ppf err_ppf ei res
+
+  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, path, args) =
+      match List.find (fun t -> cmd_name t = cmd) choices with
+      | exception Not_found -> Error (`Invalid_command (cmd, path, choices))
+      | (choice, info) -> Ok ((choice, info), choices, info :: path, args)
+
+    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 =
+      match parse_arg_cmd args with
+      | Error `No_args -> Ok (main, choices, [], args)
+      | Ok (cmd, args) -> one_of (cmd, choices, [snd main], 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 sibling_terms = List.map snd choices in
+        let ei = Cmdliner_info.eval ~env
+            (Sub_command { term = main ; path ; main ; sibling_terms}) in
+        let _, _, ei = add_stdopts ei in
+        Cmdliner_docgen.pp_man ~errs:err_ppf `Auto help_ppf ei;
+        `Help
+    | Error (`Invalid_command (maybe, path, _choices)) ->
+        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 { term = main ; 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 ; term = info ; 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_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 ~term ~main:term ~choices:[] ~env  in
+    let ei = Cmdliner_info.eval ~env (Simple term) in
     (term_eval_peek_opts ei f (remove_exec argv) :> 'a option * 'a result)
 
   (* Exits *)

vendor/cmdliner/src/cmdliner.mli

@@ -1,7 +1,7 @@
 (*---------------------------------------------------------------------------
    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-3-ga5ff0e8
+   cmdliner v1.0.4-12-gfb7fa13
   ---------------------------------------------------------------------------*)
 
 (** Declarative definition of command line interfaces.
@@ -22,7 +22,7 @@
     use. Open the module to use it, it defines only three modules in
     your scope.
 
-    {e v1.0.4-3-ga5ff0e8 — {{:http://erratique.ch/software/cmdliner }homepage}} *)
+    {e v1.0.4-12-gfb7fa13 — {{:http://erratique.ch/software/cmdliner }homepage}} *)
 
 (** {1:top Interface} *)
 
@@ -382,6 +382,21 @@ 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
+
+    and 'a t = 'a node * 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
+  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
@@ -1255,7 +1270,7 @@ let cmd =
     `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-3-ga5ff0e8" ~doc ~exits:Term.default_exits ~man
+  Term.info "rm" ~version:"v1.0.4-12-gfb7fa13" ~doc ~exits:Term.default_exits ~man
 
 let () = Term.(exit @@ eval cmd)
 ]}
@@ -1325,7 +1340,7 @@ let cmd =
       `P "Email them to <hehey at example.org>."; ]
   in
   Term.(ret (const cp $ verbose $ recurse $ force $ srcs $ dest)),
-  Term.info "cp" ~version:"v1.0.4-3-ga5ff0e8" ~doc ~exits ~man ~man_xrefs
+  Term.info "cp" ~version:"v1.0.4-12-gfb7fa13" ~doc ~exits ~man ~man_xrefs
 
 let () = Term.(exit @@ eval cmd)
 ]}
@@ -1598,7 +1613,7 @@ let default_cmd =
   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-3-ga5ff0e8" ~doc ~sdocs ~exits ~man
+  Term.info "darcs" ~version:"v1.0.4-12-gfb7fa13" ~doc ~sdocs ~exits ~man
 
 let cmds = [initialize_cmd; record_cmd; help_cmd]
 

vendor/cmdliner/src/cmdliner_arg.ml

@@ -1,7 +1,7 @@
 (*---------------------------------------------------------------------------
    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-3-ga5ff0e8
+   cmdliner v1.0.4-12-gfb7fa13
   ---------------------------------------------------------------------------*)
 
 let rev_compare n0 n1 = compare n1 n0

vendor/cmdliner/src/cmdliner_arg.mli

@@ -1,7 +1,7 @@
 (*---------------------------------------------------------------------------
    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-3-ga5ff0e8
+   cmdliner v1.0.4-12-gfb7fa13
   ---------------------------------------------------------------------------*)
 
 (** Command line arguments as terms. *)

vendor/cmdliner/src/cmdliner_base.ml

@@ -1,7 +1,7 @@
 (*---------------------------------------------------------------------------
    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-3-ga5ff0e8
+   cmdliner v1.0.4-12-gfb7fa13
   ---------------------------------------------------------------------------*)
 
 (* Invalid argument strings *)

vendor/cmdliner/src/cmdliner_base.mli

@@ -1,7 +1,7 @@
 (*---------------------------------------------------------------------------
    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-3-ga5ff0e8
+   cmdliner v1.0.4-12-gfb7fa13
   ---------------------------------------------------------------------------*)
 
 (** A few helpful base definitions. *)

vendor/cmdliner/src/cmdliner_cline.ml

@@ -1,7 +1,7 @@
 (*---------------------------------------------------------------------------
    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-3-ga5ff0e8
+   cmdliner v1.0.4-12-gfb7fa13
   ---------------------------------------------------------------------------*)
 
 (* A command line stores pre-parsed information about the command

vendor/cmdliner/src/cmdliner_cline.mli

@@ -1,7 +1,7 @@
 (*---------------------------------------------------------------------------
    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-3-ga5ff0e8
+   cmdliner v1.0.4-12-gfb7fa13
   ---------------------------------------------------------------------------*)
 
 (** Command lines. *)

vendor/cmdliner/src/cmdliner_docgen.ml

@@ -1,7 +1,7 @@
 (*---------------------------------------------------------------------------
    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-3-ga5ff0e8
+   cmdliner v1.0.4-12-gfb7fa13
   ---------------------------------------------------------------------------*)
 
 let rev_compare n0 n1 = compare n1 n0
@@ -61,9 +61,11 @@ let term_info_subst ei = function
 let invocation ?(sep = ' ') ei = match Cmdliner_info.eval_kind ei with
 | `Simple | `Multiple_main -> term_name (Cmdliner_info.eval_main ei)
 | `Multiple_sub ->
-    strf "%s%c%s"
-      Cmdliner_info.(term_name @@ eval_main ei) sep
-      Cmdliner_info.(term_name @@ eval_term ei)
+    let sep = String.make 1 sep in
+    Cmdliner_info.eval_parents_invocation_order ei
+    |> List.map Cmdliner_info.term_name
+    |> String.concat sep
+    |> strf "%s"
 
 let plain_invocation ei = invocation ei
 let invocation ?sep ei = esc @@ invocation ?sep ei

vendor/cmdliner/src/cmdliner_docgen.mli

@@ -1,7 +1,7 @@
 (*---------------------------------------------------------------------------
    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-3-ga5ff0e8
+   cmdliner v1.0.4-12-gfb7fa13
   ---------------------------------------------------------------------------*)
 
 val plain_invocation : Cmdliner_info.eval -> string