module Distribution.Verbosity (
Verbosity,
silent, normal, verbose, deafening,
moreVerbose, lessVerbose, isVerboseQuiet,
intToVerbosity, flagToVerbosity,
showForCabal, showForGHC,
verboseNoFlags, verboseHasFlags,
modifyVerbosity,
verboseCallSite, verboseCallStack,
isVerboseCallSite, isVerboseCallStack,
verboseMarkOutput, isVerboseMarkOutput,
verboseUnmarkOutput,
verboseNoWrap, isVerboseNoWrap,
verboseTimestamp, isVerboseTimestamp,
verboseNoTimestamp,
verboseStderr, isVerboseStderr,
verboseNoStderr,
) where
import Prelude ()
import Distribution.Compat.Prelude
import Distribution.ReadE
import Data.List (elemIndex)
import Distribution.Parsec
import Distribution.Pretty
import Distribution.Verbosity.Internal
import Distribution.Utils.Generic (isAsciiAlpha)
import qualified Data.Set as Set
import qualified Distribution.Compat.CharParsing as P
import qualified Text.PrettyPrint as PP
data Verbosity = Verbosity {
vLevel :: VerbosityLevel,
vFlags :: Set VerbosityFlag,
vQuiet :: Bool
} deriving (Generic, Show, Read, Typeable)
mkVerbosity :: VerbosityLevel -> Verbosity
mkVerbosity l = Verbosity { vLevel = l, vFlags = Set.empty, vQuiet = False }
instance Eq Verbosity where
x == y = vLevel x == vLevel y
instance Ord Verbosity where
compare x y = compare (vLevel x) (vLevel y)
instance Enum Verbosity where
toEnum = mkVerbosity . toEnum
fromEnum = fromEnum . vLevel
instance Bounded Verbosity where
minBound = mkVerbosity minBound
maxBound = mkVerbosity maxBound
instance Binary Verbosity
instance Structured Verbosity
silent :: Verbosity
silent = mkVerbosity Silent
normal :: Verbosity
normal = mkVerbosity Normal
verbose :: Verbosity
verbose = mkVerbosity Verbose
deafening :: Verbosity
deafening = mkVerbosity Deafening
moreVerbose :: Verbosity -> Verbosity
moreVerbose v =
case vLevel v of
Silent -> v
Normal -> v { vLevel = Verbose }
Verbose -> v { vLevel = Deafening }
Deafening -> v
lessVerbose :: Verbosity -> Verbosity
lessVerbose v =
verboseQuiet $
case vLevel v of
Deafening -> v
Verbose -> v { vLevel = Normal }
Normal -> v { vLevel = Silent }
Silent -> v
modifyVerbosity :: (Verbosity -> Verbosity) -> Verbosity -> Verbosity
modifyVerbosity f v = v { vLevel = vLevel (f v) }
intToVerbosity :: Int -> Maybe Verbosity
intToVerbosity 0 = Just (mkVerbosity Silent)
intToVerbosity 1 = Just (mkVerbosity Normal)
intToVerbosity 2 = Just (mkVerbosity Verbose)
intToVerbosity 3 = Just (mkVerbosity Deafening)
intToVerbosity _ = Nothing
instance Parsec Verbosity where
parsec = parsecVerbosity
instance Pretty Verbosity where
pretty = PP.text . showForCabal
parsecVerbosity :: CabalParsing m => m Verbosity
parsecVerbosity = parseIntVerbosity <|> parseStringVerbosity
where
parseIntVerbosity = do
i <- P.integral
case intToVerbosity i of
Just v -> return v
Nothing -> P.unexpected $ "Bad integral verbosity: " ++ show i ++ ". Valid values are 0..3"
parseStringVerbosity = do
level <- parseVerbosityLevel
_ <- P.spaces
flags <- many (parseFlag <* P.spaces)
return $ foldl' (flip ($)) (mkVerbosity level) flags
parseVerbosityLevel = do
token <- P.munch1 isAsciiAlpha
case token of
"silent" -> return Silent
"normal" -> return Normal
"verbose" -> return Verbose
"debug" -> return Deafening
"deafening" -> return Deafening
_ -> P.unexpected $ "Bad verbosity level: " ++ token
parseFlag = do
_ <- P.char '+'
token <- P.munch1 isAsciiAlpha
case token of
"callsite" -> return verboseCallSite
"callstack" -> return verboseCallStack
"nowrap" -> return verboseNoWrap
"markoutput" -> return verboseMarkOutput
"timestamp" -> return verboseTimestamp
"stderr" -> return verboseStderr
"stdout" -> return verboseNoStderr
_ -> P.unexpected $ "Bad verbosity flag: " ++ token
flagToVerbosity :: ReadE Verbosity
flagToVerbosity = parsecToReadE id parsecVerbosity
showForCabal :: Verbosity -> String
showForCabal v
| Set.null (vFlags v)
= maybe (error "unknown verbosity") show $
elemIndex v [silent,normal,verbose,deafening]
| otherwise
= unwords
$ showLevel (vLevel v)
: concatMap showFlag (Set.toList (vFlags v))
where
showLevel Silent = "silent"
showLevel Normal = "normal"
showLevel Verbose = "verbose"
showLevel Deafening = "debug"
showFlag VCallSite = ["+callsite"]
showFlag VCallStack = ["+callstack"]
showFlag VNoWrap = ["+nowrap"]
showFlag VMarkOutput = ["+markoutput"]
showFlag VTimestamp = ["+timestamp"]
showFlag VStderr = ["+stderr"]
showForGHC :: Verbosity -> String
showForGHC v = maybe (error "unknown verbosity") show $
elemIndex v [silent,normal,__,verbose,deafening]
where __ = silent
verboseCallSite :: Verbosity -> Verbosity
verboseCallSite = verboseFlag VCallSite
verboseCallStack :: Verbosity -> Verbosity
verboseCallStack = verboseFlag VCallStack
verboseMarkOutput :: Verbosity -> Verbosity
verboseMarkOutput = verboseFlag VMarkOutput
verboseUnmarkOutput :: Verbosity -> Verbosity
verboseUnmarkOutput = verboseNoFlag VMarkOutput
verboseNoWrap :: Verbosity -> Verbosity
verboseNoWrap = verboseFlag VNoWrap
verboseQuiet :: Verbosity -> Verbosity
verboseQuiet v = v { vQuiet = True }
verboseTimestamp :: Verbosity -> Verbosity
verboseTimestamp = verboseFlag VTimestamp
verboseNoTimestamp :: Verbosity -> Verbosity
verboseNoTimestamp = verboseNoFlag VTimestamp
verboseStderr :: Verbosity -> Verbosity
verboseStderr = verboseFlag VStderr
verboseNoStderr :: Verbosity -> Verbosity
verboseNoStderr = verboseNoFlag VStderr
verboseFlag :: VerbosityFlag -> (Verbosity -> Verbosity)
verboseFlag flag v = v { vFlags = Set.insert flag (vFlags v) }
verboseNoFlag :: VerbosityFlag -> (Verbosity -> Verbosity)
verboseNoFlag flag v = v { vFlags = Set.delete flag (vFlags v) }
verboseNoFlags :: Verbosity -> Verbosity
verboseNoFlags v = v { vFlags = Set.empty }
verboseHasFlags :: Verbosity -> Bool
verboseHasFlags = not . Set.null . vFlags
isVerboseCallSite :: Verbosity -> Bool
isVerboseCallSite = isVerboseFlag VCallSite
isVerboseCallStack :: Verbosity -> Bool
isVerboseCallStack = isVerboseFlag VCallStack
isVerboseMarkOutput :: Verbosity -> Bool
isVerboseMarkOutput = isVerboseFlag VMarkOutput
isVerboseNoWrap :: Verbosity -> Bool
isVerboseNoWrap = isVerboseFlag VNoWrap
isVerboseQuiet :: Verbosity -> Bool
isVerboseQuiet = vQuiet
isVerboseTimestamp :: Verbosity -> Bool
isVerboseTimestamp = isVerboseFlag VTimestamp
isVerboseStderr :: Verbosity -> Bool
isVerboseStderr = isVerboseFlag VStderr
isVerboseFlag :: VerbosityFlag -> Verbosity -> Bool
isVerboseFlag flag = (Set.member flag) . vFlags