From d54a5ebe0d2df4511f56dbf26ab885235d4950c7 Mon Sep 17 00:00:00 2001
From: sheaf <sam.derbyshire@gmail.com>
Date: Thu, 16 Apr 2026 22:07:18 +0200
Subject: [PATCH] Mark output in LogProgress

Cabal's Distribution.Utils.LogProgress module failed to take into
account whether we are marking output or not, and simply never included
output markers.

We also make sure that warnings go to stderr not stdout, to be
consistent with `Distribution.Simple.Utils.warnMessage`.

In summary, the impact is that:

  - warning messages now consistently go to stderr
  - when running the testsuite, we are more consistent in tagging
    messages emitted by Cabal, with the 'BEGIN CABAL OUTPUT'/'END CABAL OUTPUT'
    markers.
---
 Cabal/src/Distribution/Utils/LogProgress.hs | 23 +++++++++++++++------
 1 file changed, 17 insertions(+), 6 deletions(-)

diff --git a/Cabal/src/Distribution/Utils/LogProgress.hs b/Cabal/src/Distribution/Utils/LogProgress.hs
index b8484eecc14..5f3ada889bf 100644
--- a/Cabal/src/Distribution/Utils/LogProgress.hs
+++ b/Cabal/src/Distribution/Utils/LogProgress.hs
@@ -16,11 +16,11 @@ import Prelude ()
 import Distribution.Simple.Utils
 import Distribution.Utils.Progress
 import Distribution.Verbosity
-import System.IO (hPutStrLn)
+import System.IO (hFlush, hPutStr, hPutStrLn)
 import Text.PrettyPrint
 
 type CtxMsg = Doc
-type LogMsg = Doc
+data LogMsg = WarnMsg Doc | InfoMsg Doc
 type ErrMsg = Doc
 
 data LogEnv = LogEnv
@@ -55,10 +55,19 @@ runLogProgress verbosity (LogProgress m) =
         , le_context = []
         }
     step_fn :: LogMsg -> IO a -> IO a
-    step_fn doc go = do
+    step_fn (WarnMsg doc) go = do
+      -- Log the warning to the stderr handle, but flush the stdout handle first,
+      -- to prevent interleaving (see Distribution.Simple.Utils.warnMessage).
+      let h = verbosityErrorHandle verbosity
+          flags = verbosityFlags verbosity
+      hFlush (verbosityChosenOutputHandle verbosity)
+      hPutStr h $ withOutputMarker flags (render doc ++ "\n")
+      go
+    step_fn (InfoMsg doc) go = do
+      -- Don't mark 'infoProgress' messages (mostly Backpack internals)
       hPutStrLn (verbosityChosenOutputHandle verbosity) (render doc)
       go
-    fail_fn :: Doc -> IO a
+    fail_fn :: ErrMsg -> IO a
     fail_fn doc = do
       dieNoWrap verbosity (render doc)
 
@@ -67,13 +76,15 @@ warnProgress :: Doc -> LogProgress ()
 warnProgress s = LogProgress $ \env ->
   when (verbosityLevel (le_verbosity env) >= Normal) $
     stepProgress $
-      hang (text "Warning:") 4 (formatMsg (le_context env) s)
+      WarnMsg $
+        hang (text "Warning:") 4 (formatMsg (le_context env) s)
 
 -- | Output an informational trace message in 'LogProgress'.
 infoProgress :: Doc -> LogProgress ()
 infoProgress s = LogProgress $ \env ->
   when (verbosityLevel (le_verbosity env) >= Verbose) $
-    stepProgress s
+    stepProgress $
+      InfoMsg s
 
 -- | Fail the computation with an error message.
 dieProgress :: Doc -> LogProgress a