1{-# LANGUAGE DeriveDataTypeable #-} 2{-# LANGUAGE DeriveGeneric #-} 3 4----------------------------------------------------------------------------- 5-- | 6-- Module : Distribution.Verbosity 7-- Copyright : Ian Lynagh 2007 8-- License : BSD3 9-- 10-- Maintainer : cabal-devel@haskell.org 11-- Portability : portable 12-- 13-- A 'Verbosity' type with associated utilities. 14-- 15-- There are 4 standard verbosity levels from 'silent', 'normal', 16-- 'verbose' up to 'deafening'. This is used for deciding what logging 17-- messages to print. 18-- 19-- Verbosity also is equipped with some internal settings which can be 20-- used to control at a fine granularity the verbosity of specific 21-- settings (e.g., so that you can trace only particular things you 22-- are interested in.) It's important to note that the instances 23-- for 'Verbosity' assume that this does not exist. 24 25-- Verbosity for Cabal functions. 26 27module Distribution.Verbosity ( 28 -- * Verbosity 29 Verbosity, 30 silent, normal, verbose, deafening, 31 moreVerbose, lessVerbose, isVerboseQuiet, 32 intToVerbosity, flagToVerbosity, 33 showForCabal, showForGHC, 34 verboseNoFlags, verboseHasFlags, 35 modifyVerbosity, 36 37 -- * Call stacks 38 verboseCallSite, verboseCallStack, 39 isVerboseCallSite, isVerboseCallStack, 40 41 -- * Output markets 42 verboseMarkOutput, isVerboseMarkOutput, 43 verboseUnmarkOutput, 44 45 -- * line-wrapping 46 verboseNoWrap, isVerboseNoWrap, 47 48 -- * timestamps 49 verboseTimestamp, isVerboseTimestamp, 50 verboseNoTimestamp, 51 52 -- * Stderr 53 verboseStderr, isVerboseStderr, 54 verboseNoStderr, 55 ) where 56 57import Prelude () 58import Distribution.Compat.Prelude 59 60import Distribution.ReadE 61 62import Data.List (elemIndex) 63import Distribution.Parsec 64import Distribution.Pretty 65import Distribution.Verbosity.Internal 66import Distribution.Utils.Generic (isAsciiAlpha) 67 68import qualified Data.Set as Set 69import qualified Distribution.Compat.CharParsing as P 70import qualified Text.PrettyPrint as PP 71 72data Verbosity = Verbosity { 73 vLevel :: VerbosityLevel, 74 vFlags :: Set VerbosityFlag, 75 vQuiet :: Bool 76 } deriving (Generic, Show, Read, Typeable) 77 78mkVerbosity :: VerbosityLevel -> Verbosity 79mkVerbosity l = Verbosity { vLevel = l, vFlags = Set.empty, vQuiet = False } 80 81instance Eq Verbosity where 82 x == y = vLevel x == vLevel y 83 84instance Ord Verbosity where 85 compare x y = compare (vLevel x) (vLevel y) 86 87instance Enum Verbosity where 88 toEnum = mkVerbosity . toEnum 89 fromEnum = fromEnum . vLevel 90 91instance Bounded Verbosity where 92 minBound = mkVerbosity minBound 93 maxBound = mkVerbosity maxBound 94 95instance Binary Verbosity 96instance Structured Verbosity 97 98-- We shouldn't print /anything/ unless an error occurs in silent mode 99silent :: Verbosity 100silent = mkVerbosity Silent 101 102-- Print stuff we want to see by default 103normal :: Verbosity 104normal = mkVerbosity Normal 105 106-- Be more verbose about what's going on 107verbose :: Verbosity 108verbose = mkVerbosity Verbose 109 110-- Not only are we verbose ourselves (perhaps even noisier than when 111-- being "verbose"), but we tell everything we run to be verbose too 112deafening :: Verbosity 113deafening = mkVerbosity Deafening 114 115moreVerbose :: Verbosity -> Verbosity 116moreVerbose v = 117 case vLevel v of 118 Silent -> v -- silent should stay silent 119 Normal -> v { vLevel = Verbose } 120 Verbose -> v { vLevel = Deafening } 121 Deafening -> v 122 123lessVerbose :: Verbosity -> Verbosity 124lessVerbose v = 125 verboseQuiet $ 126 case vLevel v of 127 Deafening -> v -- deafening stays deafening 128 Verbose -> v { vLevel = Normal } 129 Normal -> v { vLevel = Silent } 130 Silent -> v 131 132-- | Combinator for transforming verbosity level while retaining the 133-- original hidden state. 134-- 135-- For instance, the following property holds 136-- 137-- prop> isVerboseNoWrap (modifyVerbosity (max verbose) v) == isVerboseNoWrap v 138-- 139-- __Note__: you can use @modifyVerbosity (const v1) v0@ to overwrite 140-- @v1@'s flags with @v0@'s flags. 141-- 142-- @since 2.0.1.0 143modifyVerbosity :: (Verbosity -> Verbosity) -> Verbosity -> Verbosity 144modifyVerbosity f v = v { vLevel = vLevel (f v) } 145 146intToVerbosity :: Int -> Maybe Verbosity 147intToVerbosity 0 = Just (mkVerbosity Silent) 148intToVerbosity 1 = Just (mkVerbosity Normal) 149intToVerbosity 2 = Just (mkVerbosity Verbose) 150intToVerbosity 3 = Just (mkVerbosity Deafening) 151intToVerbosity _ = Nothing 152 153-- | Parser verbosity 154-- 155-- >>> explicitEitherParsec parsecVerbosity "normal" 156-- Right (Verbosity {vLevel = Normal, vFlags = fromList [], vQuiet = False}) 157-- 158-- >>> explicitEitherParsec parsecVerbosity "normal+nowrap " 159-- Right (Verbosity {vLevel = Normal, vFlags = fromList [VNoWrap], vQuiet = False}) 160-- 161-- >>> explicitEitherParsec parsecVerbosity "normal+nowrap +markoutput" 162-- Right (Verbosity {vLevel = Normal, vFlags = fromList [VNoWrap,VMarkOutput], vQuiet = False}) 163-- 164-- >>> explicitEitherParsec parsecVerbosity "normal +nowrap +markoutput" 165-- Right (Verbosity {vLevel = Normal, vFlags = fromList [VNoWrap,VMarkOutput], vQuiet = False}) 166-- 167-- >>> explicitEitherParsec parsecVerbosity "normal+nowrap+markoutput" 168-- Right (Verbosity {vLevel = Normal, vFlags = fromList [VNoWrap,VMarkOutput], vQuiet = False}) 169-- 170-- >>> explicitEitherParsec parsecVerbosity "deafening+nowrap+stdout+stderr+callsite+callstack" 171-- Right (Verbosity {vLevel = Deafening, vFlags = fromList [VCallStack,VCallSite,VNoWrap,VStderr], vQuiet = False}) 172-- 173-- /Note:/ this parser will eat trailing spaces. 174-- 175instance Parsec Verbosity where 176 parsec = parsecVerbosity 177 178instance Pretty Verbosity where 179 pretty = PP.text . showForCabal 180 181parsecVerbosity :: CabalParsing m => m Verbosity 182parsecVerbosity = parseIntVerbosity <|> parseStringVerbosity 183 where 184 parseIntVerbosity = do 185 i <- P.integral 186 case intToVerbosity i of 187 Just v -> return v 188 Nothing -> P.unexpected $ "Bad integral verbosity: " ++ show i ++ ". Valid values are 0..3" 189 190 parseStringVerbosity = do 191 level <- parseVerbosityLevel 192 _ <- P.spaces 193 flags <- many (parseFlag <* P.spaces) 194 return $ foldl' (flip ($)) (mkVerbosity level) flags 195 196 parseVerbosityLevel = do 197 token <- P.munch1 isAsciiAlpha 198 case token of 199 "silent" -> return Silent 200 "normal" -> return Normal 201 "verbose" -> return Verbose 202 "debug" -> return Deafening 203 "deafening" -> return Deafening 204 _ -> P.unexpected $ "Bad verbosity level: " ++ token 205 parseFlag = do 206 _ <- P.char '+' 207 token <- P.munch1 isAsciiAlpha 208 case token of 209 "callsite" -> return verboseCallSite 210 "callstack" -> return verboseCallStack 211 "nowrap" -> return verboseNoWrap 212 "markoutput" -> return verboseMarkOutput 213 "timestamp" -> return verboseTimestamp 214 "stderr" -> return verboseStderr 215 "stdout" -> return verboseNoStderr 216 _ -> P.unexpected $ "Bad verbosity flag: " ++ token 217 218flagToVerbosity :: ReadE Verbosity 219flagToVerbosity = parsecToReadE id parsecVerbosity 220 221showForCabal :: Verbosity -> String 222showForCabal v 223 | Set.null (vFlags v) 224 = maybe (error "unknown verbosity") show $ 225 elemIndex v [silent,normal,verbose,deafening] 226 | otherwise 227 = unwords 228 $ showLevel (vLevel v) 229 : concatMap showFlag (Set.toList (vFlags v)) 230 where 231 showLevel Silent = "silent" 232 showLevel Normal = "normal" 233 showLevel Verbose = "verbose" 234 showLevel Deafening = "debug" 235 236 showFlag VCallSite = ["+callsite"] 237 showFlag VCallStack = ["+callstack"] 238 showFlag VNoWrap = ["+nowrap"] 239 showFlag VMarkOutput = ["+markoutput"] 240 showFlag VTimestamp = ["+timestamp"] 241 showFlag VStderr = ["+stderr"] 242 243showForGHC :: Verbosity -> String 244showForGHC v = maybe (error "unknown verbosity") show $ 245 elemIndex v [silent,normal,__,verbose,deafening] 246 where __ = silent -- this will be always ignored by elemIndex 247 248-- | Turn on verbose call-site printing when we log. 249verboseCallSite :: Verbosity -> Verbosity 250verboseCallSite = verboseFlag VCallSite 251 252-- | Turn on verbose call-stack printing when we log. 253verboseCallStack :: Verbosity -> Verbosity 254verboseCallStack = verboseFlag VCallStack 255 256-- | Turn on @-----BEGIN CABAL OUTPUT-----@ markers for output 257-- from Cabal (as opposed to GHC, or system dependent). 258verboseMarkOutput :: Verbosity -> Verbosity 259verboseMarkOutput = verboseFlag VMarkOutput 260 261-- | Turn off marking; useful for suppressing nondeterministic output. 262verboseUnmarkOutput :: Verbosity -> Verbosity 263verboseUnmarkOutput = verboseNoFlag VMarkOutput 264 265-- | Disable line-wrapping for log messages. 266verboseNoWrap :: Verbosity -> Verbosity 267verboseNoWrap = verboseFlag VNoWrap 268 269-- | Mark the verbosity as quiet 270verboseQuiet :: Verbosity -> Verbosity 271verboseQuiet v = v { vQuiet = True } 272 273-- | Turn on timestamps for log messages. 274verboseTimestamp :: Verbosity -> Verbosity 275verboseTimestamp = verboseFlag VTimestamp 276 277-- | Turn off timestamps for log messages. 278verboseNoTimestamp :: Verbosity -> Verbosity 279verboseNoTimestamp = verboseNoFlag VTimestamp 280 281-- | Turn on timestamps for log messages. 282-- 283-- @since 3.4.0.0 284verboseStderr :: Verbosity -> Verbosity 285verboseStderr = verboseFlag VStderr 286 287-- | Turn off timestamps for log messages. 288-- 289-- @since 3.4.0.0 290verboseNoStderr :: Verbosity -> Verbosity 291verboseNoStderr = verboseNoFlag VStderr 292 293-- | Helper function for flag enabling functions 294verboseFlag :: VerbosityFlag -> (Verbosity -> Verbosity) 295verboseFlag flag v = v { vFlags = Set.insert flag (vFlags v) } 296 297-- | Helper function for flag disabling functions 298verboseNoFlag :: VerbosityFlag -> (Verbosity -> Verbosity) 299verboseNoFlag flag v = v { vFlags = Set.delete flag (vFlags v) } 300 301-- | Turn off all flags 302verboseNoFlags :: Verbosity -> Verbosity 303verboseNoFlags v = v { vFlags = Set.empty } 304 305verboseHasFlags :: Verbosity -> Bool 306verboseHasFlags = not . Set.null . vFlags 307 308-- | Test if we should output call sites when we log. 309isVerboseCallSite :: Verbosity -> Bool 310isVerboseCallSite = isVerboseFlag VCallSite 311 312-- | Test if we should output call stacks when we log. 313isVerboseCallStack :: Verbosity -> Bool 314isVerboseCallStack = isVerboseFlag VCallStack 315 316-- | Test if we should output markets. 317isVerboseMarkOutput :: Verbosity -> Bool 318isVerboseMarkOutput = isVerboseFlag VMarkOutput 319 320-- | Test if line-wrapping is disabled for log messages. 321isVerboseNoWrap :: Verbosity -> Bool 322isVerboseNoWrap = isVerboseFlag VNoWrap 323 324-- | Test if we had called 'lessVerbose' on the verbosity 325isVerboseQuiet :: Verbosity -> Bool 326isVerboseQuiet = vQuiet 327 328-- | Test if we should output timestamps when we log. 329isVerboseTimestamp :: Verbosity -> Bool 330isVerboseTimestamp = isVerboseFlag VTimestamp 331 332-- | Test if we should output to stderr when we log. 333-- 334-- @since 3.4.0.0 335isVerboseStderr :: Verbosity -> Bool 336isVerboseStderr = isVerboseFlag VStderr 337 338-- | Helper function for flag testing functions. 339isVerboseFlag :: VerbosityFlag -> Verbosity -> Bool 340isVerboseFlag flag = (Set.member flag) . vFlags 341 342-- $setup 343-- >>> import Test.QuickCheck (Arbitrary (..), arbitraryBoundedEnum) 344-- >>> instance Arbitrary VerbosityLevel where arbitrary = arbitraryBoundedEnum 345-- >>> instance Arbitrary Verbosity where arbitrary = fmap mkVerbosity arbitrary 346