The unpac monorepo manager self-hosting as a monorepo using unpac
Improve completion API (#215, #216)
+413
-256
+99
-43
vendor/opam/cmdliner/src/cmdliner.mli
+99
-43
vendor/opam/cmdliner/src/cmdliner.mli
···
628
628
629
629
(** Argument completion.
630
630
631
-
This modules provides a type to describe how argument values
632
-
described by {{!Arg.type-conv}argument converters} can be completed.
633
-
They define which completion directives from the
634
-
{{!page-cli.completion_protocol}protocol} get emitted by
635
-
cmdliner for the argument. *)
631
+
This module provides a type to describe how positional and
632
+
optional argument values described by {{!Arg.type-conv}argument
633
+
converters} can be completed. It defines which completion
634
+
directives from the {{!page-cli.completion_protocol}protocol}
635
+
get emitted by your tool for the argument.
636
+
637
+
{b Note.} Subcommand and option name
638
+
completion is done automatically by the library itself.
639
+
{{!Cmdliner.Arg.predef}Prefined argument converters} already
640
+
have completions built-in whenever appropriate. *)
636
641
module Completion : sig
637
642
638
-
type 'ctx func = 'ctx option -> prefix:string -> (string * string) list
639
-
(** The type for completion functions. Given a prefix should
640
-
return a list of possible completions and a doc string. *)
643
+
(** {1:directives Completion directives} *)
641
644
642
-
type 'a complete = Complete : 'ctx Term.t option * 'ctx func -> 'a complete
643
-
(** The type for completing. A completion context specification
644
-
and a completion function. *)
645
+
type 'a directive
646
+
(** The type for a completion directive for values of type ['a]. *)
645
647
646
-
type 'a t
647
-
(** The type for completing values parsed into values of type ['a]. *)
648
+
val value : ?doc:string -> 'a -> 'a directive
649
+
(** [value v ~doc] indicates that the token to complete could be
650
+
replaced by the value [v] as serialized by the argument's
651
+
formatter {!Conv.pp}. [doc] is ANSI styled UTF-8 text
652
+
documenting the value, defaults to [""]. *)
648
653
649
-
val make :
650
-
?context:'ctx Term.t -> ?func:'ctx func -> ?dirs:bool ->
651
-
?files:bool -> ?restart:bool -> unit -> 'a t
652
-
(** [make ()] is a completion specification with:
654
+
val string : ?doc:string -> string -> 'a directive
655
+
(** [string s ~doc] indicates that the token to complete could be
656
+
replaced by the string [s]. [doc] is ANSI styled UTF-8 text
657
+
documenting the value, defaults to [""]. *)
653
658
654
-
[context] is a command line is command line completion
655
-
context. During completion the command line fragment of the
656
-
context is parsed, if successful the result is given to the
657
-
completion function. Note that [context] must be part of the
658
-
term of the command in which you use that completion otherwhise
659
-
the context will always be [None] in the function.
659
+
val files : 'a directive
660
+
(** [files] indicates that the token to complete could be replaced
661
+
with files that the shell deems suitable. *)
660
662
661
-
See accessors for semantics. Note that the properties are
662
-
not mutually exclusive. *)
663
+
val dirs : 'a directive
664
+
(** [dirs] indicates that the token to complete could be replaced with
665
+
directories that the shell deems suitable. *)
663
666
664
-
val complete : 'a t -> 'a complete
665
-
(** [complete c] is a the context and function to perform completion. *)
666
-
667
-
val dirs : 'a t -> bool
668
-
(** [dirs c] indicates the argument should be completed with directories. *)
669
-
670
-
val files : 'a t -> bool
671
-
(** [files c] indicates the argument should be completed with files. *)
672
-
673
-
val restart : 'a t -> bool
674
-
(** [restart c] indicates that shell should restart the completion
667
+
val restart : 'a directive
668
+
(** [restart] indicates that the shell should restart the completion
675
669
after the positional disambiguation token [--].
676
670
677
671
This is typically used for tools that end-up invoking other
···
681
675
your program you'd eschew [restart] on the first postional
682
676
argument but add it to the remaining ones.
683
677
684
-
{b Warning.} Other completion properties are ignored when you
685
-
use this. Also note that [restart] directives are emitted only
686
-
after a [--] token and it's likely that it will work with
687
-
completion scripts only if the [TOOL] is specified after the
688
-
token. Educate your users to use the [--] (e.g. mention them
689
-
in user {{!page-cookbook.manpage_synopsis}user defined
690
-
synopses}) it's good cli specification hygiene anyways. *)
678
+
{b Warning.} A [restart] directive is eventually emited only
679
+
if the completion is requested after a [--] token. In this
680
+
case other completions returned alongside by {!func} are
681
+
ignored. Educate your users to use the [--], for example
682
+
mention them in {{!page-cookbook.manpage_synopsis}user defined
683
+
synopses}. It is good cli specification hygiene anyways as it
684
+
properly delineates argument scopes. *)
685
+
686
+
val raw : string -> 'a directive
687
+
(** [raw s] takes over the whole {{!page-cli.completion_protocol}protocol}
688
+
output (including subcommand and option name completion) with [s],
689
+
you are in charge. Any other directive in the result of {!func}
690
+
is ignored.
691
+
692
+
{b Warning.} The protocol is unstable, it is not advised to
693
+
output it yourself. *)
694
+
695
+
(** {1:completion Completion} *)
696
+
697
+
type ('ctx, 'a) func =
698
+
'ctx option -> token:string -> ('a directive list, string) result
699
+
(** The type for completion functions.
700
+
701
+
Given an optional context determined from a partial command
702
+
line parse and a token to complete it returns a list of
703
+
completion directives or an error which is reported to
704
+
end-users via the protocol. *)
705
+
706
+
type 'a complete =
707
+
| Complete : 'ctx Term.t option * ('ctx, 'a) func -> 'a complete (** *)
708
+
(** The type for completing.
709
+
710
+
A completion context specification which captures a partial
711
+
command line parse (for example the path to a configuration
712
+
file) and a completion function. *)
713
+
714
+
type 'a t
715
+
(** The type for completing values parsed into values of type ['a]. *)
716
+
717
+
val make : ?context:'ctx Term.t -> ('ctx, 'a) func -> 'a t
718
+
(** [make ~context func] uses [func] to complete.
719
+
720
+
[context] defines a commmand line fragment that is evaluated
721
+
before performing the completion. It the evaluation is
722
+
successful the result is given to the completion function otherwise
723
+
[None] is given.
724
+
725
+
{b Warning.} [context] must be part of the term of the command
726
+
in which you use the completion otherwise the context will
727
+
always be [None] in the function. *)
728
+
729
+
val complete : 'a t -> 'a complete
730
+
(** [complete c] completes with [c]. *)
731
+
732
+
val complete_files : 'a t
733
+
(** [complete_files] holds a context insensitive function that
734
+
always returns [Ok \[]{!files}[\]]. *)
735
+
736
+
val complete_dirs : 'a t
737
+
(** [complete_dirs] holds a context insensitive function that
738
+
always returns [Ok \[]{!dirs}[\]]. *)
739
+
740
+
val complete_paths : 'a t
741
+
(** [complete_paths] holds a context insensitive function that
742
+
always returns [Ok \[]{!files}[;]{!dirs}{[\]]. *)
743
+
744
+
val complete_restart : 'a t
745
+
(** [complete_dirs] holds a context insensitive function that
746
+
always returns [Ok \[]{!restart}[\]]. *)
691
747
end
692
748
693
749
(** Argument converters.
+19
-11
vendor/opam/cmdliner/src/cmdliner_arg.ml
+19
-11
vendor/opam/cmdliner/src/cmdliner_arg.ml
···
67
67
(* Arguments *)
68
68
69
69
let no_completion =
70
-
Cmdliner_def.Arg_info.Completion Cmdliner_def.Arg_completion.none
70
+
Cmdliner_def.Arg_info.Completion Cmdliner_def.Arg_completion.complete_none
71
71
72
72
let ( & ) f x = f x
73
73
let parse_error e = Error (`Parse e)
···
331
331
332
332
(* Predefined converters. *)
333
333
334
+
let add_prefix_completion ~token name =
335
+
if Cmdliner_base.string_starts_with ~prefix:token name
336
+
then Some (Completion.string name) else None
337
+
334
338
let bool =
335
339
let alts = ["true"; "false"] in
336
340
let parser s = try Ok (bool_of_string s) with
337
341
| Invalid_argument _ -> Error (err_invalid_enum "" s alts)
338
342
in
339
343
let completion =
340
-
let func _ctx ~prefix:_ = List.map (fun s -> s, "") alts in
341
-
Completion.make ~func ()
344
+
let func _ctx ~token =
345
+
Ok (List.filter_map (add_prefix_completion ~token) alts)
346
+
in
347
+
Completion.make func
342
348
in
343
349
Conv.make ~docv:"BOOL" ~parser ~pp:Format.pp_print_bool ~completion ()
344
350
···
398
404
with Not_found -> invalid_arg (err_incomplete_enum (List.map fst sl))
399
405
in
400
406
let completion =
401
-
let func _ctx ~prefix:_ = List.map (fun (s, _) -> s, "") sl in
402
-
Completion.make ~func ()
407
+
let func _ctx ~token =
408
+
Ok (List.filter_map (fun (n, _) -> add_prefix_completion ~token n) sl)
409
+
in
410
+
Completion.make func
403
411
in
404
412
Conv.make ~docv ~parser ~pp ~completion ()
405
413
406
414
let path =
407
415
let parser s = Ok s in
408
416
let pp ppf s = Fmt.string ppf (Filename.quote s) in
409
-
let completion = Completion.make ~dirs:true ~files:true () in
417
+
let completion = Completion.complete_paths in
410
418
Conv.make ~docv:"PATH" ~parser ~pp ~completion ()
411
419
412
420
let filepath =
413
421
let parser s = Ok s in
414
422
let pp ppf s = Fmt.string ppf (Filename.quote s) in
415
-
let completion = Completion.make ~files:true () in
423
+
let completion = Completion.complete_files in
416
424
Conv.make ~docv:"FILE" ~parser ~pp ~completion ()
417
425
418
426
let dirpath =
419
427
let parser s = Ok s in
420
428
let pp ppf s = Fmt.string ppf (Filename.quote s) in
421
-
let completion = Completion.make ~dirs:true () in
429
+
let completion = Completion.complete_dirs in
422
430
Conv.make ~docv:"DIR" ~parser ~pp ~completion ()
423
431
424
432
let file =
···
427
435
if Sys.file_exists s then Ok s else
428
436
Error (err_no "file or directory" s)
429
437
in
430
-
let completion = Completion.make ~dirs:true ~files:true () in
438
+
let completion = Completion.complete_files in
431
439
Conv.make ~docv:"PATH" ~parser ~pp:Fmt.string ~completion ()
432
440
433
441
let dir =
···
436
444
then (if Sys.is_directory s then Ok s else Error (err_not_dir s))
437
445
else Error (err_no "directory" s)
438
446
in
439
-
let completion = Completion.make ~dirs:true () in
447
+
let completion = Completion.complete_dirs in
440
448
Conv.make ~docv:"DIR" ~parser ~pp:Fmt.string ~completion ()
441
449
442
450
let non_dir_file =
···
446
454
then (if not (Sys.is_directory s) then Ok s else Error (err_is_dir s))
447
455
else Error (err_no "file" s)
448
456
in
449
-
let completion = Completion.make ~files:true () in
457
+
let completion = Completion.complete_files in
450
458
Conv.make ~docv:"FILE" ~parser ~pp:Fmt.string ~completion ()
451
459
452
460
let split_and_parse sep parse s = (* raises [Failure] *)
+20
-10
vendor/opam/cmdliner/src/cmdliner_arg.mli
+20
-10
vendor/opam/cmdliner/src/cmdliner_arg.mli
···
10
10
type 'a conv
11
11
12
12
module Completion : sig
13
-
type 'ctx func = 'ctx option -> prefix:string -> (string * string) list
13
+
type 'a directive
14
+
15
+
val value : ?doc:string -> 'a -> 'a directive
16
+
val string : ?doc:string -> string -> 'a directive
17
+
val files : 'a directive
18
+
val dirs : 'a directive
19
+
val restart : 'a directive
20
+
val raw : string -> 'a directive
21
+
22
+
type ('ctx, 'a) func =
23
+
'ctx option -> token:string -> ('a directive list, string) result
24
+
14
25
type 'a complete =
15
-
| Complete : 'ctx Cmdliner_term.t option * 'ctx func -> 'a complete
26
+
| Complete : 'ctx Cmdliner_term.t option * ('ctx, 'a) func -> 'a complete
16
27
17
28
type 'a t
18
-
val make :
19
-
?context: 'ctx Cmdliner_term.t -> ?func:'ctx func -> ?dirs:bool ->
20
-
?files:bool -> ?restart:bool -> unit -> 'a t
29
+
30
+
val make : ?context:'ctx Cmdliner_term.t -> ('ctx, 'a) func -> 'a t
21
31
22
32
val complete : 'a t -> 'a complete
23
-
val dirs : 'a t -> bool
24
-
val files : 'a t -> bool
25
-
val restart : 'a t -> bool
26
-
val none : 'a t
27
-
val some : 'a t -> 'a option t
33
+
val complete_none : 'a t
34
+
val complete_files : 'a t
35
+
val complete_dirs : 'a t
36
+
val complete_paths : 'a t
37
+
val complete_restart : 'a t
28
38
end
29
39
30
40
module Conv : sig
+1
vendor/opam/cmdliner/src/cmdliner_base.ml
+1
vendor/opam/cmdliner/src/cmdliner_base.ml
+1
vendor/opam/cmdliner/src/cmdliner_base.mli
+1
vendor/opam/cmdliner/src/cmdliner_base.mli
+96
-69
vendor/opam/cmdliner/src/cmdliner_completion.ml
+96
-69
vendor/opam/cmdliner/src/cmdliner_completion.ml
···
3
3
SPDX-License-Identifier: ISC
4
4
---------------------------------------------------------------------------*)
5
5
6
-
(* Output protocol
6
+
(* Output protocol *)
7
7
8
-
This is a bit ugly we have logic and rendering intermingled. *)
8
+
let cons_if b v l = if b then v :: l else l
9
+
10
+
type dir =
11
+
[ `Dirs | `Error of string | `Files | `Group of string * (string * string) list
12
+
| `Restart ]
9
13
10
-
let pp_line ppf s = Cmdliner_base.Fmt.(string ppf s; cut ppf ())
11
-
let pp_group ppf s = pp_line ppf "group"; pp_line ppf s
12
-
let pp_item ppf ~prefix (name, doc) =
13
-
if Cmdliner_base.string_starts_with ~prefix name then begin
14
+
let pp_protocol ppf dirs =
15
+
let pp_line ppf s = Cmdliner_base.Fmt.(string ppf s; cut ppf ()) in
16
+
let vnum = 1 (* Protocol version number *) in
17
+
let pp_item ppf (name, doc) =
14
18
pp_line ppf "item";
15
19
pp_line ppf name;
16
-
Cmdliner_base.Fmt.(pf ppf "@[%a@]@," text doc);
20
+
Cmdliner_base.Fmt.(pf ppf "@[%a@]@," styled_text doc);
17
21
pp_line ppf "item-end";
18
-
end
22
+
in
23
+
let pp_dir ppf = function
24
+
| `Dirs -> pp_line ppf "dirs"
25
+
| `Files -> pp_line ppf "files"
26
+
| `Error msg -> failwith "TODO"
27
+
| `Restart -> pp_line ppf "restart"
28
+
| `Group (name, items) ->
29
+
pp_line ppf "group";
30
+
pp_line ppf name;
31
+
Cmdliner_base.Fmt.(list ~sep:nop pp_item) ppf items;
32
+
in
33
+
Cmdliner_base.Fmt.pf ppf "@[<v>%d@,%a@]" vnum
34
+
Cmdliner_base.Fmt.(list ~sep:nop pp_dir) dirs
19
35
20
-
let pp_opt ~err_ppf ~subst ~prefix ppf arg_info _ =
21
-
(* XXX should we rather list a single name ? *)
22
-
let names = Cmdliner_def.Arg_info.opt_names arg_info in
23
-
let subst = Cmdliner_def.Arg_info.doclang_subst ~subst arg_info in
24
-
let doc = Cmdliner_def.Arg_info.styled_doc ~errs:err_ppf ~subst arg_info in
25
-
List.iter (fun name -> pp_item ppf ~prefix (name, doc)) names
26
-
27
-
let pp_opt_names ~err_ppf ~subst ~prefix ppf cmd =
28
-
let info = Cmdliner_cmd.get_info cmd in
29
-
let set = Cmdliner_def.Cmd_info.args info in
30
-
if not (Cmdliner_def.Arg_info.Set.is_empty set) then begin
31
-
let arg_infos = Cmdliner_def.Cmd_info.args info in
32
-
pp_group ppf "Options";
33
-
Cmdliner_def.Arg_info.Set.iter (pp_opt ~err_ppf ~subst ~prefix ppf)
34
-
arg_infos
35
-
end
36
-
37
-
let pp_arg_values ~after_dashdash ~prefix items ppf comp =
38
-
if after_dashdash && Cmdliner_def.Arg_completion.restart comp
39
-
then pp_line ppf "restart" else
40
-
let items = items () in
41
-
let comp_files = Cmdliner_def.Arg_completion.files comp in
42
-
let comp_dirs = Cmdliner_def.Arg_completion.dirs comp in
43
-
if items <> [] || comp_files || comp_dirs then begin
44
-
pp_group ppf "Values";
45
-
List.iter (pp_item ppf ~prefix) items;
46
-
if comp_files then pp_line ppf "files";
47
-
if comp_dirs then pp_line ppf "dirs"
48
-
end
49
-
50
-
let pp_subcmds ~err_ppf ~subst ~prefix ppf cmd =
51
-
pp_group ppf "Subcommands";
52
-
let complete_cmd cmd =
36
+
let add_subcommands_group ~err_ppf ~subst cmd comp directives =
37
+
if not (Cmdliner_def.Complete.subcmds comp) then directives else
38
+
let prefix = Cmdliner_def.Complete.prefix comp in
39
+
let maybe_item cmd =
53
40
let name = Cmdliner_def.Cmd_info.name cmd in
41
+
if not (Cmdliner_base.string_starts_with ~prefix name) then None else
54
42
(* FIXME subst is wrong here. *)
55
43
let doc = Cmdliner_def.Cmd_info.styled_doc ~errs:err_ppf ~subst cmd in
56
-
pp_item ppf ~prefix (name, doc)
44
+
Some (name, doc)
45
+
in
46
+
let subcmds = Cmdliner_cmd.get_children_infos cmd in
47
+
(`Group ("Subcommands", List.filter_map maybe_item subcmds)) :: directives
48
+
49
+
let add_options_group ~err_ppf ~subst cmd comp directives =
50
+
let prefix = Cmdliner_def.Complete.prefix comp in
51
+
let maybe_items arg_info =
52
+
let names = Cmdliner_def.Arg_info.opt_names arg_info in
53
+
let subst = Cmdliner_def.Arg_info.doclang_subst ~subst arg_info in
54
+
let doc = Cmdliner_def.Arg_info.styled_doc ~errs:err_ppf ~subst arg_info in
55
+
let add_name n =
56
+
if not (Cmdliner_base.string_starts_with ~prefix n) then None else
57
+
Some (n, doc)
58
+
in
59
+
List.filter_map add_name names
57
60
in
58
-
List.iter complete_cmd (Cmdliner_cmd.get_children_infos cmd)
61
+
let maybe_opt = prefix = "" || prefix.[0] = '-' in
62
+
if Cmdliner_def.Complete.after_dashdash comp || not maybe_opt
63
+
then directives else
64
+
let info = Cmdliner_cmd.get_info cmd in
65
+
let set = Cmdliner_def.Cmd_info.args info in
66
+
if Cmdliner_def.Arg_info.Set.is_empty set then directives else
67
+
let options = Cmdliner_def.Arg_info.Set.elements set in
68
+
`Group ("Options", List.concat (List.map maybe_items options)) :: directives
59
69
60
-
let vnum = 1 (* Protocol version number *)
70
+
let add_argument_value_directives directives comp =
71
+
let Directives ds = Cmdliner_def.Complete.directives comp in
72
+
match ds with
73
+
| Error msg -> `Directives [`Error msg]
74
+
| Ok ds ->
75
+
let rec loop values ~files ~dirs ~restart ~raw = function
76
+
| [] ->
77
+
begin match raw with
78
+
| Some r -> `Raw r
79
+
| None ->
80
+
if Cmdliner_def.Complete.after_dashdash comp && restart
81
+
then `Directives [`Restart] else
82
+
let dd =
83
+
cons_if dirs `Dirs @@
84
+
cons_if files `Files @@
85
+
cons_if (values <> []) (`Group ("Values", List.rev values)) []
86
+
in
87
+
`Directives (List.rev_append dd directives)
88
+
end
89
+
| d :: ds ->
90
+
match d with
91
+
| Cmdliner_def.Arg_completion.String (s, doc) ->
92
+
loop ((s, doc) :: values) ~files ~dirs ~restart ~raw ds
93
+
| Value (_, _) -> failwith "TODO"
94
+
| Files -> loop values ~files:true ~dirs ~restart ~raw ds
95
+
| Dirs -> loop values ~files ~dirs:true ~restart ~raw ds
96
+
| Restart -> loop values ~files ~dirs ~restart:true ~raw ds
97
+
| Raw r -> loop values ~files ~dirs ~restart ~raw:(Some r) ds
98
+
in
99
+
loop [] ~files:false ~dirs:false ~restart:false ~raw:None ds
61
100
62
-
let output ~out_ppf ~err_ppf ei cmd_args_info cmd comp ~items =
101
+
let output ~out_ppf ~err_ppf ei cmd_args_info cmd comp =
63
102
let subst = Cmdliner_def.Eval.doclang_subst ei in
64
-
let after_dashdash = Cmdliner_def.Complete.after_dashdash comp in
65
-
let prefix = Cmdliner_def.Complete.prefix comp in
66
-
let maybe_opt = prefix = "" || prefix.[0] = '-' in
67
-
let pp_arg_value ppf arg_info =
68
-
begin match Cmdliner_def.Arg_info.Set.find_opt arg_info cmd_args_info with
69
-
| None -> ()
70
-
| Some (Completion comp) ->
71
-
pp_arg_values ~after_dashdash ~prefix items ppf comp
72
-
end;
103
+
let dirs = add_subcommands_group ~err_ppf ~subst cmd comp [] in
104
+
let res = match Cmdliner_def.Complete.kind comp with
105
+
| Opt_value _arg_info (* XXX need to handle Value *) ->
106
+
add_argument_value_directives dirs comp
107
+
| Opt_name_or_pos_value arg_info (* XXX need to handle Value *) ->
108
+
let dirs = add_options_group ~err_ppf ~subst cmd comp dirs in
109
+
add_argument_value_directives dirs comp
110
+
| Opt_name ->
111
+
`Directives (add_options_group ~err_ppf ~subst cmd comp dirs)
73
112
in
74
-
let pp ppf () =
75
-
begin match Cmdliner_def.Complete.kind comp with
76
-
| Opt_value arg_info -> pp_arg_value ppf arg_info
77
-
| Opt_name_or_pos_value arg_info ->
78
-
pp_arg_value ppf arg_info;
79
-
if not after_dashdash && maybe_opt
80
-
then pp_opt_names ~err_ppf ~subst ~prefix ppf cmd
81
-
| Opt_name ->
82
-
if not after_dashdash && maybe_opt
83
-
then pp_opt_names ~err_ppf ~subst ~prefix ppf cmd;
84
-
end;
85
-
if Cmdliner_def.Complete.subcmds comp
86
-
then pp_subcmds ~err_ppf ~subst ~prefix ppf cmd
87
-
in
88
-
Cmdliner_base.Fmt.pf out_ppf "@[<v>%d@,%a@]@?" vnum pp ()
113
+
match res with
114
+
| `Raw raw -> Cmdliner_base.Fmt.pf out_ppf "%s@?" raw
115
+
| `Directives dirs -> Cmdliner_base.Fmt.pf out_ppf "%a@?" pp_protocol dirs
-1
vendor/opam/cmdliner/src/cmdliner_completion.mli
-1
vendor/opam/cmdliner/src/cmdliner_completion.mli
+93
-62
vendor/opam/cmdliner/src/cmdliner_def.ml
+93
-62
vendor/opam/cmdliner/src/cmdliner_def.ml
···
202
202
[ `Error of bool * string
203
203
| `Help of Cmdliner_manpage.format * string option ]
204
204
205
-
type 'ctx func = 'ctx option -> prefix:string -> (string * string) list
206
-
type 'a complete = Complete : 'ctx term option * 'ctx func -> 'a complete
207
-
and 'a completion =
208
-
{ complete : 'a complete;
209
-
dirs : bool;
210
-
files : bool;
211
-
restart : bool }
205
+
type 'a completion_directive =
206
+
| String of string * string | Value of 'a * string | Files | Dirs | Restart
207
+
| Raw of string
212
208
209
+
type ('ctx, 'a) completion_func =
210
+
'ctx option -> token:string -> ('a completion_directive list, string) result
211
+
212
+
type 'a complete =
213
+
| Complete : 'ctx term option * ('ctx, 'a) completion_func -> 'a complete
214
+
215
+
and 'a completion = { complete : 'a complete }
213
216
and e_completion = Completion : 'a completion -> e_completion
214
217
and arg_set = e_completion Map.t
215
-
216
218
and cmd =
217
219
{ name : string; (* name of the cmd. *)
218
220
version : string option; (* version (for --version). *)
···
342
344
| _ -> None
343
345
end
344
346
345
-
(* Completion *)
346
-
347
-
module Complete = struct
348
-
type kind =
349
-
| Opt_value of Arg_info.t
350
-
| Opt_name_or_pos_value of Arg_info.t
351
-
| Opt_name
352
-
353
-
type t =
354
-
{ context : Cline.t;
355
-
prefix : string;
356
-
after_dashdash : bool;
357
-
subcmds : bool; (* Note this is adjusted in Cmdliner_eval *)
358
-
kind : kind;
359
-
values : (string * string) list }
360
-
361
-
let make ?(after_dashdash = false) ?(subcmds = false) context ~prefix kind =
362
-
{ context; prefix; after_dashdash; subcmds; kind; values = [] }
363
-
364
-
let add_subcmds c = { c with subcmds = true }
365
-
let add_values c values = { c with values }
366
-
let context c = c.context
367
-
let prefix c = c.prefix
368
-
let after_dashdash c = c.after_dashdash
369
-
let subcmds c = c.subcmds
370
-
let kind c = c.kind
371
-
end
372
-
373
347
(* Terms *)
374
348
375
349
module Term = struct
···
381
355
end
382
356
383
357
module Arg_completion = struct
384
-
type 'ctx func = 'ctx Arg_info.func
358
+
type 'a directive = 'a Arg_info.completion_directive =
359
+
| String of string * string | Value of 'a * string
360
+
| Files | Dirs | Restart | Raw of string
361
+
362
+
let value ?(doc = "") v = Value (v, doc)
363
+
let string ?(doc = "") s = String (s, doc)
364
+
let files = Files
365
+
let dirs = Dirs
366
+
let restart = Restart
367
+
let raw s = Raw s
368
+
369
+
type ('ctx, 'a) func =
370
+
'ctx option -> token:string -> ('a directive list, string) result
385
371
386
372
type 'a complete = 'a Arg_info.complete =
387
-
| Complete : 'ctx Term.t option * 'ctx func -> 'a complete
373
+
| Complete : 'ctx Term.t option * ('ctx, 'a) func -> 'a complete
388
374
389
375
type 'a t = 'a Arg_info.completion
390
376
391
-
let make
392
-
?context ?(func = fun _ ~prefix:_ -> []) ?(dirs = false) ?(files = false)
393
-
?(restart = false) () : 'a t
394
-
=
395
-
{ complete = Complete (context, func); dirs; files; restart }
377
+
let make ?context func : 'a t = { complete = Complete (context, func) }
378
+
let complete (c : 'a t) = c.complete
379
+
380
+
let complete_files : 'a t =
381
+
{ complete = Complete (None, fun _ ~token:_ -> Ok [Files]) }
382
+
383
+
let complete_dirs : 'a t =
384
+
{ complete = Complete (None, fun _ ~token:_ -> Ok [Dirs]) }
385
+
386
+
let complete_paths : 'a t =
387
+
{ complete = Complete (None, fun _ ~token:_ -> Ok [Files; Dirs]) }
388
+
389
+
let complete_restart : 'a t =
390
+
{ complete = Complete (None, fun _ ~token:_ -> Ok [Restart]) }
396
391
397
-
let none : 'a t =
398
-
{ complete = Complete (None, fun _ ~prefix:_ -> []);
399
-
dirs = false; files = false; restart = false }
392
+
let complete_none : 'a t =
393
+
{ complete = Complete (None, fun _ ~token:_ -> Ok []) }
400
394
401
-
let some c : 'a option t = match c.Arg_info.complete with
402
-
| Complete (ctx, func) -> { c with complete = Complete (ctx, func) }
395
+
let directive_some : 'a directive -> 'a option directive = function
396
+
| Value (v, doc) -> Value (Some v, doc)
397
+
| (String _ | Files | Dirs | Restart | Raw _ as v) -> v
403
398
404
-
let complete (c : 'a t) = c.complete
405
-
let dirs (c : 'a t) = c.dirs
406
-
let files (c : 'a t) = c.files
407
-
let restart (c : 'a t) = c.restart
399
+
let complete_some (c : 'a t) : 'a option t = match c.complete with
400
+
| Complete (ctx, func) ->
401
+
let func ctx ~token =
402
+
let some_result directives = List.map directive_some directives in
403
+
Result.map some_result (func ctx ~token)
404
+
in
405
+
{ complete = Complete (ctx, func) }
408
406
end
409
407
410
408
(* Converters *)
···
418
416
pp : 'a fmt;
419
417
completion : 'a Arg_completion.t; }
420
418
421
-
let make ?(completion = Arg_completion.none) ~docv ~parser ~pp () =
419
+
let make ?(completion = Arg_completion.complete_none) ~docv ~parser ~pp () =
422
420
{ docv; parser; pp; completion }
423
421
424
422
let of_conv
···
434
432
let completion c = c.completion
435
433
436
434
let some ?(none = "") conv =
437
-
let parser s = match parser conv s with
438
-
| Ok v -> Ok (Some v) | Error _ as e -> e
439
-
in
435
+
let parser s = Result.map Option.some (parser conv s) in
440
436
let pp ppf v = match v with
441
437
| None -> Format.pp_print_string ppf none
442
438
| Some v -> pp conv ppf v
443
439
in
444
-
let completion = Arg_completion.some (completion conv) in
440
+
let completion = Arg_completion.complete_some (completion conv) in
445
441
{ conv with parser; pp; completion }
446
442
447
443
let some' ?none conv =
448
-
let parser s = match parser conv s with
449
-
| Ok v -> Ok (Some v) | Error _ as e -> e
450
-
in
444
+
let parser s = Result.map Option.some (parser conv s) in
451
445
let pp ppf = function
452
446
| None -> (match none with None -> () | Some v -> (pp conv) ppf v)
453
447
| Some v -> pp conv ppf v
454
448
in
455
-
let completion = Arg_completion.some conv.completion in
456
-
{ conv with parser; pp; completion }
449
+
let completion = Arg_completion.complete_some conv.completion in
450
+
{ conv with parser; pp; completion }
451
+
end
452
+
453
+
454
+
455
+
(* Completion *)
456
+
457
+
module Complete = struct
458
+
type kind =
459
+
| Opt_value of Arg_info.t
460
+
| Opt_name_or_pos_value of Arg_info.t
461
+
| Opt_name
462
+
463
+
type directives =
464
+
Directives : ('a Arg_completion.directive list, string) result -> directives
465
+
466
+
type t =
467
+
{ context : Cline.t;
468
+
prefix : string;
469
+
after_dashdash : bool;
470
+
subcmds : bool; (* Note this is adjusted in Cmdliner_eval *)
471
+
kind : kind;
472
+
directives : directives }
473
+
474
+
let make ?(after_dashdash = false) ?(subcmds = false) context ~prefix kind =
475
+
{ context; prefix; after_dashdash; subcmds; kind;
476
+
directives = Directives (Ok []) }
477
+
478
+
let add_subcmds c = { c with subcmds = true }
479
+
let add_directives directives c =
480
+
{ c with directives = Directives directives }
481
+
482
+
let context c = c.context
483
+
let prefix c = c.prefix
484
+
let after_dashdash c = c.after_dashdash
485
+
let subcmds c = c.subcmds
486
+
let kind c = c.kind
487
+
let directives c = c.directives
457
488
end
+56
-32
vendor/opam/cmdliner/src/cmdliner_def.mli
+56
-32
vendor/opam/cmdliner/src/cmdliner_def.mli
···
117
117
val styled_doc :
118
118
errs:Format.formatter -> subst:Cmdliner_manpage.subst -> t -> string
119
119
120
+
module Map : Map.S with type key := t
121
+
120
122
type 'a completion
121
123
type e_completion = Completion : 'a completion -> e_completion
122
-
module Map : Map.S with type key := t
124
+
123
125
module Set : sig
124
126
type arg := t
125
127
type t
···
195
197
val doclang_subst : t -> Cmdliner_manpage.subst
196
198
end
197
199
198
-
(** Complete instruction. *)
199
-
module Complete : sig
200
-
type kind =
201
-
| Opt_value of Arg_info.t
202
-
| Opt_name_or_pos_value of Arg_info.t
203
-
| Opt_name
204
-
205
-
type t
206
-
207
-
val make :
208
-
?after_dashdash:bool -> ?subcmds:bool -> Cline.t -> prefix:string ->
209
-
kind -> t
210
-
211
-
val context : t -> Cline.t
212
-
val add_subcmds : t -> t
213
-
val prefix : t -> string
214
-
val after_dashdash : t -> bool
215
-
val subcmds : t -> bool
216
-
val kind : t -> kind
217
-
end
218
-
219
200
(** Terms, typed cli fragment definitions. *)
220
201
module Term : sig
221
202
type escape =
···
230
211
231
212
(** Completion strategies *)
232
213
module Arg_completion : sig
214
+
type 'a directive =
215
+
| String of string * string | Value of 'a * string
216
+
| Files | Dirs | Restart | Raw of string
233
217
234
-
type 'ctx func = 'ctx option -> prefix:string -> (string * string) list
235
-
type 'a complete = Complete : 'ctx Term.t option * 'ctx func -> 'a complete
218
+
val value : ?doc:string -> 'a -> 'a directive
219
+
val string : ?doc:string -> string -> 'a directive
220
+
val files : 'a directive
221
+
val dirs : 'a directive
222
+
val restart : 'a directive
223
+
val raw : string -> 'a directive
224
+
225
+
type ('ctx, 'a) func =
226
+
'ctx option -> token:string -> ('a directive list, string) result
227
+
228
+
type 'a complete =
229
+
| Complete : 'ctx Term.t option * ('ctx, 'a) func -> 'a complete
230
+
236
231
type 'a t = 'a Arg_info.completion
237
-
val make :
238
-
?context:'ctx Term.t -> ?func:'ctx func -> ?dirs:bool -> ?files:bool ->
239
-
?restart:bool -> unit -> 'a t
240
232
241
-
val none : 'a t
242
-
val some : 'a t -> 'a option t
233
+
val make : ?context:'ctx Term.t -> ('ctx, 'a) func -> 'a t
243
234
val complete : 'a t -> 'a complete
244
-
val dirs : 'a t -> bool
245
-
val files : 'a t -> bool
246
-
val restart : 'a t -> bool
235
+
val complete_none : 'a t
236
+
val complete_files : 'a t
237
+
val complete_dirs : 'a t
238
+
val complete_paths : 'a t
239
+
val complete_restart : 'a t
247
240
end
248
241
249
242
(** Textual OCaml value converters *)
···
267
260
val some : ?none:string -> 'a t -> 'a option t
268
261
val some' : ?none:'a -> 'a t -> 'a option t
269
262
end
263
+
264
+
265
+
(** Complete instruction. *)
266
+
module Complete : sig
267
+
type kind =
268
+
| Opt_value of Arg_info.t
269
+
| Opt_name_or_pos_value of Arg_info.t
270
+
| Opt_name
271
+
272
+
type directives =
273
+
Directives : ('a Arg_completion.directive list, string) result -> directives
274
+
275
+
type t
276
+
277
+
val make :
278
+
?after_dashdash:bool -> ?subcmds:bool -> Cline.t -> prefix:string ->
279
+
kind -> t
280
+
281
+
val context : t -> Cline.t
282
+
283
+
284
+
val add_subcmds : t -> t
285
+
val add_directives :
286
+
('a Arg_completion.directive list, string) result -> t -> t
287
+
288
+
val prefix : t -> string
289
+
val after_dashdash : t -> bool
290
+
val subcmds : t -> bool
291
+
val kind : t -> kind
292
+
val directives : t -> directives
293
+
end
+16
-15
vendor/opam/cmdliner/src/cmdliner_eval.ml
+16
-15
vendor/opam/cmdliner/src/cmdliner_eval.ml
···
107
107
Cmdliner_msg.pp_usage_and_err err_ppf ei ~err; Error `Parse
108
108
| `Complete (ei, cmd_args_info, cmd, comp) ->
109
109
(* TODO quick hack this should not happen here *)
110
-
let items () =
111
-
let prefix = Cmdliner_def.Complete.prefix comp in
110
+
let comp =
111
+
let token = Cmdliner_def.Complete.prefix comp in
112
112
let arg_info = match Cmdliner_def.Complete.kind comp with
113
113
| Opt_value arg_info -> Some arg_info
114
114
| Opt_name_or_pos_value arg_info -> Some arg_info
115
115
| _ -> None
116
116
in
117
117
match arg_info with
118
-
| None -> []
118
+
| None -> comp
119
119
| Some arg_info ->
120
120
match Cmdliner_def.Arg_info.Set.find_opt
121
121
arg_info cmd_args_info with
122
-
| None -> []
123
-
| Some (Completion c) ->
124
-
match Cmdliner_def.Arg_completion.complete c with
125
-
| Complete (ctx, func) ->
126
-
let cline = Cmdliner_def.Complete.context comp in
127
-
let ctx = match ctx with
128
-
| None -> None
129
-
| Some ctx ->
130
-
run_parser_for_completion_context ei cline ctx
131
-
in
132
-
func ctx ~prefix
122
+
| None -> comp
123
+
| Some (Completion c) -> (* FIXME we want converter here *)
124
+
match Cmdliner_def.Arg_completion.complete c with
125
+
| Complete (ctx, func) ->
126
+
let cline = Cmdliner_def.Complete.context comp in
127
+
let ctx = match ctx with
128
+
| None -> None
129
+
| Some ctx ->
130
+
run_parser_for_completion_context ei cline ctx
131
+
in
132
+
let dirs = func ctx ~token in
133
+
Cmdliner_def.Complete.add_directives dirs comp
133
134
in
134
135
Cmdliner_completion.output
135
-
~out_ppf:help_ppf ~err_ppf ei cmd_args_info cmd comp ~items; Ok `Help
136
+
~out_ppf:help_ppf ~err_ppf ei cmd_args_info cmd comp; Ok `Help
136
137
| `Help (fmt, cmd_name) ->
137
138
do_help ~env help_ppf err_ppf ei fmt cmd_name; Ok `Help
138
139
| `Exn (e, bt) ->
+4
-6
vendor/opam/cmdliner/test/test_completion.ml
+4
-6
vendor/opam/cmdliner/test/test_completion.ml
···
216
216
Options\n\
217
217
item\n\
218
218
-k\n\
219
-
\u{001B}[04mENUM\u{001B}[m restricts the animal kind. Must be either \u{001B}[01mbird\u{001B}[m or\n\
220
-
\u{001B}[01mfish\u{001B}[m\n\
219
+
\u{001B}[04mENUM\u{001B}[m restricts the animal kind. Must be either \u{001B}[01mbird\u{001B}[m or \u{001B}[01mfish\u{001B}[m\n\
221
220
item-end\n\
222
221
item\n\
223
222
--kind\n\
224
-
\u{001B}[04mENUM\u{001B}[m restricts the animal kind. Must be either \u{001B}[01mbird\u{001B}[m or\n\
225
-
\u{001B}[01mfish\u{001B}[m\n\
223
+
\u{001B}[04mENUM\u{001B}[m restricts the animal kind. Must be either \u{001B}[01mbird\u{001B}[m or \u{001B}[01mfish\u{001B}[m\n\
226
224
item-end\n";
227
225
complete ["lookup"; "-kfish"; "--__complete=s"] @@ __POS_OF__
228
226
"1\n\
···
256
254
Arg.(required & pos 0 (some tool) None & info [])
257
255
and+ args =
258
256
let arg =
259
-
let completion = Arg.Completion.make ~restart:true () in
257
+
let completion = Arg.Completion.complete_restart in
260
258
Arg.Conv.of_conv ~docv:"ARG" Arg.string ~completion ()
261
259
in
262
260
Arg.(value & pos_right 0 arg [] & info [])
···
309
307
let cmd =
310
308
Cmd.make (Cmd.info "test_restart") @@
311
309
let arg ~docv =
312
-
let completion = Arg.Completion.make ~restart:true () in
310
+
let completion = Arg.Completion.complete_restart in
313
311
Arg.Conv.of_conv ~docv:"TOOL" Arg.string ~completion ()
314
312
in
315
313
let+ verb = Arg.(value & flag & info ["verbose"])
+8
-7
vendor/opam/cmdliner/test/testing_cmdliner.ml
+8
-7
vendor/opam/cmdliner/test/testing_cmdliner.ml
···
174
174
let bird_names = ["sparrow"; "parrot"; "pigeon"] in
175
175
let fish_names = ["salmon"; "trout"; "piranha"] in
176
176
let completion =
177
-
let select ~prefix n =
178
-
if String.starts_with ~prefix n then Some (n, "") else None
177
+
let select ~token:prefix n =
178
+
if String.starts_with ~prefix n
179
+
then Some (Arg.Completion.string n) else None
179
180
in
180
-
let func kind ~prefix = match Option.join kind with
181
-
| None -> List.filter_map (select ~prefix) (bird_names @ fish_names)
182
-
| Some `Bird -> List.filter_map (select ~prefix) bird_names
183
-
| Some `Fish -> List.filter_map (select ~prefix) fish_names
181
+
let func kind ~token = match Option.join kind with
182
+
| None -> Ok (List.filter_map (select ~token) (bird_names @ fish_names))
183
+
| Some `Bird -> Ok (List.filter_map (select ~token) bird_names)
184
+
| Some `Fish -> Ok (List.filter_map (select ~token) fish_names)
184
185
in
185
-
Arg.Completion.make ~context:kind_opt ~func ()
186
+
Arg.Completion.make ~context:kind_opt func
186
187
in
187
188
Arg.Conv.of_conv Arg.string ~completion ()
188
189
in