Define completion spec in an arg converter

src/cmdliner.mli

@@ -833,6 +833,9 @@ module Arg : sig
   (** The type for argument converters. *)
 
   val conv :
+    ?complete:(string -> (string * string) list) ->
+    ?complete_file:bool ->
+    ?complete_dir:bool ->
     ?docv:string -> (string -> ('a, [`Msg of string]) result) * 'a printer ->
     'a conv
   (** [conv ~docv (parse, print)] is an argument converter
@@ -842,6 +845,9 @@ module Arg : sig
       ["VALUE"]. *)
 
   val conv' :
+    ?complete:(string -> (string * string) list) ->
+    ?complete_file:bool ->
+    ?complete_dir:bool ->
     ?docv:string -> (string -> ('a, string) result) * 'a printer ->
     'a conv
   (** [conv'] is like {!val-conv} but the [Error] case has an unlabelled
@@ -893,9 +899,7 @@ module Arg : sig
 
   val info :
     ?deprecated:string -> ?absent:string -> ?docs:string -> ?docv:string ->
-    ?doc:string -> ?env:Cmd.Env.info -> 
-    ?complete:[ `Complete_custom of unit -> (string * string) list | `Complete_dir | `Complete_file ] ->
-    string list -> info
+    ?doc:string -> ?env:Cmd.Env.info -> string list -> info
   (** [info docs docv doc env names] defines information for
       an argument.
       {ul

src/cmdliner_arg.ml

@@ -21,25 +21,28 @@ let str_of_pp pp v = pp Format.str_formatter v; Format.flush_str_formatter ()
 
 (* Argument converters *)
 
-type 'a parser = string -> [ `Ok of 'a | `Error of string ]
-type 'a printer = Format.formatter -> 'a -> unit
+type 'a parser = 'a Cmdliner_base.parser
+type 'a printer = 'a Cmdliner_base.printer
 
 type 'a conv = 'a Cmdliner_base.conv = {
   parse: 'a parser;
   print: 'a printer;
+  complete: Cmdliner_base.complete;
 }
 type 'a converter = 'a conv
 
 let default_docv = "VALUE"
-let conv ?docv (parse, print) =
+let conv ?complete ?complete_file ?complete_dir ?docv (parse, print) =
+  let complete = Cmdliner_base.complete ?complete ?file:complete_file ?dir:complete_dir () in
   let parse s = match parse s with Ok v -> `Ok v | Error (`Msg e) -> `Error e in
-  {parse; print}
+  {parse; print; complete}
 
-let conv' ?docv (parse, print) =
+let conv' ?complete ?complete_file ?complete_dir  ?docv (parse, print) =
+  let complete = Cmdliner_base.complete ?complete ?file:complete_file ?dir:complete_dir () in
   let parse s = match parse s with Ok v -> `Ok v | Error e -> `Error e in
-  {parse; print}
+  {parse; print; complete}
 
-let pconv ?docv (parse, print) = {parse; print}
+let pconv ?docv (parse, print) = {parse; print; complete=Cmdliner_base.no_complete}
 
 let conv_parser {parse; _} =
   fun s -> match parse s with `Ok v -> Ok v | `Error e -> Error (`Msg e)
@@ -94,9 +97,9 @@ let try_env ei a parse ~absent = match Cmdliner_info.Arg.env a with
         | `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.Arg.Set.singleton
-let list_to_args f l =
-  let add acc v = Cmdliner_info.Arg.Set.add (f v) acc in
+let arg_to_args a complete = Cmdliner_info.Arg.Set.singleton a complete
+let list_to_args f l complete =
+  let add acc v = Cmdliner_info.Arg.Set.add (f v) complete acc in
   List.fold_left add Cmdliner_info.Arg.Set.empty l
 
 let flag a =
@@ -107,7 +110,7 @@ let flag a =
   | [_, f, Some v] -> err (Cmdliner_msg.err_flag_value f v)
   | (_, f, _) :: (_ ,g, _) :: _  -> err (Cmdliner_msg.err_opt_repeated f g)
   in
-  arg_to_args a, convert
+  arg_to_args a Cmdliner_base.no_complete, convert
 
 let flag_all a =
   if Cmdliner_info.Arg.is_pos a then invalid_arg err_not_opt else
@@ -124,7 +127,7 @@ let flag_all a =
         Ok (List.rev_map truth l)
       with Failure e -> err e
   in
-  arg_to_args a, convert
+  arg_to_args a Cmdliner_base.no_complete, convert
 
 let vflag v l =
   let convert _ cl =
@@ -148,7 +151,7 @@ let vflag v l =
   let flag (_, a) =
     if Cmdliner_info.Arg.is_pos a then invalid_arg err_not_opt else a
   in
-  list_to_args flag l, convert
+  list_to_args flag l Cmdliner_base.no_complete, convert
 
 let vflag_all v l =
   let convert _ cl =
@@ -172,13 +175,13 @@ let vflag_all v l =
     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
+  list_to_args flag l Cmdliner_base.no_complete, convert
 
 let parse_opt_value parse f v = match parse v with
 | `Ok v -> v
 | `Error err -> failwith (Cmdliner_msg.err_opt_parse f ~err)
 
-let opt ?vopt {parse; print} v a =
+let opt ?vopt {parse; print; complete} v a =
   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
@@ -200,9 +203,9 @@ let opt ?vopt {parse; print} v a =
       end
   | (_, f, _) :: (_, g, _) :: _ -> err (Cmdliner_msg.err_opt_repeated g f)
   in
-  arg_to_args a, convert
+  arg_to_args a complete, convert
 
-let opt_all ?vopt {parse; print} v a =
+let opt_all ?vopt {parse; print; complete} v a =
   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
@@ -226,15 +229,15 @@ let opt_all ?vopt {parse; print} v a =
                 (List.sort rev_compare (List.rev_map parse l))) with
       | Failure e -> err e
   in
-  arg_to_args a, convert
+  arg_to_args a complete, convert
 
 (* Positional arguments *)
 
 let parse_pos_value parse a v = match parse v with
 | `Ok v -> v
 | `Error err -> failwith (Cmdliner_msg.err_pos_parse a ~err)
 
-let pos ?(rev = false) k {parse; print} v a =
+let pos ?(rev = false) k {parse; print; complete} v a =
   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
@@ -248,9 +251,9 @@ let pos ?(rev = false) k {parse; print} v a =
       (try Ok (parse_pos_value parse a v) with Failure e -> err e)
   | _ -> assert false
   in
-  arg_to_args a, convert
+  arg_to_args a complete, convert
 
-let pos_list pos {parse; _} v a =
+let pos_list pos {parse; complete; _} 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
   let convert ei cl = match Cmdliner_cline.pos_arg cl a with
@@ -259,7 +262,7 @@ let pos_list pos {parse; _} v a =
       try Ok (List.rev (List.rev_map (parse_pos_value parse a) l)) with
       | Failure e -> err e
   in
-  arg_to_args a, convert
+  arg_to_args a complete, convert
 
 let all = Cmdliner_info.Arg.pos ~rev:false ~start:0 ~len:None
 let pos_all c v a = pos_list all c v a
@@ -277,16 +280,16 @@ let pos_right ?(rev = false) k =
 (* Arguments as terms *)
 
 let absent_error args =
-  let make_req a acc =
+  let make_req a v acc =
     let req_a = Cmdliner_info.Arg.make_req a in
-    Cmdliner_info.Arg.Set.add req_a acc
+    Cmdliner_info.Arg.Set.add req_a v acc
   in
   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.Arg.Set.choose args)
+  err @@ Cmdliner_msg.err_arg_missing (fst (Cmdliner_info.Arg.Set.choose args))
 
 let required (args, convert) =
   let args = absent_error args in

src/cmdliner_arg.mli

@@ -10,14 +10,21 @@ type 'a printer = Format.formatter -> 'a -> unit
 type 'a conv = 'a Cmdliner_base.conv = {
   parse: 'a parser;
   print: 'a printer;
+  complete: Cmdliner_base.complete;
 }
 type 'a converter = 'a conv
 
 val conv :
+  ?complete:(string -> (string * string) list) ->
+  ?complete_file:bool ->
+  ?complete_dir:bool ->
   ?docv:string -> (string -> ('a, [`Msg of string]) result) * 'a printer ->
   'a conv
 
 val conv' :
+  ?complete:(string -> (string * string) list) ->
+  ?complete_file:bool ->
+  ?complete_dir:bool ->
   ?docv:string -> (string -> ('a, string) result) * 'a printer -> 'a conv
 
 val pconv : ?docv:string -> 'a parser * 'a printer -> 'a conv
@@ -41,7 +48,6 @@ type info
 val info :
   ?deprecated:string -> ?absent:string -> ?docs:string -> ?docv:string ->
   ?doc:string -> ?env:env -> 
-  ?complete:[ `Complete_custom of unit -> (string * string) list | `Complete_dir | `Complete_file ] ->
   string list -> info
 
 val ( & ) : ('a -> 'b) -> 'a -> 'b

src/cmdliner_base.ml

@@ -143,13 +143,28 @@ let err_invalid_val = err_invalid "value"
 let err_sep_miss sep s =
   err_invalid_val s (strf "missing a '%c' separator" sep)
 
+(* Completions *)
+
+type complete = {
+  complete_file : bool;
+  complete_dir : bool;
+  complete : (string -> (string * string) list);
+}
+
+let complete ?(file=false) ?(dir=false) ?complete () =
+  let complete = Option.value complete ~default:(fun _ -> []) in
+  {complete_file=file; complete_dir=dir; complete}
+
+let no_complete = complete ()
+
 (* Converters *)
 
 type 'a parser = string -> [ `Ok of 'a | `Error of string ]
 type 'a printer = Format.formatter -> 'a -> unit
 type 'a conv = {
   parse: 'a parser;
   print: 'a printer;
+  complete: complete;
 }
 
 let some ?(none = "") conv =
@@ -158,57 +173,57 @@ let some ?(none = "") conv =
   | None -> Format.pp_print_string ppf none
   | Some v -> conv.print ppf v
   in
-  {parse; print}
+  {parse; print; complete=conv.complete}
 
 let some' ?none conv =
   let parse s = match conv.parse s with `Ok v -> `Ok (Some v) | `Error _ as e -> e in
   let print ppf = function
   | None -> (match none with None -> () | Some v -> conv.print ppf v)
   | Some v -> conv.print ppf v
   in
-  {parse; print}
+  {parse; print; complete=conv.complete}
 
 let bool =
   let parse s = try `Ok (bool_of_string s) with
   | Invalid_argument _ ->
       `Error (err_invalid_val s (alts_str ~quoted:true ["true"; "false"]))
   in
-  {parse; print=Format.pp_print_bool}
+  {parse; print=Format.pp_print_bool; complete=no_complete}
 
 let char =
   let parse s = match String.length s = 1 with
   | true -> `Ok s.[0]
   | false -> `Error (err_invalid_val s "expected a character")
   in
-  {parse; print=pp_char}
+  {parse; print=pp_char; complete=no_complete}
 
 let parse_with t_of_str exp s =
   try `Ok (t_of_str s) with Failure _ -> `Error (err_invalid_val s exp)
 
 let int =
   let parse = parse_with int_of_string "expected an integer" in
-  {parse; print=Format.pp_print_int}
+  {parse; print=Format.pp_print_int; complete=no_complete}
 
 let int32 =
   let parse = parse_with Int32.of_string "expected a 32-bit integer" in
   let print ppf = pp ppf "%ld" in
-  {parse; print}
+  {parse; print; complete=no_complete}
 
 let int64 =
   let parse = parse_with Int64.of_string "expected a 64-bit integer" in
   let print ppf = pp ppf "%Ld" in
-  {parse; print}
+  {parse; print; complete=no_complete}
 
 let nativeint =
   let parse = parse_with Nativeint.of_string "expected a processor-native integer" in
   let print ppf = pp ppf "%nd" in
-  {parse; print}
+  {parse; print; complete=no_complete}
 
 let float =
   let parse = parse_with float_of_string "expected a floating point number" in
-  {parse; print=Format.pp_print_float}
+  {parse; print=Format.pp_print_float; complete=no_complete}
 
-let string = {parse=(fun s -> `Ok s); print=pp_str}
+let string = {parse=(fun s -> `Ok s); print=pp_str; complete=no_complete}
 let enum sl =
   if sl = [] then invalid_arg err_empty_list else
   let t = Cmdliner_trie.of_list sl in
@@ -226,28 +241,29 @@ let enum sl =
     try pp_str ppf (List.assoc v sl_inv)
     with Not_found -> invalid_arg (err_incomplete_enum (List.map fst sl))
   in
-  {parse; print}
+  let complete = complete ~complete:(fun _prefix -> List.map (fun (s, _) -> s, "") sl) () in
+  {parse; print; complete}
 
 let file =
   let parse s = match Sys.file_exists s with
   | true -> `Ok s
   | false -> `Error (err_no "file or directory" s)
   in
-  {parse; print=pp_str}
+  {parse; print=pp_str; complete=complete ~dir:true ~file:true ()}
 
 let dir =
   let parse s = match Sys.file_exists s with
   | true -> if Sys.is_directory s then `Ok s else `Error (err_not_dir s)
   | false -> `Error (err_no "directory" s)
   in
-  {parse; print=pp_str}
+  {parse; print=pp_str; complete=complete ~dir:true ()}
 
 let non_dir_file =
   let parse s = match Sys.file_exists s with
   | true -> if not (Sys.is_directory s) then `Ok s else `Error (err_is_dir s)
   | false -> `Error (err_no "file" s)
   in
-  {parse; print=pp_str}
+  {parse; print=pp_str; complete=complete ~file:true ()}
 
 let split_and_parse sep parse s = (* raises [Failure] *)
   let parse sub = match parse sub with
@@ -273,7 +289,7 @@ let list ?(sep = ',') conv =
   | v :: l -> conv.print ppf v; if (l <> []) then (pp_char ppf sep; print ppf l)
   | [] -> ()
   in
-  {parse; print}
+  {parse; print; complete=no_complete}
 
 let array ?(sep = ',') conv =
   let parse s = try `Ok (Array.of_list (split_and_parse sep conv.parse s)) with
@@ -283,7 +299,7 @@ let array ?(sep = ',') conv =
     let max = Array.length v - 1 in
     for i = 0 to max do conv.print ppf v.(i); if i <> max then pp_char ppf sep done
   in
-  {parse; print}
+  {parse; print; complete=no_complete}
 
 let split_left sep s =
   try
@@ -301,7 +317,7 @@ let pair ?(sep = ',') conv0 conv1 =
       | `Error e, _ | _, `Error e -> `Error (err_element "pair" s e)
   in
   let print ppf (v0, v1) = pp ppf "%a%c%a" conv0.print v0 sep conv1.print v1 in
-  {parse; print}
+  {parse; print; complete=no_complete}
 
 let t2 = pair
 let t3 ?(sep = ',') conv0 conv1 conv2 =
@@ -319,7 +335,7 @@ let t3 ?(sep = ',') conv0 conv1 conv2 =
   let print ppf (v0, v1, v2) =
     pp ppf "%a%c%a%c%a" conv0.print v0 sep conv1.print v1 sep conv2.print v2
   in
-  {parse; print}
+  {parse; print; complete=no_complete}
 
 let t4 ?(sep = ',') conv0 conv1 conv2 conv3 =
   let parse s = match split_left sep s with
@@ -339,7 +355,7 @@ let t4 ?(sep = ',') conv0 conv1 conv2 conv3 =
   let print ppf (v0, v1, v2, v3) =
     pp ppf "%a%c%a%c%a%c%a" conv0.print v0 sep conv1.print v1 sep conv2.print v2 sep conv3.print v3
   in
-  {parse; print}
+  {parse; print; complete=no_complete}
 
 let env_bool_parse s = match String.lowercase_ascii s with
 | "" | "false" | "no" | "n" | "0" -> `Ok false