The unpac monorepo manager self-hosting as a monorepo using unpac
Proof of concept of context sensitive value completion (#215)
+264
-89
+19
-7
vendor/opam/cmdliner/src/cmdliner.mli
+19
-7
vendor/opam/cmdliner/src/cmdliner.mli
···
635
635
cmdliner for the argument. *)
636
636
module Completion : sig
637
637
638
-
type complete = string -> (string * string) list
638
+
type 'ctx func = 'ctx option -> prefix:string -> (string * string) list
639
639
(** The type for completion functions. Given a prefix should
640
640
return a list of possible completions and a doc string. *)
641
641
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
+
642
646
type 'a t
643
647
(** The type for completing values parsed into values of type ['a]. *)
644
648
645
649
val make :
646
-
?complete:complete -> ?dirs:bool -> ?files:bool -> ?restart:bool ->
647
-
unit -> 'a t
648
-
(** [make ()] is a completion specification with given properties.
649
-
See accesors for semantics. Note that the properties are
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:
653
+
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.
660
+
661
+
See accessors for semantics. Note that the properties are
650
662
not mutually exclusive. *)
651
663
652
-
val complete : 'a t -> complete
653
-
(** [complete c] is a function to perform completion. *)
664
+
val complete : 'a t -> 'a complete
665
+
(** [complete c] is a the context and function to perform completion. *)
654
666
655
667
val dirs : 'a t -> bool
656
668
(** [dirs c] indicates the argument should be completed with directories. *)
+8
-4
vendor/opam/cmdliner/src/cmdliner_arg.ml
+8
-4
vendor/opam/cmdliner/src/cmdliner_arg.ml
···
336
336
let parser s = try Ok (bool_of_string s) with
337
337
| Invalid_argument _ -> Error (err_invalid_enum "" s alts)
338
338
in
339
-
let complete _prefix = List.map (fun s -> s, "") alts in
340
-
let completion = Completion.make ~complete () in
339
+
let completion =
340
+
let func _ctx ~prefix:_ = List.map (fun s -> s, "") alts in
341
+
Completion.make ~func ()
342
+
in
341
343
Conv.make ~docv:"BOOL" ~parser ~pp:Format.pp_print_bool ~completion ()
342
344
343
345
let char =
···
395
397
try Fmt.string ppf (List.assoc v sl_inv)
396
398
with Not_found -> invalid_arg (err_incomplete_enum (List.map fst sl))
397
399
in
398
-
let complete _prefix = List.map (fun (s, _) -> s, "") sl in
399
-
let completion = Completion.make ~complete () in
400
+
let completion =
401
+
let func _ctx ~prefix:_ = List.map (fun (s, _) -> s, "") sl in
402
+
Completion.make ~func ()
403
+
in
400
404
Conv.make ~docv ~parser ~pp ~completion ()
401
405
402
406
let path =
+7
-5
vendor/opam/cmdliner/src/cmdliner_arg.mli
+7
-5
vendor/opam/cmdliner/src/cmdliner_arg.mli
···
10
10
type 'a conv
11
11
12
12
module Completion : sig
13
-
type complete = string -> (string * string) list
13
+
type 'ctx func = 'ctx option -> prefix:string -> (string * string) list
14
+
type 'a complete =
15
+
| Complete : 'ctx Cmdliner_term.t option * 'ctx func -> 'a complete
16
+
14
17
type 'a t
15
18
val make :
16
-
?complete:complete -> ?dirs:bool -> ?files:bool -> ?restart:bool -> unit ->
17
-
'a t
19
+
?context: 'ctx Cmdliner_term.t -> ?func:'ctx func -> ?dirs:bool ->
20
+
?files:bool -> ?restart:bool -> unit -> 'a t
18
21
19
-
val context : 'a t -> 'a Cmdliner_term.t option
20
-
val complete : 'a t -> complete
22
+
val complete : 'a t -> 'a complete
21
23
val dirs : 'a t -> bool
22
24
val files : 'a t -> bool
23
25
val restart : 'a t -> bool
+20
-16
vendor/opam/cmdliner/src/cmdliner_cline.ml
+20
-16
vendor/opam/cmdliner/src/cmdliner_cline.ml
···
30
30
31
31
exception Completion_requested of Cmdliner_def.Complete.t
32
32
33
-
let comp_request ?after_dashdash ~prefix kind =
34
-
let comp = Cmdliner_def.Complete.make ?after_dashdash ~prefix kind in
33
+
let comp_request ?after_dashdash cline ~prefix kind =
34
+
let comp = Cmdliner_def.Complete.make ?after_dashdash cline ~prefix kind in
35
35
raise (Completion_requested comp)
36
36
37
37
(* Command lines *)
···
124
124
| true, [] -> [short_opt]
125
125
| true, l -> if List.mem short_opt l then l else short_opt :: l
126
126
127
-
let parse_opt_value ~for_completion arg_info name value args =
127
+
let parse_opt_value ~for_completion cline arg_info name value args =
128
128
(* Either we got a value glued in [value] or we need to get one in args *)
129
129
match Cmdliner_def.Arg_info.opt_kind arg_info with
130
130
| Flag -> (* Flags have no values but we may get dash sharing in [value] *)
···
144
144
| v :: rest when for_completion && has_complete_prefix v ->
145
145
let v = get_token_to_complete v in
146
146
if is_opt v then (* not an option value *) None, args else
147
-
comp_request ~prefix:v (Opt_value arg_info)
147
+
comp_request cline ~prefix:v (Opt_value arg_info)
148
148
| v :: rest ->
149
149
if is_opt v then None, args else Some v, rest
150
150
151
-
let try_complete_opt_value arg_info name value args =
151
+
let try_complete_opt_value cline arg_info name value args =
152
152
(* At that point we found a matching option name so this should be mostly
153
153
about completing a glued option value, but there are twists. *)
154
154
match Cmdliner_def.Arg_info.opt_kind arg_info with
···
162
162
(* This is actually a parse error, flags have no value. We
163
163
make it an option completion but the completions will
164
164
eventually be empty (the prefix won't match) *)
165
-
comp_request ~prefix:(name ^ v) Opt_name
165
+
comp_request cline ~prefix:(name ^ v) Opt_name
166
166
| None ->
167
167
(* We have in fact a fully completed flag turn it into an
168
168
option completion. *)
169
-
comp_request ~prefix:name Opt_name
169
+
comp_request cline ~prefix:name Opt_name
170
170
end
171
171
| _ ->
172
172
begin match value with
173
-
| Some prefix -> comp_request ~prefix (Opt_value arg_info)
173
+
| Some prefix -> comp_request cline ~prefix (Opt_value arg_info)
174
174
| None ->
175
175
(* We have a fully completed option name, we don't try to
176
176
lookup what happens in the next argument which should
177
177
hold the value if any, we just turn it into an option
178
178
completion. *)
179
-
comp_request ~prefix:name Opt_name
179
+
comp_request cline ~prefix:name Opt_name
180
180
end
181
181
182
182
let parse_opt_args
···
201
201
| Ok arg_info ->
202
202
let value, args =
203
203
if is_completion
204
-
then try_complete_opt_value arg_info name value args
205
-
else parse_opt_value ~for_completion arg_info name value args
204
+
then try_complete_opt_value cline arg_info name value args
205
+
else parse_opt_value ~for_completion cline arg_info name value args
206
206
in
207
207
let arg : arg = O ((k, name, value) :: opt_arg cline arg_info) in
208
208
let cline = Cmdliner_def.Arg_info.Map.add arg_info arg cline in
209
209
loop errs (k + 1) cline pargs args
210
210
| Error `Not_found when for_completion ->
211
211
if not is_completion
212
-
then (* XXX unclear *) loop errs (k + 1) cline (s :: pargs) args else
212
+
(* Drop the data, if the user thought this was an opt with
213
+
an argument this may confuse positional args but there's
214
+
not much we can do. *)
215
+
then loop errs (k + 1) cline pargs args else
213
216
let prefix = name ^ Option.value ~default:"" value in
214
-
comp_request ~prefix Opt_name
217
+
comp_request cline ~prefix Opt_name
215
218
| Error `Not_found when peek_opts ->
216
219
loop errs (k + 1) cline pargs args
217
220
| Error `Not_found ->
···
268
271
| `Range args -> args
269
272
| `Complete prefix ->
270
273
let kind = Cmdliner_def.Complete.Opt_name_or_pos_value a in
271
-
comp_request ~after_dashdash:has_dashdash ~prefix kind
274
+
comp_request ~after_dashdash:has_dashdash cline ~prefix kind
272
275
in
273
276
let max_spec = max stop max_spec in
274
277
let cline = Cmdliner_def.Arg_info.Map.add a (P args : arg) cline in
···
283
286
match take_range ~for_completion (max_spec + 1) last pargs with
284
287
| `Range args -> args
285
288
| `Complete prefix ->
286
-
comp_request ~after_dashdash:has_dashdash ~prefix Opt_name
289
+
comp_request ~after_dashdash:has_dashdash cline ~prefix Opt_name
287
290
in
288
291
if misses <> [] then begin
289
292
let _ : string list = consume_excess () in
···
317
320
match maybe_token_to_complete ~for_completion:true arg with
318
321
| None -> assert false
319
322
| Some prefix ->
320
-
comp_request ~after_dashdash:has_dashdash ~prefix Opt_name
323
+
comp_request
324
+
~after_dashdash:has_dashdash cline ~prefix Opt_name
321
325
end
322
326
| Error (errs, cline, has_dashdash, pargs) ->
323
327
let _ : _ result =
+10
-7
vendor/opam/cmdliner/src/cmdliner_completion.ml
+10
-7
vendor/opam/cmdliner/src/cmdliner_completion.ml
···
30
30
if not (Cmdliner_def.Arg_info.Set.is_empty set) then begin
31
31
let arg_infos = Cmdliner_def.Cmd_info.args info in
32
32
pp_group ppf "Options";
33
-
Cmdliner_def.Arg_info.Set.iter (pp_opt ~err_ppf ~subst ~prefix ppf) arg_infos
33
+
Cmdliner_def.Arg_info.Set.iter (pp_opt ~err_ppf ~subst ~prefix ppf)
34
+
arg_infos
34
35
end
35
36
36
-
let pp_arg_values ~after_dashdash ~prefix ppf comp =
37
+
let pp_arg_values ~after_dashdash ~prefix items ppf comp =
37
38
if after_dashdash && Cmdliner_def.Arg_completion.restart comp
38
39
then pp_line ppf "restart" else
39
-
let items = Cmdliner_def.Arg_completion.complete comp prefix in
40
+
let items = items () in
40
41
let comp_files = Cmdliner_def.Arg_completion.files comp in
41
42
let comp_dirs = Cmdliner_def.Arg_completion.dirs comp in
42
43
if items <> [] || comp_files || comp_dirs then begin
···
58
59
59
60
let vnum = 1 (* Protocol version number *)
60
61
61
-
let output ~out_ppf ~err_ppf ei cmd_args_info cmd comp =
62
+
let output ~out_ppf ~err_ppf ei cmd_args_info cmd comp ~items =
62
63
let subst = Cmdliner_def.Eval.doclang_subst ei in
63
64
let after_dashdash = Cmdliner_def.Complete.after_dashdash comp in
64
65
let prefix = Cmdliner_def.Complete.prefix comp in
66
+
let maybe_opt = prefix = "" || prefix.[0] = '-' in
65
67
let pp_arg_value ppf arg_info =
66
68
begin match Cmdliner_def.Arg_info.Set.find_opt arg_info cmd_args_info with
67
69
| None -> ()
68
-
| Some (Completion comp) -> pp_arg_values ~after_dashdash ~prefix ppf comp
70
+
| Some (Completion comp) ->
71
+
pp_arg_values ~after_dashdash ~prefix items ppf comp
69
72
end;
70
73
in
71
74
let pp ppf () =
···
73
76
| Opt_value arg_info -> pp_arg_value ppf arg_info
74
77
| Opt_name_or_pos_value arg_info ->
75
78
pp_arg_value ppf arg_info;
76
-
if not after_dashdash
79
+
if not after_dashdash && maybe_opt
77
80
then pp_opt_names ~err_ppf ~subst ~prefix ppf cmd
78
81
| Opt_name ->
79
-
if not after_dashdash
82
+
if not after_dashdash && maybe_opt
80
83
then pp_opt_names ~err_ppf ~subst ~prefix ppf cmd;
81
84
end;
82
85
if Cmdliner_def.Complete.subcmds comp
+4
-1
vendor/opam/cmdliner/src/cmdliner_completion.mli
+4
-1
vendor/opam/cmdliner/src/cmdliner_completion.mli
+27
-16
vendor/opam/cmdliner/src/cmdliner_def.ml
+27
-16
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 complete = string -> (string * string) list
206
-
type 'a completion =
207
-
{ context : 'a term option;
208
-
complete : complete;
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
209
dirs : bool;
210
210
files : bool;
211
211
restart : bool }
···
351
351
| Opt_name
352
352
353
353
type t =
354
-
{ prefix : string;
354
+
{ context : Cline.t;
355
+
prefix : string;
355
356
after_dashdash : bool;
356
357
subcmds : bool; (* Note this is adjusted in Cmdliner_eval *)
357
-
kind : kind }
358
+
kind : kind;
359
+
values : (string * string) list }
358
360
359
-
let make ?(after_dashdash = false) ?(subcmds = false) ~prefix kind =
360
-
{ prefix; after_dashdash; subcmds; kind }
361
+
let make ?(after_dashdash = false) ?(subcmds = false) context ~prefix kind =
362
+
{ context; prefix; after_dashdash; subcmds; kind; values = [] }
361
363
362
364
let add_subcmds c = { c with subcmds = true }
365
+
let add_values c values = { c with values }
366
+
let context c = c.context
363
367
let prefix c = c.prefix
364
368
let after_dashdash c = c.after_dashdash
365
369
let subcmds c = c.subcmds
···
377
381
end
378
382
379
383
module Arg_completion = struct
380
-
type complete = Arg_info.complete
384
+
type 'ctx func = 'ctx Arg_info.func
385
+
386
+
type 'a complete = 'a Arg_info.complete =
387
+
| Complete : 'ctx Term.t option * 'ctx func -> 'a complete
388
+
381
389
type 'a t = 'a Arg_info.completion
382
390
383
391
let make
384
-
?(complete = Fun.const []) ?(dirs = false) ?(files = false)
392
+
?context ?(func = fun _ ~prefix:_ -> []) ?(dirs = false) ?(files = false)
385
393
?(restart = false) () : 'a t
386
394
=
387
-
{context = None; complete; dirs; files; restart}
395
+
{ complete = Complete (context, func); dirs; files; restart }
388
396
389
-
let none = make ()
390
-
let some (c : 'a t) =
391
-
{ c with context = Option.map Term.some c.context }
397
+
let none : 'a t =
398
+
{ complete = Complete (None, fun _ ~prefix:_ -> []);
399
+
dirs = false; files = false; restart = false }
392
400
393
-
let context (c : 'a t) = c.context
401
+
let some c : 'a option t = match c.Arg_info.complete with
402
+
| Complete (ctx, func) -> { c with complete = Complete (ctx, func) }
403
+
394
404
let complete (c : 'a t) = c.complete
395
405
let dirs (c : 'a t) = c.dirs
396
406
let files (c : 'a t) = c.files
···
412
422
{ docv; parser; pp; completion }
413
423
414
424
let of_conv
415
-
conv ?(completion = conv.completion) ?(docv = conv.docv)
425
+
conv
426
+
?(completion = conv.completion) ?(docv = conv.docv)
416
427
?(parser = conv.parser) ?(pp = conv.pp) ()
417
428
=
418
429
{ docv; parser; pp; completion }
+12
-9
vendor/opam/cmdliner/src/cmdliner_def.mli
+12
-9
vendor/opam/cmdliner/src/cmdliner_def.mli
···
205
205
type t
206
206
207
207
val make :
208
-
?after_dashdash:bool -> ?subcmds:bool -> prefix:string -> kind -> t
208
+
?after_dashdash:bool -> ?subcmds:bool -> Cline.t -> prefix:string ->
209
+
kind -> t
209
210
211
+
val context : t -> Cline.t
210
212
val add_subcmds : t -> t
211
213
val prefix : t -> string
212
214
val after_dashdash : t -> bool
···
228
230
229
231
(** Completion strategies *)
230
232
module Arg_completion : sig
231
-
type complete = string -> (string * string) list
233
+
234
+
type 'ctx func = 'ctx option -> prefix:string -> (string * string) list
235
+
type 'a complete = Complete : 'ctx Term.t option * 'ctx func -> 'a complete
232
236
type 'a t = 'a Arg_info.completion
233
237
val make :
234
-
?complete:complete -> ?dirs:bool -> ?files:bool -> ?restart:bool ->
235
-
unit -> 'a t
238
+
?context:'ctx Term.t -> ?func:'ctx func -> ?dirs:bool -> ?files:bool ->
239
+
?restart:bool -> unit -> 'a t
236
240
237
-
val context : 'a t -> 'a Term.t option
238
241
val none : 'a t
239
242
val some : 'a t -> 'a option t
240
-
val complete : 'a t -> complete
243
+
val complete : 'a t -> 'a complete
241
244
val dirs : 'a t -> bool
242
245
val files : 'a t -> bool
243
246
val restart : 'a t -> bool
···
252
255
?completion:'a Arg_completion.t -> docv:string -> parser:'a parser ->
253
256
pp:'a fmt -> unit -> 'a t
254
257
255
-
val of_conv : 'a t ->
256
-
?completion:'a Arg_completion.t -> ?docv:string -> ?parser:'a parser ->
257
-
?pp:'a fmt -> unit -> 'a t
258
+
val of_conv :
259
+
'a t -> ?completion:'a Arg_completion.t -> ?docv:string ->
260
+
?parser:'a parser -> ?pp:'a fmt -> unit -> 'a t
258
261
259
262
val docv : 'a t -> string
260
263
val parser : 'a t -> 'a parser
+41
-7
vendor/opam/cmdliner/src/cmdliner_eval.ml
+41
-7
vendor/opam/cmdliner/src/cmdliner_eval.ml
···
8
8
type 'a eval_exit = [ `Ok of 'a | `Exit of Cmdliner_def.Exit.code ]
9
9
10
10
type 'a complete =
11
-
Cmdliner_def.Arg_info.Set.t * 'a Cmdliner_cmd.t * Cmdliner_def.Complete.t
11
+
Cmdliner_def.Eval.t * Cmdliner_def.Arg_info.Set.t * 'a Cmdliner_cmd.t *
12
+
Cmdliner_def.Complete.t
12
13
13
14
type eval_result_error =
14
15
[ Cmdliner_term.term_escape
···
44
45
| exn when catch ->
45
46
let bt = Printexc.get_raw_backtrace () in
46
47
Error (`Exn (exn, bt))
48
+
49
+
let run_parser_for_completion_context ei cline ctx =
50
+
let parser = Cmdliner_term.parser ctx in
51
+
match (parser ei cline :> ('a, eval_result_error) result) with
52
+
| Ok ctx -> Some ctx
53
+
| Error _ -> None
54
+
| exception exn -> None
55
+
47
56
48
57
let try_eval_stdopts ~catch ei cl help version : 'a eval_result option =
49
58
match run_parser ~catch ei cl (Cmdliner_term.parser help) with
···
96
105
Cmdliner_msg.pp_version help_ppf ei; Ok `Version
97
106
| `Parse err ->
98
107
Cmdliner_msg.pp_usage_and_err err_ppf ei ~err; Error `Parse
99
-
| `Complete (cmd_args_info, cmd, comp) ->
108
+
| `Complete (ei, cmd_args_info, cmd, comp) ->
109
+
(* TODO quick hack this should not happen here *)
110
+
let items () =
111
+
let prefix = Cmdliner_def.Complete.prefix comp in
112
+
let arg_info = match Cmdliner_def.Complete.kind comp with
113
+
| Opt_value arg_info -> Some arg_info
114
+
| Opt_name_or_pos_value arg_info -> Some arg_info
115
+
| _ -> None
116
+
in
117
+
match arg_info with
118
+
| None -> []
119
+
| Some arg_info ->
120
+
match Cmdliner_def.Arg_info.Set.find_opt
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
133
+
in
100
134
Cmdliner_completion.output
101
-
~out_ppf:help_ppf ~err_ppf ei cmd_args_info cmd comp; Ok `Help
135
+
~out_ppf:help_ppf ~err_ppf ei cmd_args_info cmd comp ~items; Ok `Help
102
136
| `Help (fmt, cmd_name) ->
103
137
do_help ~env help_ppf err_ppf ei fmt cmd_name; Ok `Help
104
138
| `Exn (e, bt) ->
···
220
254
| Error (`Parse (try_stdopts, msg)) ->
221
255
(* Command lookup error, we may still prioritize stdargs *)
222
256
begin match cline with
223
-
| `Complete comp -> Error (`Complete (cmd_args_info, cmd, comp))
257
+
| `Complete comp -> Error (`Complete (ei, cmd_args_info, cmd, comp))
224
258
| `Error (_, cl) | `Ok cl ->
225
259
let stdopts =
226
260
if try_stdopts then try_eval_stdopts ~catch ei cl help version else
···
235
269
begin match cline with
236
270
| `Complete comp ->
237
271
let comp = Cmdliner_def.Complete.add_subcmds comp in
238
-
Error (`Complete (cmd_args_info, cmd, comp))
272
+
Error (`Complete (ei, cmd_args_info, cmd, comp))
239
273
| `Ok _ | `Error _ -> assert false
240
274
end
241
275
| Ok parser ->
242
276
begin match cline with
243
-
| `Complete comp -> Error (`Complete (cmd_args_info, cmd, comp))
277
+
| `Complete comp -> Error (`Complete (ei, cmd_args_info, cmd, comp))
244
278
| `Error (e, cl) ->
245
279
begin match try_eval_stdopts ~catch ei cl help version with
246
280
| Some e -> e
···
282
316
let v, ret = match cline with
283
317
| `Complete comp ->
284
318
let cmd = Cmdliner_cmd.make cmd_info t in
285
-
None, (Error (`Complete (cmd_arg_infos, cmd, comp)))
319
+
None, (Error (`Complete (ei, cmd_arg_infos, cmd, comp)))
286
320
| `Error (e, cl) ->
287
321
begin match try_eval_stdopts ~catch:true ei cl help version with
288
322
| Some e -> None, e
+6
-3
vendor/opam/cmdliner/test/test_cmd.ml
+6
-3
vendor/opam/cmdliner/test/test_cmd.ml
···
37
37
error `Term [] @@ __POS_OF__
38
38
"Usage: \u{001B}[01mtest_group\u{001B}[m [\u{001B}[01m--help\u{001B}[m] \u{001B}[04mCOMMAND\u{001B}[m …\n\
39
39
test_group: required \u{001B}[04mCOMMAND\u{001B}[m name is \u{001B}[31mmissing\u{001B}[m, must be one of \u{001B}[01mbirds\u{001B}[m, \u{001B}[01mcamels\u{001B}[m,\n\
40
-
\ \u{001B}[01mfishs\u{001B}[m or \u{001B}[01mmammals\u{001B}[m\n";
40
+
\ \u{001B}[01mfishs\u{001B}[m, \u{001B}[01mlookup\u{001B}[m or \u{001B}[01mmammals\u{001B}[m\n";
41
41
error `Term ["bla"] @@ __POS_OF__ "Usage: \u{001B}[01mtest_group\u{001B}[m [\u{001B}[01m--help\u{001B}[m] \u{001B}[04mCOMMAND\u{001B}[m …\n\
42
-
test_group: \u{001B}[31munknown\u{001B}[m command \u{001B}[01mbla\u{001B}[m. Must be one of \u{001B}[01mbirds\u{001B}[m, \u{001B}[01mcamels\u{001B}[m, \u{001B}[01mfishs\u{001B}[m or\n\
43
-
\ \u{001B}[01mmammals\u{001B}[m\n";
42
+
test_group: \u{001B}[31munknown\u{001B}[m command \u{001B}[01mbla\u{001B}[m. Must be one of \u{001B}[01mbirds\u{001B}[m, \u{001B}[01mcamels\u{001B}[m, \u{001B}[01mfishs\u{001B}[m, \u{001B}[01mlookup\u{001B}[m\n\
43
+
\ or \u{001B}[01mmammals\u{001B}[m\n";
44
44
error `Parse ["birds"; "-k"] @@ __POS_OF__
45
45
"Usage: \u{001B}[01mtest_group birds\u{001B}[m [\u{001B}[01m--help\u{001B}[m] [\u{001B}[04mCOMMAND\u{001B}[m] …\n\
46
46
test_group: option \u{001B}[01m-k\u{001B}[m \u{001B}[31mneeds an argument\u{001B}[m\n";
···
64
64
65
65
fishs [OPTION]… [NAME]
66
66
Operate on fishs.
67
+
68
+
lookup [--kind=ENUM] [OPTION]… NAME
69
+
Lookup animal by name.
67
70
68
71
mammals [OPTION]…
69
72
Operate on mammals.
+75
-11
vendor/opam/cmdliner/test/test_completion.ml
+75
-11
vendor/opam/cmdliner/test/test_completion.ml
···
39
39
item\n\
40
40
camels\n\
41
41
Operate on camels.\n\
42
+
item-end\n\
43
+
item\n\
44
+
lookup\n\
45
+
Lookup animal by name.\n\
42
46
item-end\n";
43
47
complete ["birds"; "--__complete="] @@ __POS_OF__
44
48
"1\n\
···
69
73
()
70
74
71
75
let test_no_options_after_dashsash =
72
-
Test.test "No options after --" @@ fun () ->
76
+
Test.test "no options after --" @@ fun () ->
73
77
complete ["birds"; "fly"; "--__complete="] @@ __POS_OF__
74
78
"1\n\
75
79
group\n\
···
83
87
()
84
88
85
89
let test_opts_starts =
86
-
Test.test "Complete optional argument values" @@ fun () ->
90
+
Test.test "complete optional argument names" @@ fun () ->
87
91
complete ["birds"; "--__complete=-"] @@ __POS_OF__
88
92
"1\n\
89
93
group\n\
···
117
121
()
118
122
119
123
let test_opt_value =
120
-
Test.test "Complete optional argument values" @@ fun () ->
124
+
Test.test "complete optional argument values" @@ fun () ->
121
125
(* Glued *)
122
126
complete ["birds"; "--__complete=--can-fly="] @@ __POS_OF__
123
127
"1\n\
···
178
182
item-end\n";
179
183
()
180
184
185
+
let test_context_sensitive =
186
+
Test.test "context sensitive completions" @@ fun () ->
187
+
complete ["lookup"; "--__complete="] @@ __POS_OF__
188
+
"1\n\
189
+
group\n\
190
+
Values\n\
191
+
item\n\
192
+
sparrow\n\
193
+
\n\
194
+
item-end\n\
195
+
item\n\
196
+
parrot\n\
197
+
\n\
198
+
item-end\n\
199
+
item\n\
200
+
pigeon\n\
201
+
\n\
202
+
item-end\n\
203
+
item\n\
204
+
salmon\n\
205
+
\n\
206
+
item-end\n\
207
+
item\n\
208
+
trout\n\
209
+
\n\
210
+
item-end\n\
211
+
item\n\
212
+
piranha\n\
213
+
\n\
214
+
item-end\n\
215
+
group\n\
216
+
Options\n\
217
+
item\n\
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\
221
+
item-end\n\
222
+
item\n\
223
+
--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\
226
+
item-end\n";
227
+
complete ["lookup"; "-kfish"; "--__complete=s"] @@ __POS_OF__
228
+
"1\n\
229
+
group\n\
230
+
Values\n\
231
+
item\n\
232
+
salmon\n\
233
+
\n\
234
+
item-end\n";
235
+
complete ["lookup"; "-kbird"; "--__complete=p"] @@ __POS_OF__
236
+
"1\n\
237
+
group\n\
238
+
Values\n\
239
+
item\n\
240
+
parrot\n\
241
+
\n\
242
+
item-end\n\
243
+
item\n\
244
+
pigeon\n\
245
+
\n\
246
+
item-end\n";
247
+
()
248
+
181
249
let test_restart_restricted_tool =
182
-
Test.test "Restart restricted tool" @@ fun () ->
250
+
Test.test "restart restricted tool" @@ fun () ->
183
251
let cmd =
184
252
Cmd.make (Cmd.info "test_restart_restricted") @@
185
253
let+ verb = Arg.(value & flag & info ["verbose"])
···
221
289
item\n\
222
290
git\n\
223
291
\n\
224
-
item-end\n\
225
-
group\n\
226
-
Options\n";
292
+
item-end\n";
227
293
(* Note no reset here: as there is no -- token *)
228
294
complete ["git"; "--__complete="] @@ __POS_OF__
229
295
"1\n\
···
239
305
()
240
306
241
307
let test_restart_any_tool =
242
-
Test.test "Restart any tool" @@ fun () ->
308
+
Test.test "restart any tool" @@ fun () ->
243
309
let cmd =
244
310
Cmd.make (Cmd.info "test_restart") @@
245
311
let arg ~docv =
···
262
328
item-end\n";
263
329
(* The following two do not restart because -- is missing *)
264
330
complete ["--__complete=gi"] @@ __POS_OF__
265
-
"1\n\
266
-
group\n\
267
-
Options\n";
331
+
"1\n";
268
332
complete ["git"; "--__complete="] @@ __POS_OF__
269
333
"1\n\
270
334
group\n\
+2
-2
vendor/opam/cmdliner/test/test_legacy_prefix.ml
+2
-2
vendor/opam/cmdliner/test/test_legacy_prefix.ml
···
45
45
"Usage: \u{001B}[01mtest_group birds\u{001B}[m [\u{001B}[01m--help\u{001B}[m] [\u{001B}[04mCOMMAND\u{001B}[m] …\n\
46
46
test_group: \u{001B}[31munknown\u{001B}[m command \u{001B}[01mfl\u{001B}[m. Did you mean \u{001B}[01mfly\u{001B}[m?\n";
47
47
error_nolegacy `Term ["mam"] @@ __POS_OF__ "Usage: \u{001B}[01mtest_group\u{001B}[m [\u{001B}[01m--help\u{001B}[m] \u{001B}[04mCOMMAND\u{001B}[m …\n\
48
-
test_group: \u{001B}[31munknown\u{001B}[m command \u{001B}[01mmam\u{001B}[m. Must be one of \u{001B}[01mbirds\u{001B}[m, \u{001B}[01mcamels\u{001B}[m, \u{001B}[01mfishs\u{001B}[m or\n\
49
-
\ \u{001B}[01mmammals\u{001B}[m\n";
48
+
test_group: \u{001B}[31munknown\u{001B}[m command \u{001B}[01mmam\u{001B}[m. Must be one of \u{001B}[01mbirds\u{001B}[m, \u{001B}[01mcamels\u{001B}[m, \u{001B}[01mfishs\u{001B}[m, \u{001B}[01mlookup\u{001B}[m\n\
49
+
\ or \u{001B}[01mmammals\u{001B}[m\n";
50
50
()
51
51
52
52
let test_cmd =
+33
-1
vendor/opam/cmdliner/test/testing_cmdliner.ml
+33
-1
vendor/opam/cmdliner/test/testing_cmdliner.ml
···
162
162
Cmd.make (Cmd.info "camels" ~deprecated ~doc:"Operate on camels." ~man) @@
163
163
let+ bactrian and+ herd in ()
164
164
in
165
+
let lookup =
166
+
let kind_opt =
167
+
let kinds = ["bird", `Bird; "fish", `Fish] in
168
+
let doc =
169
+
"$(docv) restricts the animal kind. Must be " ^ Arg.doc_alts_enum kinds
170
+
in
171
+
Arg.(value & opt (some (enum kinds)) None & info ["k"; "kind"] ~doc)
172
+
in
173
+
let name_conv =
174
+
let bird_names = ["sparrow"; "parrot"; "pigeon"] in
175
+
let fish_names = ["salmon"; "trout"; "piranha"] in
176
+
let completion =
177
+
let select ~prefix n =
178
+
if String.starts_with ~prefix n then Some (n, "") else None
179
+
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
184
+
in
185
+
Arg.Completion.make ~context:kind_opt ~func ()
186
+
in
187
+
Arg.Conv.of_conv Arg.string ~completion ()
188
+
in
189
+
Cmd.make (Cmd.info "lookup" ~doc:"Lookup animal by name.") @@
190
+
let+ kind_opt
191
+
and+ name =
192
+
let doc = "$(docv) is the animal name to lookup" and docv = "NAME" in
193
+
Arg.(required & pos 0 (some name_conv) None & info [] ~doc ~docv)
194
+
in
195
+
()
196
+
in
165
197
Cmd.group (Cmd.info "test_group" ~version:"X.Y.Z" ~man) @@
166
-
[birds; mammals; fishs; camels]
198
+
[birds; mammals; fishs; camels; lookup]