Install cmdliner based completions

shell/vendor_cmdliner.sh

@@ -1,23 +1,18 @@
-#!/bin/sh
+#!/bin/bash
 
 set -euo pipefail
 
 cd src/core/cmdliner
-rm -rf *.ml *.mli dune
+rm -rf *.ml *.mli dune tool
 
+trap "rm -rf tmp-vendor" EXIT
 git clone https://github.com/dbuenzli/cmdliner tmp-vendor
-git -C tmp-vendor switch --detach v1.3.0
+git -C tmp-vendor switch --detach v2.1.1
 
 mv tmp-vendor/src/*.{ml,mli} .
-rm -rf tmp-vendor
+mkdir -p tool
+mv tmp-vendor/src/tool/*.ml tool/
 
-mv cmdliner.ml opamCmdliner.ml
-mv cmdliner.mli opamCmdliner.mli
-rm cmdliner_exit.ml{,i}
-
-cat > dune << EOF
-(library
- (name opamCmdliner)
- (public_name opam-core.cmdliner)
- (flags :standard -w -27-32-35-50))
-EOF
+for f in patches/*.patch; do
+  git apply "$f"
+done

src/client/opamArg.ml

@@ -641,6 +641,70 @@ let apply_global_options cli o =
   with
   | Sys_error _ | Not_found -> ()
 
+(** Helpers for completions *)
+
+let global_options_for_completion opt_switch =
+  create_global_options false false None [] true None opt_switch
+  [] []
+  false
+  None None false
+  None None true true None true
+  false false
+  false None
+
+let complete_with_switch f ctx ~token =
+  let opt_switch = OpamStd.Option.default None ctx in
+  let options = global_options_for_completion opt_switch in
+  apply_global_options (OpamCLIVersion.default, `Default) options;
+  OpamGlobalState.with_ `Lock_none @@ fun gt ->
+  OpamRepositoryState.with_ `Lock_none gt @@ fun rt ->
+  let st =
+      OpamSwitchState.load `Lock_none gt rt (OpamStateConfig.get_switch ())
+  in
+  f st ~token
+
+let complete_packages ?(which=`Installed ) ?(extras=[]) () =
+  complete_with_switch @@ fun st ~token ->
+    let packages =
+      match which with
+      | `Installed -> st.installed
+      | `Pinned -> st.pinned
+      | `All -> OpamPackage.Set.union st.packages st.installed
+    in
+    let packages = OpamPackage.names_of_packages packages in
+    let directives = List.filter_map
+      (fun pkg ->
+          let name = OpamPackage.Name.to_string pkg in
+          if OpamCompat.String.starts_with ~prefix:token name then
+            Some (Arg.Completion.string name)
+          else
+            None
+      )
+      (OpamPackage.Name.Set.to_seq packages |> List.of_seq)
+    in
+    Ok (extras @ directives)
+
+let package_completion ?(which=`Installed ) ?(extras=[]) () =
+  Arg.Completion.make
+    ~context:switch_flag
+    (complete_packages ~which ~extras ())
+
+let complete_repos _ ~token =
+  OpamGlobalState.with_ `Lock_none @@ fun gt ->
+  OpamRepositoryState.with_ `Lock_none gt @@ fun rt ->
+  let repos =  rt.repositories in
+  let directives = List.filter_map
+    (fun repo ->
+        let name = OpamRepositoryName.to_string repo in
+        if OpamCompat.String.starts_with ~prefix:token name then
+          Some (Arg.Completion.string name)
+        else
+          None
+    )
+    (OpamRepositoryName.Map.keys repos)
+  in
+  Ok directives
+
 (** Build options *)
 
 type build_options = {
@@ -750,9 +814,9 @@ let url =
   Arg.conv' (parse, print)
 
 let filename =
-  let parse str = Ok (OpamFilename.of_string str) in
-  let print ppf filename = pr_str ppf (OpamFilename.to_string filename) in
-  Arg.conv' (parse, print)
+  let parser str = Ok (OpamFilename.of_string str) in
+  let pp ppf filename = pr_str ppf (OpamFilename.to_string filename) in
+  Arg.Conv.make ~completion:Arg.Completion.complete_files ~docv:"A file" ~parser ~pp ()
 
 let existing_filename_or_dash =
   let parse str =
@@ -768,9 +832,10 @@ let existing_filename_or_dash =
   Arg.conv' (parse, print)
 
 let dirname =
-  let parse str = Ok (OpamFilename.Dir.of_string str) in
-  let print ppf dir = pr_str ppf (escape_path (OpamFilename.prettify_dir dir)) in
-  Arg.conv' (parse, print)
+  let completion = Arg.Completion.complete_dirs in
+  let parser str = Ok (OpamFilename.Dir.of_string str) in
+  let pp ppf dir = pr_str ppf (escape_path (OpamFilename.prettify_dir dir)) in
+  Arg.Conv.make ~docv:"DIR" ~completion ~parser ~pp ()
 
 let existing_filename_dirname_or_dash =
   let parse str =
@@ -798,12 +863,13 @@ let subpath_conv =
   Arg.conv' (parse, print)
 
 let package_name =
-  let parse str =
+  let parser str =
     try Ok (OpamPackage.Name.of_string str)
     with Failure msg -> Error msg
   in
-  let print ppf pkg = pr_str ppf (OpamPackage.Name.to_string pkg) in
-  Arg.conv' (parse, print)
+  let pp ppf pkg = pr_str ppf (OpamPackage.Name.to_string pkg) in
+  let completion = package_completion ~which:`All () in
+  Arg.Conv.make ~docv:"PACKAGE" ~completion ~pp ~parser ()
 
 let package_version =
   let parse str =
@@ -813,6 +879,14 @@ let package_version =
   let print ppf ver = pr_str ppf (OpamPackage.Version.to_string ver) in
   Arg.conv' (parse, print)
 
+let level_int =
+  Arg.(Conv.of_conv
+        ~completion:(Completion.make
+          (fun _ ~token:_ ->
+            Ok (List.map Completion.value
+                [1;2;3;4;5;6;7;8])))
+        int)
+
 let positive_integer : int Arg.conv =
   let parser = Arg.conv_parser Arg.int in
   let printer = Arg.conv_printer Arg.int in
@@ -871,7 +945,7 @@ let atom =
   Arg.conv' (parse, print)
 
 let atom_or_local =
-  let parse str =
+  let parser str =
     if OpamFilename.is_rel_seg str ||
        OpamCompat.String.exists OpamFilename.is_dir_sep str
     then
@@ -887,27 +961,29 @@ let atom_or_local =
       | Ok at -> Ok (`Atom at)
       | Error (`Msg e) -> Error e
   in
-  let print ppf = function
+  let pp ppf = function
     | `Filename f -> pr_str ppf (OpamFilename.to_string f)
     | `Dirname d -> pr_str ppf (OpamFilename.Dir.to_string d)
     | `Atom a -> Arg.conv_printer atom ppf a
   in
-  Arg.conv' (parse, print)
+  let completion = package_completion ~which:`All ~extras:[Arg.Completion.dirs; Arg.Completion.files] () in
+  Arg.Conv.make ~completion ~docv:"PACKAGE" ~parser ~pp ()
 
 let atom_or_dir =
-  let parse str = match Arg.conv_parser atom_or_local str with
+  let parser str = match Arg.conv_parser atom_or_local str with
     | Ok (`Filename _) ->
       Error (Printf.sprintf
                "Not a valid package specification or existing directory: %s"
                str)
     | Ok (`Atom _ | `Dirname _ as atom_or_dir) -> Ok (atom_or_dir)
     | Error (`Msg e) -> Error e
   in
-  let print ppf
+  let pp ppf
     :> [ `Atom of OpamTypes.atom | `Dirname of OpamTypes.dirname ] -> unit
     = Arg.conv_printer atom_or_local ppf
   in
-  Arg.conv' (parse, print)
+  let completion = package_completion ~extras:[Arg.Completion.dirs] () in
+  Arg.Conv.make ~docv:"ATOM" ~parser ~completion ~pp ()
 
 let dep_formula =
   let module OpamParser = OpamParser.FullPos in
@@ -1044,6 +1120,18 @@ let opamlist_column =
   in
   Arg.conv' (parse, print)
 
+let complete_opam_fields _ ~token =
+  let directives =
+    List.filter_map
+      (fun (_, name) ->
+         if OpamCompat.String.starts_with ~prefix:token name && not (String.contains name '<') then
+           Some (Arg.Completion.string name)
+         else
+           None)
+      OpamListCommand.field_names
+  in
+  Ok directives
+
 let opamlist_columns =
   let field_re =
     (* max paren nesting 1, obviously *)
@@ -1056,7 +1144,7 @@ let opamlist_columns =
         alt [char ','; stop];
       ])
   in
-  let parse str =
+  let parser str =
     try
       let rec aux pos =
         if pos = String.length str then [] else
@@ -1074,7 +1162,7 @@ let opamlist_columns =
     with Not_found ->
       Error (Printf.sprintf "Invalid columns specification: '%s'." str)
   in
-  let print ppf cols =
+  let pp ppf cols =
     let rec aux = function
       | x::(_::_) as r ->
         Arg.conv_printer opamlist_column ppf x;
@@ -1085,7 +1173,8 @@ let opamlist_columns =
     in
     aux cols
   in
-  Arg.conv' (parse, print)
+  let completion = Arg.Completion.make complete_opam_fields in
+  Arg.Conv.make ~docv:"COLUMN" ~completion ~parser ~pp ()
 
 let hash_kinds =
   Arg.enum
@@ -1209,11 +1298,15 @@ let repo_kind_flag ?section cli validity =
        (string_of_enum main_kinds))
 
 let jobs_flag ?section cli validity =
+  let jobs_conv = Arg.Conv.of_conv
+    ~completion:(Arg.Conv.completion level_int)
+    positive_integer
+  in
   mk_opt ~cli validity ?section ["j";"jobs"] "JOBS"
     "Set the maximal number of concurrent jobs to use. The default value is \
     calculated from the number of cores. You can also set it using the \
     $(b,\\$OPAMJOBS) environment variable."
-    Arg.(some positive_integer) None
+    Arg.(some jobs_conv) None
 
 let formula_flag ?section cli =
   mk_opt ~cli (cli_from ~experimental:true cli2_2) ?section ["formula"] "FORMULA"
@@ -1273,7 +1366,7 @@ let global_options cli =
       "Like $(b,--debug), but allows specifying the debug level ($(b,--debug) \
        sets it to 1). Equivalent to setting $(b,\\$OPAMDEBUG) to a positive \
        integer."
-      Arg.(some int) None in
+      Arg.(some level_int) None in
   let verbose =
     Arg.(value & flag_all & info ~docs:section ["v";"verbose"] ~doc:
            "Be more verbose. One $(b,-v) shows all package commands, repeat to \
@@ -1297,11 +1390,6 @@ let global_options cli =
        select the 2.0 CLI, set the $(b,OPAMCLI) environment variable to \
        $(i,2.0) instead of using this parameter."
       Arg.string (OpamCLIVersion.to_string OpamCLIVersion.current) in
-  let switch =
-    mk_opt ~cli cli_original ~section ["switch"]
-      "SWITCH" "Use $(docv) as the current compiler switch. \
-                This is equivalent to setting $(b,\\$OPAMSWITCH) to $(i,SWITCH)."
-      Arg.(some string) None in
   let yes =
     mk_vflag_all ~cli ~section [
       cli_original, true, ["y";"yes"],
@@ -1420,7 +1508,7 @@ let global_options cli =
        equivalent to setting $(b,IGNOREPINDEPENDS=true)."
   in
   Term.(const create_global_options
-        $git_version $debug $debug_level $verbose $quiet $color $switch
+        $git_version $debug $debug_level $verbose $quiet $color $switch_flag
         $yes $confirm_level
         $strict $root $external_solver
         $use_internal_solver $cudf_file $solver_preferences $best_effort
@@ -1697,21 +1785,40 @@ let package_selection cli =
       Arg.(pair ~sep:':' string string)
   in
   let has_flag =
+    let flag_conv =
+      let parser s =
+        match pkg_flag_of_string s with
+        | Pkgflag_Unknown s ->
+          Error ("Invalid package flag "^s^", must be one of "^
+                OpamStd.List.concat_map " " string_of_pkg_flag
+                  all_package_flags)
+        | f -> Ok f
+      in
+      let pp fmt flag =
+        Format.pp_print_string fmt (string_of_pkg_flag flag)
+      in
+      let completion =
+        let completer _ ~token =
+          Ok (List.filter_map
+            (fun flag ->
+               let s = string_of_pkg_flag flag in
+               if OpamCompat.String.starts_with ~prefix:token s  then
+                 Some (Arg.Completion.string s)
+               else
+                 None)
+            all_package_flags)
+        in
+        Arg.Completion.make completer
+      in
+      Arg.Conv.make ~docv:"FLAG" ~completion ~parser ~pp ()
+    in
     mk_opt_all ~cli cli_original ["has-flag"] "FLAG" ~section
       ("Only include packages which have the given flag set. \
         Package flags are one of: "^
        (OpamStd.List.concat_map " "
           (Printf.sprintf "$(b,%s)" @* string_of_pkg_flag)
           all_package_flags))
-      (Arg.conv'
-         ((fun s -> match pkg_flag_of_string s with
-             | Pkgflag_Unknown s ->
-               Error ("Invalid package flag "^s^", must be one of "^
-                      OpamStd.List.concat_map " " string_of_pkg_flag
-                        all_package_flags)
-             | f -> Ok f),
-          (fun fmt flag ->
-             Format.pp_print_string fmt (string_of_pkg_flag flag))))
+      flag_conv
   in
   let has_tag =
     mk_opt_all ~cli cli_original ["has-tag"] "TAG" ~section