Make _ Cmdliner.Arg.conv abstract

src/cmdliner.mli

@@ -829,13 +829,8 @@ module Arg : sig
   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.} Do not use directly, use {!val-conv} or {!val-conv'}.
-      This type will become abstract in the next major version of cmdliner. *)
-  [@@@alert "+deprecated"] (* Need to be able to mention them ! *)
+  type 'a conv
+  (** The type for argument converters. *)
 
   val conv :
     ?docv:string -> (string -> ('a, [`Msg of string]) result) * 'a printer ->

src/cmdliner_arg.ml

@@ -24,24 +24,27 @@ let str_of_pp pp v = pp Format.str_formatter v; Format.flush_str_formatter ()
 type 'a parser = string -> [ `Ok of 'a | `Error of string ]
 type 'a printer = Format.formatter -> 'a -> unit
 
-type 'a conv = 'a parser * 'a printer
+type 'a conv = 'a Cmdliner_base.conv = {
+  parse: 'a parser;
+  print: 'a printer;
+}
 type 'a converter = 'a conv
 
 let default_docv = "VALUE"
 let conv ?docv (parse, print) =
   let parse s = match parse s with Ok v -> `Ok v | Error (`Msg e) -> `Error e in
-  parse, print
+  {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
+  {parse; print}
 
-let pconv ?docv conv = conv
+let pconv ?docv (parse, print) = {parse; print}
 
-let conv_parser (parse, _) =
+let conv_parser {parse; _} =
   fun s -> match parse s with `Ok v -> Ok v | `Error e -> Error (`Msg e)
 
-let conv_printer (_, print) = print
+let conv_printer {print; _} = print
 let conv_docv _ = default_docv
 
 let err_invalid s kind = `Msg (strf "invalid value '%s', expected %s" s kind)
@@ -175,7 +178,7 @@ 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} 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
@@ -199,7 +202,7 @@ let opt ?vopt (parse, print) v a =
   in
   arg_to_args a, convert
 
-let opt_all ?vopt (parse, print) v a =
+let opt_all ?vopt {parse; print} 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
@@ -231,7 +234,7 @@ 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} 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
@@ -247,7 +250,7 @@ let pos ?(rev = false) k (parse, print) v a =
   in
   arg_to_args a, convert
 
-let pos_list pos (parse, _) v a =
+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
   let convert ei cl = match Cmdliner_cline.pos_arg cl a with

src/cmdliner_arg.mli

@@ -7,7 +7,10 @@
 
 type 'a parser = string -> [ `Ok of 'a | `Error of string ]
 type 'a printer = Format.formatter -> 'a -> unit
-type 'a conv = 'a parser * 'a printer
+type 'a conv = 'a Cmdliner_base.conv = {
+  parse: 'a parser;
+  print: 'a printer;
+}
 type 'a converter = 'a conv
 
 val conv :

src/cmdliner_base.ml

@@ -147,61 +147,68 @@ let err_sep_miss sep s =
 
 type 'a parser = string -> [ `Ok of 'a | `Error of string ]
 type 'a printer = Format.formatter -> 'a -> unit
-type 'a conv = 'a parser * 'a printer
+type 'a conv = {
+  parse: 'a parser;
+  print: '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 some ?(none = "") conv =
+  let parse s = match conv.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
+  | Some v -> conv.print ppf v
   in
-  parse, print
+  {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 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 -> print ppf v)
-  | Some v -> print ppf v
+  | None -> (match none with None -> () | Some v -> conv.print ppf v)
+  | Some v -> conv.print ppf v
   in
-  parse, print
+  {parse; print}
 
 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, Format.pp_print_bool
+  {parse; print=Format.pp_print_bool}
 
 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, pp_char
+  {parse; print=pp_char}
 
 let parse_with t_of_str exp s =
   try `Ok (t_of_str s) with Failure _ -> `Error (err_invalid_val s exp)
 
 let int =
-  parse_with int_of_string "expected an integer", Format.pp_print_int
+  let parse = parse_with int_of_string "expected an integer" in
+  {parse; print=Format.pp_print_int}
 
 let int32 =
-  parse_with Int32.of_string "expected a 32-bit integer",
-  (fun ppf -> pp ppf "%ld")
+  let parse = parse_with Int32.of_string "expected a 32-bit integer" in
+  let print ppf = pp ppf "%ld" in
+  {parse; print}
 
 let int64 =
-  parse_with Int64.of_string "expected a 64-bit integer",
-  (fun ppf -> pp ppf "%Ld")
+  let parse = parse_with Int64.of_string "expected a 64-bit integer" in
+  let print ppf = pp ppf "%Ld" in
+  {parse; print}
 
 let nativeint =
-  parse_with Nativeint.of_string "expected a processor-native integer",
-  (fun ppf -> pp ppf "%nd")
+  let parse = parse_with Nativeint.of_string "expected a processor-native integer" in
+  let print ppf = pp ppf "%nd" in
+  {parse; print}
 
 let float =
-  parse_with float_of_string "expected a floating point number",
-  Format.pp_print_float
+  let parse = parse_with float_of_string "expected a floating point number" in
+  {parse; print=Format.pp_print_float}
 
-let string = (fun s -> `Ok s), pp_str
+let string = {parse=(fun s -> `Ok s); print=pp_str}
 let enum sl =
   if sl = [] then invalid_arg err_empty_list else
   let t = Cmdliner_trie.of_list sl in
@@ -219,28 +226,28 @@ 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
+  {parse; print}
 
 let file =
   let parse s = match Sys.file_exists s with
   | true -> `Ok s
   | false -> `Error (err_no "file or directory" s)
   in
-  parse, pp_str
+  {parse; print=pp_str}
 
 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, pp_str
+  {parse; print=pp_str}
 
 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, pp_str
+  {parse; print=pp_str}
 
 let split_and_parse sep parse s = (* raises [Failure] *)
   let parse sub = match parse sub with
@@ -258,25 +265,25 @@ let split_and_parse sep parse s = (* raises [Failure] *)
   in
   split [] (String.length s - 1)
 
-let list ?(sep = ',') (parse, pp_e) =
-  let parse s = try `Ok (split_and_parse sep parse s) with
+let list ?(sep = ',') conv =
+  let parse s = try `Ok (split_and_parse sep conv.parse s) with
   | Failure e -> `Error (err_element "list" s e)
   in
   let rec print ppf = function
-  | v :: l -> pp_e ppf v; if (l <> []) then (pp_char ppf sep; print ppf l)
+  | v :: l -> conv.print ppf v; if (l <> []) then (pp_char ppf sep; print ppf l)
   | [] -> ()
   in
-  parse, print
+  {parse; print}
 
-let array ?(sep = ',') (parse, pp_e) =
-  let parse s = try `Ok (Array.of_list (split_and_parse sep parse s)) with
+let array ?(sep = ',') conv =
+  let parse s = try `Ok (Array.of_list (split_and_parse sep conv.parse s)) with
   | Failure e -> `Error (err_element "array" s e)
   in
   let print ppf v =
     let max = Array.length v - 1 in
-    for i = 0 to max do pp_e ppf v.(i); if i <> max then pp_char ppf sep done
+    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}
 
 let split_left sep s =
   try
@@ -285,36 +292,36 @@ let split_left sep s =
     Some ((String.sub s 0 i), (String.sub s (i + 1) (len - i - 1)))
   with Not_found -> None
 
-let pair ?(sep = ',') (pa0, pr0) (pa1, pr1) =
-  let parser s = match split_left sep s with
+let pair ?(sep = ',') conv0 conv1 =
+  let parse s = match split_left sep s with
   | None -> `Error (err_sep_miss sep s)
   | Some (v0, v1) ->
-      match pa0 v0, pa1 v1 with
+      match conv0.parse v0, conv1.parse v1 with
       | `Ok v0, `Ok v1 -> `Ok (v0, v1)
       | `Error e, _ | _, `Error e -> `Error (err_element "pair" s e)
   in
-  let printer ppf (v0, v1) = pp ppf "%a%c%a" pr0 v0 sep pr1 v1 in
-  parser, printer
+  let print ppf (v0, v1) = pp ppf "%a%c%a" conv0.print v0 sep conv1.print v1 in
+  {parse; print}
 
 let t2 = pair
-let t3 ?(sep = ',') (pa0, pr0) (pa1, pr1) (pa2, pr2) =
+let t3 ?(sep = ',') conv0 conv1 conv2 =
   let parse s = match split_left sep s with
   | None -> `Error (err_sep_miss sep s)
   | Some (v0, s) ->
       match split_left sep s with
       | None -> `Error (err_sep_miss sep s)
       | Some (v1, v2) ->
-          match pa0 v0, pa1 v1, pa2 v2 with
+          match conv0.parse v0, conv1.parse v1, conv2.parse v2 with
           | `Ok v0, `Ok v1, `Ok v2 -> `Ok (v0, v1, v2)
           | `Error e, _, _ | _, `Error e, _ | _, _, `Error e ->
               `Error (err_element "triple" s e)
   in
   let print ppf (v0, v1, v2) =
-    pp ppf "%a%c%a%c%a" pr0 v0 sep pr1 v1 sep pr2 v2
+    pp ppf "%a%c%a%c%a" conv0.print v0 sep conv1.print v1 sep conv2.print v2
   in
-  parse, print
+  {parse; print}
 
-let t4 ?(sep = ',') (pa0, pr0) (pa1, pr1) (pa2, pr2) (pa3, pr3) =
+let t4 ?(sep = ',') conv0 conv1 conv2 conv3 =
   let parse s = match split_left sep s with
   | None -> `Error (err_sep_miss sep s)
   | Some(v0, s) ->
@@ -324,15 +331,15 @@ let t4 ?(sep = ',') (pa0, pr0) (pa1, pr1) (pa2, pr2) (pa3, pr3) =
           match split_left sep s with
           | None -> `Error (err_sep_miss sep s)
           | Some (v2, v3) ->
-              match pa0 v0, pa1 v1, pa2 v2, pa3 v3 with
+              match conv0.parse v0, conv1.parse v1, conv2.parse v2, conv3.parse v3 with
               | `Ok v1, `Ok v2, `Ok v3, `Ok v4 -> `Ok (v1, v2, v3, v4)
               | `Error e, _, _, _ | _, `Error e, _, _ | _, _, `Error e, _
               | _, _, _, `Error e -> `Error (err_element "quadruple" s e)
   in
   let print ppf (v0, v1, v2, v3) =
-    pp ppf "%a%c%a%c%a%c%a" pr0 v0 sep pr1 v1 sep pr2 v2 sep pr3 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}
 
 let env_bool_parse s = match String.lowercase_ascii s with
 | "" | "false" | "no" | "n" | "0" -> `Ok false

src/cmdliner_base.mli

@@ -32,7 +32,7 @@ val err_multi_def :
 
 type 'a parser = string -> [ `Ok of 'a | `Error of string ]
 type 'a printer = Format.formatter -> 'a -> unit
-type 'a conv = 'a parser * 'a printer
+type 'a conv = {parse: 'a parser; print: 'a printer}
 
 val some : ?none:string -> 'a conv -> 'a option conv
 val some' : ?none:'a -> 'a conv -> 'a option conv

test/darcs_ex.ml

@@ -27,12 +27,13 @@ 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 conv = Cmdliner.Arg.enum (List.rev_map (fun s -> (s, s)) topics) in
+    let parse = Cmdliner.Arg.conv_parser conv in
+    match parse topic with
+    | Error (`Msg 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)