diff --git a/CHANGES.md b/CHANGES.md index 4325c8cb39d..a5b8d3ad2e8 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -141,6 +141,9 @@ Unreleased a file that failed to build. This was a niche feature and it was getting in the way of making Dune's core better. (#4607, @jeremiedimino) +- Make Dune display the progress indicator in all output modes except quiet + (#4618, @aalekseyev) + 2.9.0 (unreleased) ------------------ diff --git a/bench/bench.ml b/bench/bench.ml index 5139ce0308a..6f80b506239 100644 --- a/bench/bench.ml +++ b/bench/bench.ml @@ -117,7 +117,7 @@ let () = let module Scheduler = Dune_engine.Scheduler in let config = { Scheduler.Config.concurrency = 10 - ; display = Quiet + ; display = { verbosity = Quiet; status_line = false } ; rpc = None ; stats = None } diff --git a/bench/micro/dune_bench/scheduler_bench.ml b/bench/micro/dune_bench/scheduler_bench.ml index 38e30ffd665..2165ceeb221 100644 --- a/bench/micro/dune_bench/scheduler_bench.ml +++ b/bench/micro/dune_bench/scheduler_bench.ml @@ -5,7 +5,7 @@ open Dune_engine let config = { Scheduler.Config.concurrency = 1 - ; display = Short + ; display = { verbosity = Short; status_line = false } ; rpc = None ; stats = None } diff --git a/bin/common.ml b/bin/common.ml index 52a42eec35e..c55b7c8d544 100644 --- a/bin/common.ml +++ b/bin/common.ml @@ -514,7 +514,7 @@ let display_term = & info [ "verbose" ] ~docs:copts_sect ~doc:"Same as $(b,--display verbose)") in - Option.some_if verbose Display.Verbose) + Option.some_if verbose { Display.verbosity = Verbose; status_line = true }) Arg.( value & opt (some (enum Display.all)) None diff --git a/bin/subst.ml b/bin/subst.ml index b564e1cfe6b..291e90b9fef 100644 --- a/bin/subst.ml +++ b/bin/subst.ml @@ -61,7 +61,10 @@ let term = let+ () = Common.build_info and+ debug_backtraces = Common.debug_backtraces in let config : Dune_config.t = - { Dune_config.default with display = Quiet; concurrency = Fixed 1 } + { Dune_config.default with + display = { verbosity = Quiet; status_line = false } + ; concurrency = Fixed 1 + } in Dune_engine.Clflags.debug_backtraces debug_backtraces; Path.set_root (Path.External.cwd ()); diff --git a/bin/target.ml b/bin/target.ml index 6b461bf9aac..f280edaaee0 100644 --- a/bin/target.ml +++ b/bin/target.ml @@ -155,7 +155,7 @@ let resolve_targets_mixed root (config : Dune_config.t) setup user_targets = >>| Result.map_error ~f:(fun hints -> (Arg.Dep.file (Path.to_string p), hints))) in - if config.display = Verbose then + if config.display.verbosity = Verbose then Log.info [ Pp.text "Actual targets:" ; Pp.enumerate diff --git a/src/dune_config/dune_config.ml b/src/dune_config/dune_config.ml index 0d44bcec408..1aa77d3ca3c 100644 --- a/src/dune_config/dune_config.ml +++ b/src/dune_config/dune_config.ml @@ -275,11 +275,7 @@ let hash = Hashtbl.hash let equal a b = Poly.equal a b let default = - { display = - (if Config.inside_dune then - Quiet - else - Progress) + { display = { verbosity = Quiet; status_line = not Config.inside_dune } ; concurrency = (if Config.inside_dune then Fixed 1 @@ -389,14 +385,14 @@ let load_user_config_file () = Partial.empty let adapt_display config ~output_is_a_tty = - (* Progress isn't meaningful if inside a terminal (or emacs), so reset the - display to Quiet if the output is getting piped to a file or something. *) + (* Progress isn't meaningful if inside a terminal (or emacs), so disable it if + the output is getting piped to a file or something. *) let config = if - config.display = Progress && (not output_is_a_tty) + config.display.status_line && (not output_is_a_tty) && not Config.inside_emacs then - { config with display = Quiet } + { config with display = { config.display with status_line = false } } else config in @@ -409,7 +405,7 @@ let adapt_display config ~output_is_a_tty = let init t = Console.Backend.set (Scheduler.Config.Display.console_backend t.display); - Log.verbose := t.display = Verbose + Log.verbose := t.display.verbosity = Verbose let auto_concurrency = lazy diff --git a/src/dune_engine/process.ml b/src/dune_engine/process.ml index 7b15a0ef7c0..8f3bad0e5ea 100644 --- a/src/dune_engine/process.ml +++ b/src/dune_engine/process.ml @@ -434,7 +434,7 @@ module Exit_status = struct ++ Pp.char ' ' ++ command_line :: Option.to_list output) - let handle_non_verbose t ~display ~purpose ~output ~prog ~command_line ~dir + let handle_non_verbose t ~verbosity ~purpose ~output ~prog ~command_line ~dir ~has_unexpected_stdout ~has_unexpected_stderr = let open Pp.O in let has_embedded_location = outputs_starts_with_location output in @@ -459,7 +459,11 @@ module Exit_status = struct | Ok n -> if Option.is_some output - || (display = Scheduler.Config.Display.Short && purpose <> Internal_job) + || (match verbosity with + | Scheduler.Config.Display.Short -> true + | Quiet -> false + | Verbose -> assert false) + && purpose <> Internal_job then Console.print_user_message (User_message.make @@ -536,7 +540,7 @@ let run_internal ?dir ?(stdout_to = Io.stdout) ?(stderr_to = Io.stderr) command_line ~prog:prog_str ~args ~dir ~stdout_to ~stderr_to ~stdin_from in let fancy_command_line = - match display with + match display.verbosity with | Verbose -> let open Pp.O in let cmdline = @@ -713,16 +717,15 @@ let run_internal ?dir ?(stdout_to = Io.stdout) ?(stderr_to = Io.stderr) let output = stdout ^ stderr in Log.command ~command_line ~output ~exit_status:process_info.status; let res = - match (display, exit_status', output) with - | (Quiet | Progress), Ok n, "" -> - n (* Optimisation for the common case *) + match (display.verbosity, exit_status', output) with + | Quiet, Ok n, "" -> n (* Optimisation for the common case *) | Verbose, _, _ -> Exit_status.handle_verbose exit_status' ~id ~dir ~command_line:fancy_command_line ~output | _ -> Exit_status.handle_non_verbose exit_status' ~prog:prog_str ~dir - ~command_line ~output ~purpose ~display ~has_unexpected_stdout - ~has_unexpected_stderr + ~command_line ~output ~purpose ~verbosity:display.verbosity + ~has_unexpected_stdout ~has_unexpected_stderr in (res, times)) diff --git a/src/dune_engine/scheduler.ml b/src/dune_engine/scheduler.ml index 7148bf343fa..90edc23247d 100644 --- a/src/dune_engine/scheduler.ml +++ b/src/dune_engine/scheduler.ml @@ -6,31 +6,41 @@ module Config = struct include Config module Display = struct - type t = - | Progress + type verbosity = + | Quiet | Short | Verbose - | Quiet + type t = + { status_line : bool + ; verbosity : verbosity + } + + (* Even though [status_line] is true by default in most of these, the status + line is actually not shown if the output is redirected to a file or a + pipe. *) let all = - [ ("progress", Progress) - ; ("verbose", Verbose) - ; ("short", Short) - ; ("quiet", Quiet) + [ ("progress", { verbosity = Quiet; status_line = true }) + ; ("verbose", { verbosity = Verbose; status_line = true }) + ; ("short", { verbosity = Short; status_line = true }) + ; ("quiet", { verbosity = Quiet; status_line = false }) ] - let to_dyn = function - | Progress -> Dyn.Variant ("Progress", []) + let verbosity_to_dyn : verbosity -> Dyn.t = function | Quiet -> Variant ("Quiet", []) | Short -> Variant ("Short", []) | Verbose -> Variant ("Verbose", []) - let console_backend = function - | Progress -> Console.Backend.progress - | Short - | Verbose - | Quiet -> - Console.Backend.dumb + let to_dyn { status_line; verbosity } : Dyn.t = + Record + [ ("status_line", Dyn.Bool status_line) + ; ("verbosity", verbosity_to_dyn verbosity) + ] + + let console_backend t = + match t.status_line with + | false -> Console.Backend.dumb + | true -> Console.Backend.progress end type t = diff --git a/src/dune_engine/scheduler.mli b/src/dune_engine/scheduler.mli index dc15024ed0a..be94a312e01 100644 --- a/src/dune_engine/scheduler.mli +++ b/src/dune_engine/scheduler.mli @@ -5,11 +5,15 @@ open Stdune module Config : sig module Display : sig - type t = - | Progress (** Single interactive status line *) + type verbosity = + | Quiet (** Only display errors *) | Short (** One line per command *) | Verbose (** Display all commands fully *) - | Quiet (** Only display errors *) + + type t = + { status_line : bool + ; verbosity : verbosity + } val all : (string * t) list diff --git a/test/expect-tests/csexp_rpc/csexp_rpc_tests.ml b/test/expect-tests/csexp_rpc/csexp_rpc_tests.ml index 2d2ae33804d..4bb9ec8d50d 100644 --- a/test/expect-tests/csexp_rpc/csexp_rpc_tests.ml +++ b/test/expect-tests/csexp_rpc/csexp_rpc_tests.ml @@ -74,7 +74,7 @@ let%expect_test "csexp server life cycle" = in let config = { Scheduler.Config.concurrency = 1 - ; display = Quiet + ; display = { verbosity = Quiet; status_line = false } ; rpc = None ; stats = None } diff --git a/test/expect-tests/dune_config/dune_config_test.ml b/test/expect-tests/dune_config/dune_config_test.ml index 6d16a87ede3..57ca3a77c33 100644 --- a/test/expect-tests/dune_config/dune_config_test.ml +++ b/test/expect-tests/dune_config/dune_config_test.ml @@ -20,7 +20,7 @@ let%expect_test "cache-check-probability 0.1" = parse "(cache-check-probability 0.1)"; [%expect {| - { display = Quiet + { display = { status_line = false; verbosity = Quiet } ; concurrency = Fixed 1 ; terminal_persistence = Preserve ; sandboxing_preference = [] @@ -36,7 +36,7 @@ let%expect_test "cache-storage-mode copy" = parse "(cache-storage-mode copy)"; [%expect {| - { display = Quiet + { display = { status_line = false; verbosity = Quiet } ; concurrency = Fixed 1 ; terminal_persistence = Preserve ; sandboxing_preference = [] @@ -52,7 +52,7 @@ let%expect_test "cache-storage-mode hardlink" = parse "(cache-storage-mode hardlink)"; [%expect {| - { display = Quiet + { display = { status_line = false; verbosity = Quiet } ; concurrency = Fixed 1 ; terminal_persistence = Preserve ; sandboxing_preference = [] diff --git a/test/expect-tests/process_tests.ml b/test/expect-tests/process_tests.ml index 11adfe6da1e..15e91dba280 100644 --- a/test/expect-tests/process_tests.ml +++ b/test/expect-tests/process_tests.ml @@ -5,7 +5,7 @@ open Dune_engine let go = let config = { Scheduler.Config.concurrency = 1 - ; display = Short + ; display = { verbosity = Short; status_line = false } ; rpc = None ; stats = None } diff --git a/test/expect-tests/vcs_tests.ml b/test/expect-tests/vcs_tests.ml index 9316d4900ba..415e2828488 100644 --- a/test/expect-tests/vcs_tests.ml +++ b/test/expect-tests/vcs_tests.ml @@ -118,7 +118,7 @@ let run kind script = let vcs = { Vcs.kind; root = temp_dir } in let config = { Scheduler.Config.concurrency = 1 - ; display = Short + ; display = { verbosity = Short; status_line = false } ; rpc = None ; stats = None }