{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} ----------------------------------------------------------------------------- -- | -- Module : Distribution.Verbosity -- Copyright : Ian Lynagh 2007 -- License : BSD3 -- -- Maintainer : cabal-devel@haskell.org -- Portability : portable -- -- A 'Verbosity' type with associated utilities. -- -- There are 4 standard verbosity levels from 'silent', 'normal', -- 'verbose' up to 'deafening'. This is used for deciding what logging -- messages to print. -- -- Verbosity also is equipped with some internal settings which can be -- used to control at a fine granularity the verbosity of specific -- settings (e.g., so that you can trace only particular things you -- are interested in.) It's important to note that the instances -- for 'Verbosity' assume that this does not exist. -- Verbosity for Cabal functions. module Distribution.Verbosity ( -- * Verbosity Verbosity, silent, normal, verbose, deafening, moreVerbose, lessVerbose, isVerboseQuiet, intToVerbosity, flagToVerbosity, showForCabal, showForGHC, verboseNoFlags, verboseHasFlags, modifyVerbosity, -- * Call stacks verboseCallSite, verboseCallStack, isVerboseCallSite, isVerboseCallStack, -- * Output markets verboseMarkOutput, isVerboseMarkOutput, verboseUnmarkOutput, -- * line-wrapping verboseNoWrap, isVerboseNoWrap, -- * timestamps verboseTimestamp, isVerboseTimestamp, verboseNoTimestamp, -- * Stderr 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 -- We shouldn't print /anything/ unless an error occurs in silent mode silent :: Verbosity silent = mkVerbosity Silent -- Print stuff we want to see by default normal :: Verbosity normal = mkVerbosity Normal -- Be more verbose about what's going on verbose :: Verbosity verbose = mkVerbosity Verbose -- Not only are we verbose ourselves (perhaps even noisier than when -- being "verbose"), but we tell everything we run to be verbose too deafening :: Verbosity deafening = mkVerbosity Deafening moreVerbose :: Verbosity -> Verbosity moreVerbose v = case vLevel v of Silent -> v -- silent should stay silent Normal -> v { vLevel = Verbose } Verbose -> v { vLevel = Deafening } Deafening -> v lessVerbose :: Verbosity -> Verbosity lessVerbose v = verboseQuiet $ case vLevel v of Deafening -> v -- deafening stays deafening Verbose -> v { vLevel = Normal } Normal -> v { vLevel = Silent } Silent -> v -- | Combinator for transforming verbosity level while retaining the -- original hidden state. -- -- For instance, the following property holds -- -- prop> isVerboseNoWrap (modifyVerbosity (max verbose) v) == isVerboseNoWrap v -- -- __Note__: you can use @modifyVerbosity (const v1) v0@ to overwrite -- @v1@'s flags with @v0@'s flags. -- -- @since 2.0.1.0 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 -- | Parser verbosity -- -- >>> explicitEitherParsec parsecVerbosity "normal" -- Right (Verbosity {vLevel = Normal, vFlags = fromList [], vQuiet = False}) -- -- >>> explicitEitherParsec parsecVerbosity "normal+nowrap " -- Right (Verbosity {vLevel = Normal, vFlags = fromList [VNoWrap], vQuiet = False}) -- -- >>> explicitEitherParsec parsecVerbosity "normal+nowrap +markoutput" -- Right (Verbosity {vLevel = Normal, vFlags = fromList [VNoWrap,VMarkOutput], vQuiet = False}) -- -- >>> explicitEitherParsec parsecVerbosity "normal +nowrap +markoutput" -- Right (Verbosity {vLevel = Normal, vFlags = fromList [VNoWrap,VMarkOutput], vQuiet = False}) -- -- >>> explicitEitherParsec parsecVerbosity "normal+nowrap+markoutput" -- Right (Verbosity {vLevel = Normal, vFlags = fromList [VNoWrap,VMarkOutput], vQuiet = False}) -- -- >>> explicitEitherParsec parsecVerbosity "deafening+nowrap+stdout+stderr+callsite+callstack" -- Right (Verbosity {vLevel = Deafening, vFlags = fromList [VCallStack,VCallSite,VNoWrap,VStderr], vQuiet = False}) -- -- /Note:/ this parser will eat trailing spaces. -- 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 -- this will be always ignored by elemIndex -- | Turn on verbose call-site printing when we log. verboseCallSite :: Verbosity -> Verbosity verboseCallSite = verboseFlag VCallSite -- | Turn on verbose call-stack printing when we log. 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 -- | Turn off marking; useful for suppressing nondeterministic output. verboseUnmarkOutput :: Verbosity -> Verbosity verboseUnmarkOutput = verboseNoFlag VMarkOutput -- | Disable line-wrapping for log messages. verboseNoWrap :: Verbosity -> Verbosity verboseNoWrap = verboseFlag VNoWrap -- | Mark the verbosity as quiet verboseQuiet :: Verbosity -> Verbosity verboseQuiet v = v { vQuiet = True } -- | Turn on timestamps for log messages. verboseTimestamp :: Verbosity -> Verbosity verboseTimestamp = verboseFlag VTimestamp -- | Turn off timestamps for log messages. verboseNoTimestamp :: Verbosity -> Verbosity verboseNoTimestamp = verboseNoFlag VTimestamp -- | Turn on timestamps for log messages. -- -- @since 3.4.0.0 verboseStderr :: Verbosity -> Verbosity verboseStderr = verboseFlag VStderr -- | Turn off timestamps for log messages. -- -- @since 3.4.0.0 verboseNoStderr :: Verbosity -> Verbosity verboseNoStderr = verboseNoFlag VStderr -- | Helper function for flag enabling functions verboseFlag :: VerbosityFlag -> (Verbosity -> Verbosity) verboseFlag flag v = v { vFlags = Set.insert flag (vFlags v) } -- | Helper function for flag disabling functions verboseNoFlag :: VerbosityFlag -> (Verbosity -> Verbosity) verboseNoFlag flag v = v { vFlags = Set.delete flag (vFlags v) } -- | Turn off all flags verboseNoFlags :: Verbosity -> Verbosity verboseNoFlags v = v { vFlags = Set.empty } verboseHasFlags :: Verbosity -> Bool verboseHasFlags = not . Set.null . vFlags -- | Test if we should output call sites when we log. isVerboseCallSite :: Verbosity -> Bool isVerboseCallSite = isVerboseFlag VCallSite -- | Test if we should output call stacks when we log. 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 -- | Test if we had called 'lessVerbose' on the verbosity isVerboseQuiet :: Verbosity -> Bool isVerboseQuiet = vQuiet -- | Test if we should output timestamps when we log. isVerboseTimestamp :: Verbosity -> Bool isVerboseTimestamp = isVerboseFlag VTimestamp -- | Test if we should output to stderr when we log. -- -- @since 3.4.0.0 isVerboseStderr :: Verbosity -> Bool isVerboseStderr = isVerboseFlag VStderr -- | Helper function for flag testing functions. isVerboseFlag :: VerbosityFlag -> Verbosity -> Bool isVerboseFlag flag = (Set.member flag) . vFlags -- $setup -- >>> import Test.QuickCheck (Arbitrary (..), arbitraryBoundedEnum) -- >>> instance Arbitrary VerbosityLevel where arbitrary = arbitraryBoundedEnum -- >>> instance Arbitrary Verbosity where arbitrary = fmap mkVerbosity arbitrary