pkg: simplify the display logs (#10662)

Only logs the standard output when the command fails or the user
explicitly requests it.

Add new flag `--debug-package-logs`, which force dune to display the
stdout logs when dealing with package management.

Signed-off-by: Etienne Marais <[email protected]>
Signed-off-by: Christine Rose <[email protected]>
Signed-off-by: Etienne Millon <[email protected]>

bin/common.ml

@@ -567,6 +567,7 @@ module Builder = struct
     ; debug_artifact_substitution : bool
     ; debug_load_dir : bool
     ; debug_digests : bool
+    ; debug_package_logs : bool
     ; wait_for_filesystem_clock : bool
     ; only_packages : Only_packages.Clflags.t
     ; capture_outputs : bool
@@ -666,6 +667,16 @@ module Builder = struct
             [ "debug-digests" ]
             ~docs
             ~doc:"Explain why Dune decides to re-digest some files")
+    and+ debug_package_logs =
+      let doc = "Always print the standard logs when building packages" in
+      Arg.(
+        value
+        & flag
+        & info
+            [ "debug-package-logs" ]
+            ~docs
+            ~doc
+            ~env:(Cmd.Env.info ~doc "DUNE_DEBUG_PACKAGE_LOGS"))
     and+ no_buffer =
       let doc =
         "Do not buffer the output of commands executed by dune. By default dune buffers \
@@ -970,6 +981,7 @@ module Builder = struct
     ; debug_artifact_substitution
     ; debug_load_dir
     ; debug_digests
+    ; debug_package_logs
     ; wait_for_filesystem_clock
     ; only_packages
     ; capture_outputs = not no_buffer
@@ -1236,6 +1248,7 @@ let init (builder : Builder.t) =
   Dune_engine.Clflags.debug_load_dir := c.builder.debug_load_dir;
   Dune_engine.Clflags.debug_fs_cache := c.builder.cache_debug_flags.fs_cache;
   Dune_digest.Clflags.debug_digests := c.builder.debug_digests;
+  Dune_rules.Clflags.debug_package_logs := c.builder.debug_package_logs;
   Dune_digest.Clflags.wait_for_filesystem_clock := c.builder.wait_for_filesystem_clock;
   Dune_engine.Clflags.capture_outputs := c.builder.capture_outputs;
   Dune_engine.Clflags.diff_command := c.builder.diff_command;

doc/changes/10662.md

@@ -0,0 +1,3 @@
+- pkg: only logs the standard output when the command fails or the user explicitly requests it.
+  Add new flag `--debug-package-logs`, which force dune to display the stdout logs when dealing
+  with package management (#10662, @maiste)

src/dune_rules/clflags.ml

@@ -4,6 +4,7 @@ let promote_install_files = ref false
 let display = Dune_engine.Clflags.display
 let capture_outputs = Dune_engine.Clflags.capture_outputs
 let debug_artifact_substitution = ref false
+let debug_package_logs = ref false
 let ignore_lock_dir = ref false
 
 type on_missing_dune_project_file =

src/dune_rules/clflags.mli

@@ -16,6 +16,9 @@ val capture_outputs : bool ref
 (** Print debug info about artifact substitution *)
 val debug_artifact_substitution : bool ref
 
+(** Print package output when building with package management *)
+val debug_package_logs : bool ref
+
 (** Whether we are ignoring "dune.lock/". *)
 val ignore_lock_dir : bool ref
 

src/dune_rules/pkg_rules.ml

@@ -9,6 +9,7 @@ include struct
   module Checksum = Checksum
   module Source = Source
   module Build_command = Lock_dir.Build_command
+  module Display = Dune_engine.Display
 end
 
 module Variable = struct
@@ -405,7 +406,8 @@ module Expander0 = struct
   include Expander0
 
   type t =
-    { paths : Paths.t
+    { name : Dune_pkg.Package_name.t
+    ; paths : Paths.t
     ; artifacts : Path.t Filename.Map.t
     ; depends : (Variable.value Package_variable_name.Map.t * Paths.t) Package.Name.Map.t
     ; context : Context_name.t
@@ -514,6 +516,63 @@ module Substitute = struct
 end
 
 module Run_with_path = struct
+  module Output : sig
+    type error
+
+    val io : error -> Process.Io.output Process.Io.t
+
+    val with_error
+      :  accepted_exit_codes:int Predicate.t
+      -> pkg:Dune_pkg.Package_name.t * Loc.t
+      -> display:Display.t
+      -> (error -> 'a)
+      -> 'a
+
+    val prerr : rc:int -> error -> unit
+  end = struct
+    type error =
+      { pkg : Dune_pkg.Package_name.t * Loc.t
+      ; filename : Dpath.t
+      ; io : Process.Io.output Process.Io.t
+      ; accepted_exit_codes : int Predicate.t
+      ; display : Display.t
+      }
+
+    let io t = t.io
+
+    let with_error ~accepted_exit_codes ~pkg ~display f =
+      let filename = Temp.create File ~prefix:"dune-pkg" ~suffix:"stderr" in
+      let io = Process.Io.(file filename Out) in
+      let t = { filename; io; accepted_exit_codes; display; pkg } in
+      let result = f t in
+      Temp.destroy File filename;
+      result
+    ;;
+
+    let to_paragraphs t error =
+      let pp_pkg =
+        let pkg_name = Dune_pkg.Package_name.to_string (fst t.pkg) in
+        Pp.textf "Logs for package %s" pkg_name
+      in
+      let loc = snd t.pkg in
+      [ pp_pkg; Pp.verbatim error ], loc
+    ;;
+
+    let prerr ~rc error =
+      match Predicate.test error.accepted_exit_codes rc, error.display with
+      | false, _ ->
+        let paragraphs, loc = Stdune.Io.read_file error.filename |> to_paragraphs error in
+        User_warning.emit ~loc ~is_error:true paragraphs
+      | true, Display.Verbose ->
+        let content = Stdune.Io.read_file error.filename in
+        if not (String.is_empty content)
+        then (
+          let paragraphs, loc = to_paragraphs error content in
+          User_warning.emit ~loc paragraphs)
+      | true, _ -> ()
+    ;;
+  end
+
   module Spec = struct
     type 'path chunk =
       | String of string
@@ -525,6 +584,7 @@ module Run_with_path = struct
       { prog : Action.Prog.t
       ; args : 'path arg Array.Immutable.t
       ; ocamlfind_destdir : 'path
+      ; pkg : Dune_pkg.Package_name.t * Loc.t
       }
 
     let name = "run-with-path"
@@ -545,7 +605,7 @@ module Run_with_path = struct
 
     let is_useful_to ~memoize:_ = true
 
-    let encode { prog; args; ocamlfind_destdir } path _ : Dune_lang.t =
+    let encode { prog; args; ocamlfind_destdir; pkg = _ } path _ : Dune_lang.t =
       let prog =
         Dune_lang.atom_or_quoted_string
         @@
@@ -567,11 +627,12 @@ module Run_with_path = struct
     ;;
 
     let action
-      { prog; args; ocamlfind_destdir }
+      { prog; args; ocamlfind_destdir; pkg }
       ~(ectx : Action.Ext.context)
       ~(eenv : Action.Ext.env)
       =
       let open Fiber.O in
+      let display = !Clflags.display in
       match prog with
       | Error e -> Action.Prog.Not_found.raise e
       | Ok prog ->
@@ -589,31 +650,37 @@ module Run_with_path = struct
             ~var:"OCAMLFIND_DESTDIR"
             ~value:(Path.to_absolute_filename ocamlfind_destdir)
         in
-        Process.run
-          (Accept eenv.exit_codes)
-          prog
-          args
-          ~display:!Clflags.display
-          ~metadata
-          ~stdout_to:eenv.stdout_to
-          ~stderr_to:eenv.stderr_to
-          ~stdin_from:eenv.stdin_from
-          ~dir:eenv.working_dir
-          ~env
-        >>= (function
-         | Error _ -> Fiber.return ()
-         | Ok () -> Fiber.return ())
+        Output.with_error ~accepted_exit_codes:eenv.exit_codes ~pkg ~display (fun error ->
+          let stdout_to =
+            match !Clflags.debug_package_logs, display with
+            | true, _ | false, Display.Verbose -> eenv.stdout_to
+            | _ -> Process.Io.(null Out)
+          in
+          Process.run
+            Return
+            prog
+            args
+            ~display
+            ~metadata
+            ~stdout_to
+            ~stderr_to:(Output.io error)
+            ~stdin_from:eenv.stdin_from
+            ~dir:eenv.working_dir
+            ~env
+          >>= fun (_, rc) ->
+          Output.prerr ~rc error;
+          Fiber.return ())
     ;;
   end
 
-  let action prog args ~ocamlfind_destdir =
+  let action ~pkg prog args ~ocamlfind_destdir =
     let module M = struct
       type path = Path.t
       type target = Path.Build.t
 
       module Spec = Spec
 
-      let v = { Spec.prog; args; ocamlfind_destdir }
+      let v = { Spec.prog; args; ocamlfind_destdir; pkg }
     end
     in
     Action.Extension (module M)
@@ -742,7 +809,7 @@ module Action_expander = struct
     ;;
 
     let expand_pform
-      { env = _; paths; artifacts = _; context; depends; version = _ }
+      { name = _; env = _; paths; artifacts = _; context; depends; version = _ }
       ~source
       (pform : Pform.t)
       : (Value.t list, [ `Undefined_pkg_var of Package_variable_name.t ]) result Memo.t
@@ -877,7 +944,7 @@ module Action_expander = struct
          let ocamlfind_destdir =
            (Lazy.force expander.paths.install_roots).lib_root |> Path.build
          in
-         Run_with_path.action exe args ~ocamlfind_destdir)
+         Run_with_path.action ~pkg:(expander.name, prog_loc) exe args ~ocamlfind_destdir)
     | Progn t ->
       let+ args = Memo.parallel_map t ~f:(expand ~expander) in
       Action.Progn args
@@ -1007,6 +1074,7 @@ module Action_expander = struct
         (Pkg_info.variables pkg.info, pkg.paths)
     in
     { Expander.paths = pkg.paths
+    ; name = pkg.info.name
     ; artifacts = binaries
     ; context
     ; depends

test/blackbox-tests/test-cases/pkg/build-package-logs.t

@@ -0,0 +1,48 @@
+Test the error message when installing package that fails.
+
+  $ . ./helpers.sh
+  $ make_lockdir
+  $ export DUNE_DEBUG_PACKAGE_LOGS=0
+
+Make a project with two packages, one successful and one that fails:
+
+  $ cat > dune-project << EOF
+  > (lang dune 3.12)
+  > EOF
+
+Create a package with a failing command that throws an error:
+
+  $ make_lockpkg x << EOF
+  > (version 0.0.1)
+  > (build
+  >    (progn
+  >       (run cat i_dont_exist)))
+  > EOF
+
+Building the package should fail and print an error:
+
+  $ build_pkg x 2>&1 | sed -E 's#/.*/cat#cat#g'
+  File "dune.lock/x.pkg", line 4, characters 11-14:
+  4 |       (run cat i_dont_exist)))
+                 ^^^
+  Error: Logs for package x
+  cat: i_dont_exist: No such file or directory
+
+
+Create a package with a succeeding command that displays some text:
+
+  $ make_lockpkg y << EOF
+  > (version 0.0.1)
+  > (build
+  >    (progn
+  >       (run echo "Success!")))
+  > EOF
+
+Building the package should succeed and print no output:
+
+  $ build_pkg y
+
+Checks the package is installed:
+
+  $ show_pkg_cookie y
+  { files = map {}; variables = [] }

test/blackbox-tests/test-cases/pkg/dune

@@ -2,6 +2,11 @@
  (alias pkg)
  (applies_to :whole_subtree))
 
+(env
+ (_
+  (env-vars
+   (DUNE_DEBUG_PACKAGE_LOGS 1))))
+
 (cram
  (deps helpers.sh)
  (applies_to :whole_subtree))

test/blackbox-tests/test-cases/pkg/pin-stanza/update-non-dune-local-pin.t

@@ -41,7 +41,10 @@ Attempt to build the package the first time:
   echo aaa
   aaa
   false
-  -> required by _build/_private/default/.pkg/foo/target/cookie
+  File "dune.lock/foo.pkg", line 4, characters 6-13:
+            ^^^^^^^
+  Error: Logs for package foo
+
 
 Update the message that gets printed while building foo:
   $ cat >foo/Makefile <<EOF
@@ -55,4 +58,7 @@ The change to the package is picked up:
   echo bbb
   bbb
   false
-  -> required by _build/_private/default/.pkg/foo/target/cookie
+  File "dune.lock/foo.pkg", line 4, characters 6-13:
+            ^^^^^^^
+  Error: Logs for package foo
+