diff --git a/bin/common.ml b/bin/common.ml index b4da8594a59..a1e35acdcea 100644 --- a/bin/common.ml +++ b/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 } diff --git a/bin/common.mli b/bin/common.mli index 735ef337eb0..04ee1750ff7 100644 --- a/bin/common.mli +++ b/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 diff --git a/bin/promotion.ml b/bin/promotion.ml index ac23bcf1d41..334249b9070 100644 --- a/bin/promotion.ml +++ b/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" ;; diff --git a/doc/changes/added/15338.md b/doc/changes/added/15338.md new file mode 100644 index 00000000000..5118506b635 --- /dev/null +++ b/doc/changes/added/15338.md @@ -0,0 +1,2 @@ +- Tab completion for `dune promote` now lists pending promotion files. + (#15338, fixes #7254, @Alizter). diff --git a/test/blackbox-tests/setup-script.sh b/test/blackbox-tests/setup-script.sh index 45dd3791255..08cbe40e03c 100644 --- a/test/blackbox-tests/setup-script.sh +++ b/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=` +# marker at that position (see vendor/cmdliner/src/tool/cmdliner_data.ml); the +# last argument here is treated as that token. +# +# Usage: dune_complete [...] +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" diff --git a/test/blackbox-tests/test-cases/completion/promote.t b/test/blackbox-tests/test-cases/completion/promote.t new file mode 100644 index 00000000000..656e0aaab55 --- /dev/null +++ b/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 < (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