Commit afc23fdd authored by Edward Z. Yang's avatar Edward Z. Yang Committed by Edward Z. Yang
Browse files

Marked output support in Setup


Signed-off-by: default avatarEdward Z. Yang <ezyang@cs.stanford.edu>
parent a243411d
......@@ -213,7 +213,7 @@ import System.Directory
( createDirectory, removeDirectoryRecursive )
import System.IO
( Handle, hSetBinaryMode, hGetContents, stderr, stdout, hPutStr, hFlush
, hClose )
, hClose, hPutStrLn )
import System.IO.Error as IO.Error
( isDoesNotExistError, isAlreadyExistsError
, ioeSetFileName, ioeGetFileName, ioeGetErrorString )
......@@ -329,14 +329,14 @@ hPutCallStackPrefix h verbosity = withFrozenCallStack $ do
dieMsg :: Verbosity -> String -> NoCallStackIO ()
dieMsg verbosity msg = do
hFlush stdout
hPutStr stderr (wrapTextVerbosity verbosity msg)
errWithMarker verbosity (wrapTextVerbosity verbosity msg)
-- | As 'dieMsg' but with pre-formatted text.
--
dieMsgNoWrap :: Verbosity -> String -> NoCallStackIO ()
dieMsgNoWrap _verbosity msg = do
dieMsgNoWrap verbosity msg = do
hFlush stdout
hPutStr stderr msg
errWithMarker verbosity msg
-- | Non fatal conditions that may be indicative of an error or problem.
--
......@@ -347,7 +347,7 @@ warn verbosity msg = withFrozenCallStack $ do
when (verbosity >= normal) $ do
hFlush stdout
hPutCallStackPrefix stderr verbosity
hPutStr stderr (wrapTextVerbosity verbosity ("Warning: " ++ msg))
errWithMarker verbosity (wrapTextVerbosity verbosity ("Warning: " ++ msg))
-- | Useful status messages.
--
......@@ -360,13 +360,13 @@ notice :: Verbosity -> String -> IO ()
notice verbosity msg = withFrozenCallStack $ do
when (verbosity >= normal) $ do
hPutCallStackPrefix stdout verbosity
putStr (wrapTextVerbosity verbosity msg)
outWithMarker verbosity (wrapTextVerbosity verbosity msg)
noticeNoWrap :: Verbosity -> String -> IO ()
noticeNoWrap verbosity msg = withFrozenCallStack $ do
when (verbosity >= normal) $ do
hPutCallStackPrefix stdout verbosity
putStr msg
outWithMarker verbosity msg
-- | Pretty-print a 'Disp.Doc' status message at 'normal' verbosity
-- level. Use this if you need fancy formatting.
......@@ -375,7 +375,19 @@ noticeDoc :: Verbosity -> Disp.Doc -> IO ()
noticeDoc verbosity msg = withFrozenCallStack $ do
when (verbosity >= normal) $ do
hPutCallStackPrefix stdout verbosity
putStrLn (Disp.renderStyle defaultStyle msg)
outWithMarker verbosity (Disp.renderStyle defaultStyle msg ++ "\n")
hWithMarker :: Handle -> Verbosity -> String -> NoCallStackIO ()
hWithMarker h v xs | not (isVerboseMarkOutput v) = hPutStr h xs
hWithMarker _ _ [] = return ()
hWithMarker h _ xs = do
hPutStrLn h "-----BEGIN CABAL OUTPUT-----"
hPutStr h (if last xs == '\n' then xs else xs ++ "\n")
hPutStrLn h "-----END CABAL OUTPUT-----"
outWithMarker, errWithMarker :: Verbosity -> String -> IO ()
outWithMarker = hWithMarker stdout
errWithMarker = hWithMarker stderr
setupMessage :: Verbosity -> String -> PackageIdentifier -> IO ()
setupMessage verbosity msg pkgid = withFrozenCallStack $ do
......
......@@ -36,6 +36,9 @@ module Distribution.Verbosity (
verboseCallSite, verboseCallStack,
isVerboseCallSite, isVerboseCallStack,
-- * Output markets
verboseMarkOutput, isVerboseMarkOutput,
-- * line-wrapping
verboseNoWrap, isVerboseNoWrap,
) where
......@@ -145,6 +148,7 @@ parseVerbosity = parseIntVerbosity <++ parseStringVerbosity
[ string "callsite" >> return verboseCallSite
, string "callstack" >> return verboseCallStack
, string "nowrap" >> return verboseNoWrap
, string "markoutput" >> return verboseMarkOutput
]
flagToVerbosity :: ReadE Verbosity
......@@ -175,6 +179,7 @@ showForCabal v
showFlag VCallSite = "+callsite"
showFlag VCallStack = "+callstack"
showFlag VNoWrap = "+nowrap"
showFlag VMarkOutput = "+markoutput"
showForGHC v = maybe (error "unknown verbosity") show $
elemIndex v [silent,normal,__,verbose,deafening]
where __ = silent -- this will be always ignored by elemIndex
......@@ -183,6 +188,7 @@ data VerbosityFlag
= VCallStack
| VCallSite
| VNoWrap
| VMarkOutput
deriving (Generic, Show, Read, Eq, Ord, Enum, Bounded)
instance Binary VerbosityFlag
......@@ -195,6 +201,11 @@ verboseCallSite = verboseFlag VCallSite
verboseCallStack :: Verbosity -> Verbosity
verboseCallStack = verboseFlag VCallStack
-- | Turn on @-----BEGIN CABAL OUTPUT-----@ markers for output
-- from Cabal (as opposed to GHC, or system dependent).
verboseMarkOutput :: Verbosity -> Verbosity
verboseMarkOutput = verboseFlag VMarkOutput
-- | Disable line-wrapping for log messages.
verboseNoWrap :: Verbosity -> Verbosity
verboseNoWrap = verboseFlag VNoWrap
......@@ -217,6 +228,10 @@ isVerboseCallSite = isVerboseFlag VCallSite
isVerboseCallStack :: Verbosity -> Bool
isVerboseCallStack = isVerboseFlag VCallStack
-- | Test if we should output markets.
isVerboseMarkOutput :: Verbosity -> Bool
isVerboseMarkOutput = isVerboseFlag VMarkOutput
-- | Test if line-wrapping is disabled for log messages.
isVerboseNoWrap :: Verbosity -> Bool
isVerboseNoWrap = isVerboseFlag VNoWrap
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment