verbose output with status line

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)
 ------------------
 

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
     }

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
   }

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

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 ());

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

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

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))
 

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 =

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
 

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
     }

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 = []

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
     }

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
     }