swallow stdout on success

CHANGES.md

@@ -84,6 +84,9 @@ Unreleased
 - Fields allowed in the config file are now also allowed in the
   workspace file (#4426, @jeremiedimino)
 
+- Add an option to swallow the output of actions when they succeed, to
+  reduce noise of large builds (#4422, @jeremiedimino)
+
 2.8.5 (28/03/2021)
 ------------------
 

bin/common.ml

@@ -148,7 +148,7 @@ let print_entering_message c =
     in
     Console.print [ Pp.verbatim (sprintf "Entering directory '%s'" dir) ]
 
-let set_common ?log_file c =
+let set_common ?log_file ?(recognize_jbuilder_projects = false) c =
   if c.root.dir <> Filename.current_dir_name then Sys.chdir c.root.dir;
   Path.set_root (normalize_path (Path.External.cwd ()));
   Path.Build.set_build_dir (Path.Build.Kind.of_string c.build_dir);
@@ -168,6 +168,16 @@ let set_common ?log_file c =
   in
   Dune_config.init config;
   Dune_util.Log.init () ?file:log_file;
+  Dune_engine.Source_tree.init
+    (let open Memo.Build.O in
+    let module S = Dune_engine.Source_tree.Settings in
+    let+ w = Dune_rules.Workspace.workspace () in
+    S.builtin_default
+    |> S.set_ancestor_vcs c.root.ancestor_vcs
+    |> S.set_execution_parameters
+         (Dune_engine.Execution_parameters.builtin_default
+         |> Dune_rules.Workspace.update_execution_parameters w)
+    |> S.set_recognize_jbuilder_projects recognize_jbuilder_projects);
   Clflags.debug_dep_path := c.debug_dep_path;
   Clflags.debug_findlib := c.debug_findlib;
   Clflags.debug_backtraces c.debug_backtraces;
@@ -606,6 +616,12 @@ let shared_with_config_file =
           ~docs
           ~env:(Arg.env_var ~doc "DUNE_CACHE_CHECK_PROBABILITY")
           ~doc)
+  and+ swallow_stdout_on_success =
+    Arg.(
+      value & flag
+      & info
+          [ "swallow-stdout-on-success" ]
+          ~doc:"Swallow the output of an action when it succeeds.")
   in
   { Dune_config.Partial.display
   ; concurrency
@@ -617,6 +633,7 @@ let shared_with_config_file =
   ; cache_duplication
   ; cache_trim_period = None
   ; cache_trim_size = None
+  ; swallow_stdout_on_success = Option.some_if swallow_stdout_on_success true
   }
 
 let term =

bin/common.mli

@@ -32,7 +32,11 @@ val prefix_target : t -> string -> string
 
     Return the final configuration, which is the same as the one returned in the
     [config] field of [Dune_rules.Workspace.workspace ()]) *)
-val set_common : ?log_file:Dune_util.Log.File.t -> t -> Dune_config.t
+val set_common :
+     ?log_file:Dune_util.Log.File.t
+  -> ?recognize_jbuilder_projects:bool
+  -> t
+  -> Dune_config.t
 
 (** [examples \[("description", "dune cmd foo"); ...\]] is an [EXAMPLES] manpage
     section of enumerated examples illustrating how to run the documented

bin/import.ml

@@ -81,8 +81,7 @@ module Main = struct
 
   let scan_workspace (common : Common.t) =
     let capture_outputs = Common.capture_outputs common in
-    let ancestor_vcs = (Common.root common).ancestor_vcs in
-    scan_workspace ~capture_outputs ~ancestor_vcs ()
+    scan_workspace ~capture_outputs ()
 
   let setup ?build_mutex common config =
     let open Fiber.O in

bin/ocaml_merlin.ml

@@ -29,10 +29,11 @@ let term =
              ouptut.")
   in
   let common = Common.set_print_directory common false in
-  let config = Common.set_common common ~log_file:No_log_file in
+  let config =
+    Common.set_common common ~log_file:No_log_file
+      ~recognize_jbuilder_projects:true
+  in
   Scheduler.go ~common ~config (fun () ->
-      Dune_engine.Source_tree.init ~recognize_jbuilder_projects:true
-        ~ancestor_vcs:None;
       match dump_config with
       | Some s -> Dune_rules.Merlin_server.dump s
       | None -> Dune_rules.Merlin_server.start ())
@@ -66,10 +67,11 @@ module Dump_dot_merlin = struct
               "The path to the folder of which the configuration should be \
                printed. Defaults to the current directory.")
     in
-    let config = Common.set_common common ~log_file:No_log_file in
+    let config =
+      Common.set_common common ~log_file:No_log_file
+        ~recognize_jbuilder_projects:true
+    in
     Scheduler.go ~common ~config (fun () ->
-        Dune_engine.Source_tree.init ~recognize_jbuilder_projects:true
-          ~ancestor_vcs:None;
         match path with
         | Some s -> Dune_rules.Merlin_server.dump_dot_merlin s
         | None -> Dune_rules.Merlin_server.dump_dot_merlin ".")

bin/upgrade.ml

@@ -15,10 +15,7 @@ let info = Term.info "upgrade" ~doc ~man
 
 let term =
   let+ common = Common.term in
-  let config = Common.set_common common in
-  Scheduler.go ~common ~config (fun () ->
-      Dune_engine.Source_tree.init ~recognize_jbuilder_projects:true
-        ~ancestor_vcs:None;
-      Dune_upgrader.upgrade ())
+  let config = Common.set_common common ~recognize_jbuilder_projects:true in
+  Scheduler.go ~common ~config (fun () -> Dune_upgrader.upgrade ())
 
 let command = (term, info)

src/dune_config/dune_config.ml

@@ -146,6 +146,7 @@ module type S = sig
     ; cache_duplication : Caching.Duplication.t field
     ; cache_trim_period : int field
     ; cache_trim_size : int64 field
+    ; swallow_stdout_on_success : bool field
     }
 end
 
@@ -171,6 +172,8 @@ struct
     ; cache_duplication = field a.cache_duplication b.cache_duplication
     ; cache_trim_period = field a.cache_trim_period b.cache_trim_period
     ; cache_trim_size = field a.cache_trim_size b.cache_trim_size
+    ; swallow_stdout_on_success =
+        field a.swallow_stdout_on_success b.swallow_stdout_on_success
     }
 end
 
@@ -192,6 +195,7 @@ struct
       ; cache_duplication
       ; cache_trim_period
       ; cache_trim_size
+      ; swallow_stdout_on_success
       } =
     Dyn.Encoder.record
       [ ("display", field Scheduler.Config.Display.to_dyn display)
@@ -210,6 +214,8 @@ struct
             cache_duplication )
       ; ("cache_trim_period", field Dyn.Encoder.int cache_trim_period)
       ; ("cache_trim_size", field Dyn.Encoder.int64 cache_trim_size)
+      ; ( "swallow_stdout_on_success"
+        , field Dyn.Encoder.bool swallow_stdout_on_success )
       ]
 end
 
@@ -233,6 +239,7 @@ module Partial = struct
     ; cache_trim_period = None
     ; cache_trim_size = None
     ; cache_duplication = None
+    ; swallow_stdout_on_success = None
     }
 
   include
@@ -288,6 +295,7 @@ let default =
   ; cache_trim_period = 10 * 60
   ; cache_trim_size = 10_000_000_000L
   ; cache_duplication = None
+  ; swallow_stdout_on_success = false
   }
 
 let decode_generic ~min_dune_version =
@@ -313,6 +321,9 @@ let decode_generic ~min_dune_version =
     field_o "cache-trim-period" (2, 0) Dune_lang.Decoder.duration
   and+ cache_trim_size =
     field_o "cache-trim-size" (2, 0) Dune_lang.Decoder.bytes_unit
+  and+ swallow_stdout_on_success =
+    field_o_b "swallow-stdout-on-success"
+      ~check:(Dune_lang.Syntax.since Stanza.syntax (3, 0))
   in
   { Partial.display
   ; concurrency
@@ -324,6 +335,7 @@ let decode_generic ~min_dune_version =
   ; cache_duplication
   ; cache_trim_period
   ; cache_trim_size
+  ; swallow_stdout_on_success
   }
 
 let decode =

src/dune_config/dune_config.mli

@@ -70,6 +70,7 @@ module type S = sig
     ; cache_duplication : Caching.Duplication.t field
     ; cache_trim_period : int field
     ; cache_trim_size : int64 field
+    ; swallow_stdout_on_success : bool field
     }
 end
 

src/dune_engine/action_exec.ml

@@ -516,13 +516,18 @@ let exec_until_all_deps_ready ~ectx ~eenv t =
   let+ () = loop ~eenv in
   Exec_result.{ dynamic_deps_stages = List.rev !stages }
 
-let exec ~targets ~context ~env ~rule_loc ~build_deps t =
+let exec ~targets ~context ~env ~rule_loc ~build_deps ~execution_parameters t =
   let purpose = Process.Build_job targets in
   let ectx = { targets; purpose; context; rule_loc; build_deps }
   and eenv =
     { working_dir = Path.root
     ; env
-    ; stdout_to = Process.Io.stdout
+    ; stdout_to =
+        (if Execution_parameters.swallow_stdout_on_success execution_parameters
+        then
+          Process.Io.stdout_swallow_on_success
+        else
+          Process.Io.stdout)
     ; stderr_to = Process.Io.stderr
     ; stdin_from = Process.Io.null In
     ; prepared_dependencies = DAP.Dependency.Set.empty

src/dune_engine/action_exec.mli

@@ -33,5 +33,6 @@ val exec :
   -> env:Env.t
   -> rule_loc:Loc.t
   -> build_deps:(Dep.Set.t -> Dep.Fact.t Dep.Map.t Fiber.t)
+  -> execution_parameters:Execution_parameters.t
   -> Action.t
   -> Exec_result.t Fiber.t

src/dune_engine/build_system.ml

@@ -1421,7 +1421,7 @@ end = struct
     let targets = rule.action.targets in
     let head_target = Path.Build.Set.choose_exn targets in
     let* action, deps = exec_build_request rule.action.build
-    and* exec_params =
+    and* execution_parameters =
       Source_tree.execution_parameters_of_dir
         (Path.Build.drop_build_context_exn dir)
     in
@@ -1641,7 +1641,7 @@ end = struct
                 let deps =
                   if
                     Execution_parameters.should_expand_aliases_when_sandboxing
-                      exec_params
+                      execution_parameters
                   then
                     Dep.Facts.paths deps
                   else
@@ -1664,7 +1664,7 @@ end = struct
                   in
                   let+ exec_result =
                     Action_exec.exec ~context ~env ~targets ~rule_loc:loc
-                      ~build_deps action
+                      ~build_deps ~execution_parameters action
                   in
                   Option.iter sandboxed ~f:copy_files_from_sandbox;
                   exec_result)
@@ -1673,7 +1673,8 @@ end = struct
             (* All went well, these targets are no longer pending *)
             pending_targets := Path.Build.Set.diff !pending_targets targets;
             let targets_digests =
-              compute_targets_digests_or_raise_error exec_params ~loc targets
+              compute_targets_digests_or_raise_error execution_parameters ~loc
+                targets
             in
             let targets_digest = digest_of_targets_digests targets_digests in
             let () =

src/dune_engine/dune_engine.ml

@@ -56,3 +56,4 @@ module Pform = Pform
 module Cm_kind = Cm_kind
 module Mode = Mode
 module Fs_notify_memo = Fs_notify_memo
+module Execution_parameters = Execution_parameters

src/dune_engine/dune_project.ml

@@ -135,6 +135,7 @@ type t =
   { name : Name.t
   ; root : Path.Source.t
   ; version : string option
+  ; dune_version : Dune_lang.Syntax.Version.t
   ; info : Package.Info.t
   ; packages : Package.t Package.Name.Map.t
   ; stanza_parser : Stanza.t list Dune_lang.Decoder.t
@@ -152,7 +153,6 @@ type t =
   ; format_config : Format_config.t option
   ; strict_package_deps : bool
   ; cram : bool
-  ; execution_parameters : Execution_parameters.t
   }
 
 let equal = ( == )
@@ -183,14 +183,13 @@ let dialects t = t.dialects
 
 let explicit_js_mode t = t.explicit_js_mode
 
-let execution_parameters t = t.execution_parameters
-
-let dune_version t = Execution_parameters.dune_version t.execution_parameters
+let dune_version t = t.dune_version
 
 let to_dyn
     { name
     ; root
     ; version
+    ; dune_version
     ; info
     ; project_file
     ; parsing_context = _
@@ -208,13 +207,13 @@ let to_dyn
     ; format_config
     ; strict_package_deps
     ; cram
-    ; execution_parameters
     } =
   let open Dyn.Encoder in
   record
     [ ("name", Name.to_dyn name)
     ; ("root", Path.Source.to_dyn root)
     ; ("version", (option string) version)
+    ; ("dune_version", Dune_lang.Syntax.Version.to_dyn dune_version)
     ; ("info", Package.Info.to_dyn info)
     ; ("project_file", Path.Source.to_dyn project_file)
     ; ( "packages"
@@ -231,7 +230,6 @@ let to_dyn
     ; ("format_config", option Format_config.to_dyn format_config)
     ; ("strict_package_deps", bool strict_package_deps)
     ; ("cram", bool cram)
-    ; ("execution_parameters", Execution_parameters.to_dyn execution_parameters)
     ]
 
 let find_extension_args t key = Univ_map.find t.extension_args key
@@ -494,6 +492,7 @@ let infer ~dir packages =
   ; root
   ; info = Package.Info.empty
   ; version = None
+  ; dune_version = lang.version
   ; implicit_transitive_deps
   ; wrapped_executables
   ; executables_implicit_empty_intf
@@ -513,7 +512,6 @@ let infer ~dir packages =
   ; format_config = None
   ; strict_package_deps
   ; cram
-  ; execution_parameters = Execution_parameters.make ~dune_version:lang.version
   }
 
 module Toggle = struct
@@ -759,6 +757,7 @@ let parse ~dir ~lang ~opam_packages ~file ~dir_status =
         ; file_key
         ; root
         ; version
+        ; dune_version
         ; info
         ; packages
         ; stanza_parser
@@ -775,7 +774,6 @@ let parse ~dir ~lang ~opam_packages ~file ~dir_status =
         ; format_config
         ; strict_package_deps
         ; cram
-        ; execution_parameters = Execution_parameters.make ~dune_version
         }))
 
 let load_dune_project ~dir opam_packages ~dir_status =
@@ -827,3 +825,6 @@ let strict_package_deps t = t.strict_package_deps
 let cram t = t.cram
 
 let info t = t.info
+
+let update_execution_parameters t ep =
+  Execution_parameters.set_dune_version t.dune_version ep

src/dune_engine/dune_project.mli

@@ -169,4 +169,7 @@ val cram : t -> bool
 
 val info : t -> Package.Info.t
 
-val execution_parameters : t -> Execution_parameters.t
+(** Update the execution parameters according to what is written in the
+    [dune-project] file. *)
+val update_execution_parameters :
+  t -> Execution_parameters.t -> Execution_parameters.t