Cabal/src/Distribution/Verbosity.hs

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