Skip to content

Commit 0ec6cbc

Browse files
committed
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.
1 parent 03cc2dc commit 0ec6cbc

1 file changed

Lines changed: 17 additions & 6 deletions

File tree

Cabal/src/Distribution/Utils/LogProgress.hs

Lines changed: 17 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -16,11 +16,11 @@ import Prelude ()
1616
import Distribution.Simple.Utils
1717
import Distribution.Utils.Progress
1818
import Distribution.Verbosity
19-
import System.IO (hPutStrLn)
19+
import System.IO (hFlush, hPutStr, hPutStrLn)
2020
import Text.PrettyPrint
2121

2222
type CtxMsg = Doc
23-
type LogMsg = Doc
23+
data LogMsg = WarnMsg Doc | InfoMsg Doc
2424
type ErrMsg = Doc
2525

2626
data LogEnv = LogEnv
@@ -55,10 +55,19 @@ runLogProgress verbosity (LogProgress m) =
5555
, le_context = []
5656
}
5757
step_fn :: LogMsg -> IO a -> IO a
58-
step_fn doc go = do
58+
step_fn (WarnMsg doc) go = do
59+
-- Log the warning to the stderr handle, but flush the stdout handle first,
60+
-- to prevent interleaving (see Distribution.Simple.Utils.warnMessage).
61+
let h = verbosityErrorHandle verbosity
62+
flags = verbosityFlags verbosity
63+
hFlush (verbosityChosenOutputHandle verbosity)
64+
hPutStr h $ withOutputMarker flags (render doc ++ "\n")
65+
go
66+
step_fn (InfoMsg doc) go = do
67+
-- Don't mark 'infoProgress' messages (mostly Backpack internals)
5968
hPutStrLn (verbosityChosenOutputHandle verbosity) (render doc)
6069
go
61-
fail_fn :: Doc -> IO a
70+
fail_fn :: ErrMsg -> IO a
6271
fail_fn doc = do
6372
dieNoWrap verbosity (render doc)
6473

@@ -67,13 +76,15 @@ warnProgress :: Doc -> LogProgress ()
6776
warnProgress s = LogProgress $ \env ->
6877
when (verbosityLevel (le_verbosity env) >= Normal) $
6978
stepProgress $
70-
hang (text "Warning:") 4 (formatMsg (le_context env) s)
79+
WarnMsg $
80+
hang (text "Warning:") 4 (formatMsg (le_context env) s)
7181

7282
-- | Output an informational trace message in 'LogProgress'.
7383
infoProgress :: Doc -> LogProgress ()
7484
infoProgress s = LogProgress $ \env ->
7585
when (verbosityLevel (le_verbosity env) >= Verbose) $
76-
stepProgress s
86+
stepProgress $
87+
InfoMsg s
7788

7889
-- | Fail the computation with an error message.
7990
dieProgress :: Doc -> LogProgress a

0 commit comments

Comments
 (0)