feat(promote): complete pending promotion files

bin/common.ml

@@ -629,7 +629,6 @@ module Builder = struct
     ; sandbox_actions : bool
     }
 
-  let set_no_build t no_build = { t with no_build }
   let root t = t.root
   let set_root t root = { t with root = Some root }
   let forbid_builds t = { t with allow_builds = false; no_print_directory = true }

bin/common.mli

@@ -42,7 +42,6 @@ module Builder : sig
   type t
 
   val equal : t -> t -> bool
-  val set_no_build : t -> No_build.t -> t
   val root : t -> string option
   val set_root : t -> string -> t
   val forbid_builds : t -> t

bin/promotion.ml

@@ -20,6 +20,53 @@ let on_missing missing =
       ])
 ;;
 
+(* Promotion subcommands don't build anything: they read the [.to-promote] db
+   and copy files between the build dir and source tree. *)
+let init_no_build builder =
+  Common.Builder.forbid_builds builder |> Common.Builder.disable_log_file |> Common.init
+;;
+
+(* Conv for a pending-promotion file: parses as the raw user string (same
+   as [Arg.path]), but completes against the entries recorded in the build
+   dir's [.to-promote] db.
+
+   Cmdliner passes us the [Common.Builder.t] parsed from the command's own
+   term as the completion context, so [--root] / [--build-dir] are honoured.
+   Init goes through [init_no_build] — same as the runtime — so no [_build/]
+   mkdir and no trace-file rewrite on every keystroke.
+
+   CR-someday Alizter: subtract already-typed positional args from the
+   candidate list. Needs cmdliner to pass the previously parsed positional
+   values into the completion func (the current public API exposes only
+   the context value and the cursor token). *)
+let promote_file =
+  let parser s = Ok s in
+  let pp ppf s = Format.pp_print_string ppf s in
+  let candidates ~(builder : Common.Builder.t) ~token =
+    let common, _config = init_no_build builder in
+    let { Diff_promotion.present; missing = _ } =
+      let db = Diff_promotion.load_db () in
+      Diff_promotion.partition_db db Dune_rpc.Files_to_promote.All
+    in
+    let from =
+      Path.source (Path.Source.L.relative Path.Source.root (Common.root common).to_cwd)
+    in
+    List.filter_map present ~f:(fun file ->
+      let cwd_relative =
+        Path.source (Diff_promotion.File.source file) |> Path.reach ~from
+      in
+      Option.some_if (String.starts_with ~prefix:token cwd_relative) cwd_relative)
+    |> List.sort ~compare:String.compare
+    |> List.map ~f:Cmdliner.Arg.Completion.string
+  in
+  let completion =
+    Cmdliner.Arg.Completion.make ~context:Common.Builder.term (fun ctx ~token ->
+      let builder = Option.value ctx ~default:Common.Builder.default in
+      Ok (candidates ~builder ~token))
+  in
+  Cmdliner.Arg.Conv.make ~docv:"FILE" ~parser ~pp ~completion ()
+;;
+
 module Apply = struct
   let info =
     let doc = "Promote files from the last run" in
@@ -45,9 +92,19 @@ module Apply = struct
     Cmd.info ~doc ~man "apply"
   ;;
 
-  let run ~(builder : Common.Builder.t) ~exact ~files =
-    let common, config = Common.init builder in
-    let files_to_promote = List.map files ~f:Arg.Path.arg |> files_to_promote ~common in
+  let term =
+    let+ builder = Common.Builder.term
+    and+ exact =
+      Arg.(
+        value
+        & flag
+        & info [ "file" ] ~doc:(Some "Require each FILE argument to match exactly."))
+    and+ files =
+      (* CR-someday Alizter: document this option *)
+      Arg.(value & pos_all promote_file [] & info [] ~docv:"FILE" ~doc:None)
+    in
+    let common, config = init_no_build builder in
+    let files_to_promote = files_to_promote ~common files in
     let matching : Dune_rpc.Promote_targets.Matching.t =
       if exact then Exact else Prefix
     in
@@ -68,28 +125,6 @@ module Apply = struct
         >>| Rpc.Rpc_common.wrap_build_outcome_exn ~print_on_success:true)
   ;;
 
-  let term_with_builder builder =
-    let+ builder
-    and+ exact =
-      Arg.(
-        value
-        & flag
-        & info [ "file" ] ~doc:(Some "Require each FILE argument to match exactly."))
-    and+ files =
-      (* CR-someday Alizter: document this option *)
-      Arg.(value & pos_all Arg.path [] & info [] ~docv:"FILE" ~doc:None)
-    in
-    run ~builder ~exact ~files
-  ;;
-
-  let term = term_with_builder Common.Builder.term
-
-  let promote_term =
-    term_with_builder
-      (let+ no_build = Common.No_build.term in
-       Common.Builder.set_no_build Common.Builder.default no_build)
-  ;;
-
   let command = Cmd.v info term
 end
 
@@ -116,7 +151,7 @@ module Diff = struct
       (* CR-someday Alizter: document this option *)
       Arg.(value & pos_all Cmdliner.Arg.file [] & info [] ~docv:"FILE" ~doc:None)
     in
-    let common, config = Common.init builder in
+    let common, config = init_no_build builder in
     let files_to_promote = files_to_promote ~common files in
     (* CR-soon rgrinberg: remove pointless args *)
     Scheduler_setup.no_build_no_rpc ~config (fun () ->
@@ -141,7 +176,7 @@ module Files = struct
       (* CR-soon rgrinberg: why do we even need this argument? *)
       Arg.(value & pos_all Cmdliner.Arg.file [] & info [] ~docv:"FILE" ~doc:None)
     in
-    let common, _config = Common.init builder in
+    let common, _config = init_no_build builder in
     let files_to_promote = files_to_promote ~common files in
     (* CR-soon rgrinberg: remove pointless args *)
     let db = Diff_promotion.load_db () in
@@ -184,7 +219,7 @@ module Show = struct
          are users supposed to distinguish the output? *)
       Arg.(value & pos_all Cmdliner.Arg.file [] & info [] ~docv:"FILE" ~doc:None)
     in
-    let common, _config = Common.init builder in
+    let common, _config = init_no_build builder in
     let files_to_promote = files_to_promote ~common files in
     let db = Diff_promotion.load_db () in
     let { Diff_promotion.present = _; missing } =
@@ -204,9 +239,5 @@ let info =
 let group = Cmd.group info [ Files.command; Apply.command; Diff.command; Show.command ]
 
 let promote =
-  Common.command_alias
-    ~orig_name:"promotion apply"
-    Apply.command
-    Apply.promote_term
-    "promote"
+  Common.command_alias ~orig_name:"promotion apply" Apply.command Apply.term "promote"
 ;;

doc/changes/added/15338.md

@@ -0,0 +1,2 @@
+- Tab completion for `dune promote` now lists pending promotion files.
+  (#15338, fixes #7254, @Alizter).

test/blackbox-tests/setup-script.sh

@@ -98,6 +98,24 @@ make_dune_project() {
 	EOF
 }
 
+# Invoke dune's shell completion protocol for the given subcommand/token and
+# print just the candidate values, one per line. The protocol output also
+# carries Subcommands/Options groups which we filter out here.
+#
+# Cmdliner identifies the word under the cursor with a `--__complete=<token>`
+# marker at that position (see vendor/cmdliner/src/tool/cmdliner_data.ml); the
+# last argument here is treated as that token.
+#
+# Usage: dune_complete <subcmd> [<arg>...] <token>
+dune_complete() {
+  local token="${!#}"
+  local args=("${@:1:$#-1}")
+  dune --__complete "${args[@]}" "--__complete=$token" | awk '
+    /^group$/ { getline g; current = g; next }
+    current == "Values" && /^item$/ { getline name; print name }
+  '
+}
+
 make_dune_project_with_package() {
   local version="$1"
   local package="$2"

test/blackbox-tests/test-cases/completion/promote.t

@@ -0,0 +1,90 @@
+Tab completion for `dune promote` lists pending promotions.
+
+  $ make_dune_project 3.25
+
+With no pending promotions, the candidate list is empty.
+
+  $ dune_complete promote ""
+
+Set up two pending promotions: one at the top level, one in a subdir.
+
+  $ cat > dune <<EOF
+  > (rule (alias runtest) (action (diff a.expected a.actual)))
+  > (rule (write-file a.actual "ACTUAL\n"))
+  > (subdir sub
+  >  (rule (alias runtest) (action (diff b.expected b.actual)))
+  >  (rule (write-file b.actual "SUBACTUAL\n")))
+  > EOF
+  $ echo "expected" > a.expected
+  $ mkdir sub && echo "subexpected" > sub/b.expected
+  $ dune runtest
+  File "a.expected", line 1, characters 0-0:
+  --- a.expected
+  +++ a.actual
+  @@ -1 +1 @@
+  -expected
+  +ACTUAL
+  File "sub/b.expected", line 1, characters 0-0:
+  --- sub/b.expected
+  +++ sub/b.actual
+  @@ -1 +1 @@
+  -subexpected
+  +SUBACTUAL
+  [1]
+
+An empty token lists every pending promotion, cwd-relative.
+
+  $ dune_complete promote ""
+  a.expected
+  sub/b.expected
+
+A prefix token filters the candidate list.
+
+  $ dune_complete promote "sub/"
+  sub/b.expected
+
+  $ dune_complete promote "a"
+  a.expected
+
+A token that matches nothing yields no candidates.
+
+  $ dune_complete promote "no-such-prefix"
+
+CR-someday Alizter: an already-typed positional arg is still offered as
+a candidate. Fixing this needs a cmdliner change to pass the already-typed
+positional args to the completion func (the public API exposes only the
+context value and the cursor token; positionals aren't reachable without
+patching the vendored cmdliner).
+
+  $ dune_complete promote a.expected ""
+  a.expected
+  sub/b.expected
+
+`--build-dir` is honoured: with `_build/` cleared, pending promotions from a
+non-default build dir are still found.
+
+  $ rm -rf _build
+  $ dune runtest --build-dir _build2
+  File "a.expected", line 1, characters 0-0:
+  --- a.expected
+  +++ a.actual
+  @@ -1 +1 @@
+  -expected
+  +ACTUAL
+  File "sub/b.expected", line 1, characters 0-0:
+  --- sub/b.expected
+  +++ sub/b.actual
+  @@ -1 +1 @@
+  -subexpected
+  +SUBACTUAL
+  [1]
+  $ dune_complete "promotion" "apply" --build-dir _build2 ""
+  a.expected
+  sub/b.expected
+
+`--root` is honoured too:
+
+  $ workspace=$PWD
+  $ (cd / && dune_complete "promotion" "apply" --root "$workspace" --build-dir _build2 "")
+  a.expected
+  sub/b.expected