Skip to content

Commit

Permalink
Write debug output to stderr
Browse files Browse the repository at this point in the history
  • Loading branch information
fredefox committed Nov 25, 2021
1 parent cff9b1a commit 1a031e3
Show file tree
Hide file tree
Showing 3 changed files with 26 additions and 26 deletions.
48 changes: 22 additions & 26 deletions Cabal/src/Distribution/Simple/Utils.hs
Original file line number Diff line number Diff line change
Expand Up @@ -423,7 +423,7 @@ topHandlerWith cont prog = do
handle se = do
hFlush stdout
pname <- getProgName
hPutStr stderr (message pname se)
putErr (message pname se)
cont se

message :: String -> Exception.SomeException -> String
Expand Down Expand Up @@ -457,11 +457,6 @@ displaySomeException se =
topHandler :: IO a -> IO a
topHandler prog = topHandlerWith (const $ exitWith (ExitFailure 1)) prog

verbosityHandle :: Verbosity -> Handle
verbosityHandle verbosity
| isVerboseStderr verbosity = stderr
| otherwise = stdout

-- | Non fatal conditions that may be indicative of an error or problem.
--
-- We display these at the 'normal' verbosity level.
Expand All @@ -471,9 +466,10 @@ warn verbosity msg = withFrozenCallStack $ do
when ((verbosity >= normal) && not (isVerboseNoWarn verbosity)) $ do
ts <- getPOSIXTime
hFlush stdout
hPutStr stderr . withMetadata ts NormalMark FlagTrace verbosity
. wrapTextVerbosity verbosity
$ "Warning: " ++ msg
putErr
. withMetadata ts NormalMark FlagTrace verbosity
. wrapTextVerbosity verbosity
$ "Warning: " ++ msg

-- | Useful status messages.
--
Expand All @@ -485,9 +481,8 @@ warn verbosity msg = withFrozenCallStack $ do
notice :: Verbosity -> String -> IO ()
notice verbosity msg = withFrozenCallStack $ do
when (verbosity >= normal) $ do
let h = verbosityHandle verbosity
ts <- getPOSIXTime
hPutStr h
putErr
$ withMetadata ts NormalMark FlagTrace verbosity
$ wrapTextVerbosity verbosity
$ msg
Expand All @@ -498,19 +493,17 @@ notice verbosity msg = withFrozenCallStack $ do
noticeNoWrap :: Verbosity -> String -> IO ()
noticeNoWrap verbosity msg = withFrozenCallStack $ do
when (verbosity >= normal) $ do
let h = verbosityHandle verbosity
ts <- getPOSIXTime
hPutStr h . withMetadata ts NormalMark FlagTrace verbosity $ msg
putErr . withMetadata ts NormalMark FlagTrace verbosity $ msg

-- | Pretty-print a 'Disp.Doc' status message at 'normal' verbosity
-- level. Use this if you need fancy formatting.
--
noticeDoc :: Verbosity -> Disp.Doc -> IO ()
noticeDoc verbosity msg = withFrozenCallStack $ do
when (verbosity >= normal) $ do
let h = verbosityHandle verbosity
ts <- getPOSIXTime
hPutStr h
putErr
$ withMetadata ts NormalMark FlagTrace verbosity
$ Disp.renderStyle defaultStyle
$ msg
Expand All @@ -529,34 +522,38 @@ setupMessage verbosity msg pkgid = withFrozenCallStack $ do
info :: Verbosity -> String -> IO ()
info verbosity msg = withFrozenCallStack $
when (verbosity >= verbose) $ do
let h = verbosityHandle verbosity
ts <- getPOSIXTime
hPutStr h
putErr
$ withMetadata ts NeverMark FlagTrace verbosity
$ wrapTextVerbosity verbosity
$ msg

infoNoWrap :: Verbosity -> String -> IO ()
infoNoWrap verbosity msg = withFrozenCallStack $
when (verbosity >= verbose) $ do
let h = verbosityHandle verbosity
ts <- getPOSIXTime
hPutStr h
putErr
$ withMetadata ts NeverMark FlagTrace verbosity
$ msg

putErr :: String -> IO ()
putErr = hPutStr stderr

putErrLn :: String -> IO ()
putErrLn = hPutStrLn stderr

-- | Detailed internal debugging information
--
-- We display these messages when the verbosity level is 'deafening'
--
debug :: Verbosity -> String -> IO ()
debug verbosity msg = withFrozenCallStack $
when (verbosity >= deafening) $ do
let h = verbosityHandle verbosity
ts <- getPOSIXTime
hPutStr h $ withMetadata ts NeverMark FlagTrace verbosity
$ wrapTextVerbosity verbosity
$ msg
putErr
$ withMetadata ts NeverMark FlagTrace verbosity
$ wrapTextVerbosity verbosity
$ msg
-- ensure that we don't lose output if we segfault/infinite loop
hFlush stdout

Expand All @@ -565,9 +562,8 @@ debug verbosity msg = withFrozenCallStack $
debugNoWrap :: Verbosity -> String -> IO ()
debugNoWrap verbosity msg = withFrozenCallStack $
when (verbosity >= deafening) $ do
let h = verbosityHandle verbosity
ts <- getPOSIXTime
hPutStr h
putErr
$ withMetadata ts NeverMark FlagTrace verbosity
$ msg
-- ensure that we don't lose output if we segfault/infinite loop
Expand All @@ -580,7 +576,7 @@ chattyTry :: String -- ^ a description of the action we were attempting
-> IO ()
chattyTry desc action =
catchIO action $ \exception ->
hPutStrLn stderr $ "Error while " ++ desc ++ ": " ++ show exception
putErrLn $ "Error while " ++ desc ++ ": " ++ show exception

-- | Run an IO computation, returning @e@ if it raises a "file
-- does not exist" error.
Expand Down
1 change: 1 addition & 0 deletions Cabal/src/Distribution/Verbosity.hs
Original file line number Diff line number Diff line change
Expand Up @@ -343,6 +343,7 @@ isVerboseTimestamp = isVerboseFlag VTimestamp
-- @since 3.4.0.0
isVerboseStderr :: Verbosity -> Bool
isVerboseStderr = isVerboseFlag VStderr
{-# DEPRECATED isVerboseStderr "Cabal output should generally not go to stdout." #-}

-- | Test if we should output warnings when we log.
isVerboseNoWarn :: Verbosity -> Bool
Expand Down
3 changes: 3 additions & 0 deletions changelog.d/issue-7790
Original file line number Diff line number Diff line change
@@ -0,0 +1,3 @@
synopsis: `cabal run` should send info logging to stderr not stdout
packages: Cabal
issues: #7790

0 comments on commit 1a031e3

Please sign in to comment.