{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeApplications #-}

-----------------------------------------------------------------------------

-- Verbosity for Cabal functions.

-- |
-- 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.
module Distribution.Verbosity
  ( -- * Rich verbosity
    Verbosity (..)
  , VerbosityHandles (..)
  , defaultVerbosityHandles
  , VerbosityLevel (..)
  , verbosityLevel
  , verbosityChosenOutputHandle
  , verbosityErrorHandle
  , modifyVerbosityFlags
  , mkVerbosity
  , setVerbosityHandles

    -- * Verbosity flags
  , VerbosityFlags (vLevel)
  , mkVerbosityFlags
  , makeVerbose
  , silent
  , normal
  , verbose
  , deafening
  , moreVerbose
  , lessVerbose
  , isVerboseQuiet
  , intToVerbosity
  , flagToVerbosity
  , showForCabal
  , showForGHC
  , verboseNoFlags
  , verboseHasFlags

    -- * Call stacks
  , verboseCallSite
  , verboseCallStack
  , isVerboseCallSite
  , isVerboseCallStack

    -- * Output markers
  , verboseMarkOutput
  , isVerboseMarkOutput
  , verboseUnmarkOutput

    -- * Line wrapping
  , verboseNoWrap
  , isVerboseNoWrap

    -- * Time stamps
  , verboseTimestamp
  , isVerboseTimestamp
  , verboseNoTimestamp

    -- * Stderr
  , verboseStderr
  , isVerboseStderr
  , verboseNoStderr

    -- * No warnings
  , verboseNoWarn
  , isVerboseNoWarn
  ) where

import Distribution.Compat.Prelude
import Prelude ()

import Distribution.ReadE

import Data.List (elemIndex)
import Distribution.Parsec
import Distribution.Pretty
import Distribution.Utils.Generic (isAsciiAlpha)
import Distribution.Verbosity.Internal

import qualified Data.Set as Set
import qualified Distribution.Compat.CharParsing as P
import Distribution.Utils.Structured
import System.IO (Handle, stderr, stdout)
import qualified Text.PrettyPrint as PP
import qualified Type.Reflection as Typeable

-- | Rich verbosity, used for the Cabal library interface.
data Verbosity = Verbosity
  { Verbosity -> VerbosityFlags
verbosityFlags :: VerbosityFlags
  , Verbosity -> VerbosityHandles
verbosityHandles :: VerbosityHandles
  }
  deriving ((forall x. Verbosity -> Rep Verbosity x)
-> (forall x. Rep Verbosity x -> Verbosity) -> Generic Verbosity
forall x. Rep Verbosity x -> Verbosity
forall x. Verbosity -> Rep Verbosity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Verbosity -> Rep Verbosity x
from :: forall x. Verbosity -> Rep Verbosity x
$cto :: forall x. Rep Verbosity x -> Verbosity
to :: forall x. Rep Verbosity x -> Verbosity
Generic)

-- | Handles to use for logging (e.g. log to stdout, or log to a file).
data VerbosityHandles = VerbosityHandles
  { VerbosityHandles -> Handle
vStdoutHandle :: Handle
  , VerbosityHandles -> Handle
vStderrHandle :: Handle
  }

defaultVerbosityHandles :: VerbosityHandles
defaultVerbosityHandles :: VerbosityHandles
defaultVerbosityHandles =
  VerbosityHandles
    { vStdoutHandle :: Handle
vStdoutHandle = Handle
stdout
    , vStderrHandle :: Handle
vStderrHandle = Handle
stderr
    }

-- | Verbosity information which can be passed by the CLI.
data VerbosityFlags = VerbosityFlags
  { VerbosityFlags -> VerbosityLevel
vLevel :: VerbosityLevel
  , VerbosityFlags -> Set VerbosityFlag
vFlags :: Set VerbosityFlag
  , VerbosityFlags -> Bool
vQuiet :: Bool
  }
  deriving ((forall x. VerbosityFlags -> Rep VerbosityFlags x)
-> (forall x. Rep VerbosityFlags x -> VerbosityFlags)
-> Generic VerbosityFlags
forall x. Rep VerbosityFlags x -> VerbosityFlags
forall x. VerbosityFlags -> Rep VerbosityFlags x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. VerbosityFlags -> Rep VerbosityFlags x
from :: forall x. VerbosityFlags -> Rep VerbosityFlags x
$cto :: forall x. Rep VerbosityFlags x -> VerbosityFlags
to :: forall x. Rep VerbosityFlags x -> VerbosityFlags
Generic, Int -> VerbosityFlags -> ShowS
[VerbosityFlags] -> ShowS
VerbosityFlags -> String
(Int -> VerbosityFlags -> ShowS)
-> (VerbosityFlags -> String)
-> ([VerbosityFlags] -> ShowS)
-> Show VerbosityFlags
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VerbosityFlags -> ShowS
showsPrec :: Int -> VerbosityFlags -> ShowS
$cshow :: VerbosityFlags -> String
show :: VerbosityFlags -> String
$cshowList :: [VerbosityFlags] -> ShowS
showList :: [VerbosityFlags] -> ShowS
Show, ReadPrec [VerbosityFlags]
ReadPrec VerbosityFlags
Int -> ReadS VerbosityFlags
ReadS [VerbosityFlags]
(Int -> ReadS VerbosityFlags)
-> ReadS [VerbosityFlags]
-> ReadPrec VerbosityFlags
-> ReadPrec [VerbosityFlags]
-> Read VerbosityFlags
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS VerbosityFlags
readsPrec :: Int -> ReadS VerbosityFlags
$creadList :: ReadS [VerbosityFlags]
readList :: ReadS [VerbosityFlags]
$creadPrec :: ReadPrec VerbosityFlags
readPrec :: ReadPrec VerbosityFlags
$creadListPrec :: ReadPrec [VerbosityFlags]
readListPrec :: ReadPrec [VerbosityFlags]
Read, VerbosityFlags -> VerbosityFlags -> Bool
(VerbosityFlags -> VerbosityFlags -> Bool)
-> (VerbosityFlags -> VerbosityFlags -> Bool) -> Eq VerbosityFlags
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VerbosityFlags -> VerbosityFlags -> Bool
== :: VerbosityFlags -> VerbosityFlags -> Bool
$c/= :: VerbosityFlags -> VerbosityFlags -> Bool
/= :: VerbosityFlags -> VerbosityFlags -> Bool
Eq)

verbosityLevel :: Verbosity -> VerbosityLevel
verbosityLevel :: Verbosity -> VerbosityLevel
verbosityLevel = VerbosityFlags -> VerbosityLevel
vLevel (VerbosityFlags -> VerbosityLevel)
-> (Verbosity -> VerbosityFlags) -> Verbosity -> VerbosityLevel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Verbosity -> VerbosityFlags
verbosityFlags

-- | The handle used for normal output.
--
-- With the @+stderr@ verbosity flag, this is the error handle.
verbosityChosenOutputHandle :: Verbosity -> Handle
verbosityChosenOutputHandle :: Verbosity -> Handle
verbosityChosenOutputHandle Verbosity
verb =
  if VerbosityFlags -> Bool
isVerboseStderr (Verbosity -> VerbosityFlags
verbosityFlags Verbosity
verb)
    then VerbosityHandles -> Handle
vStderrHandle (VerbosityHandles -> Handle) -> VerbosityHandles -> Handle
forall a b. (a -> b) -> a -> b
$ Verbosity -> VerbosityHandles
verbosityHandles Verbosity
verb
    else VerbosityHandles -> Handle
vStdoutHandle (VerbosityHandles -> Handle) -> VerbosityHandles -> Handle
forall a b. (a -> b) -> a -> b
$ Verbosity -> VerbosityHandles
verbosityHandles Verbosity
verb

-- | The verbosity handle used for error output.
verbosityErrorHandle :: Verbosity -> Handle
verbosityErrorHandle :: Verbosity -> Handle
verbosityErrorHandle = VerbosityHandles -> Handle
vStderrHandle (VerbosityHandles -> Handle)
-> (Verbosity -> VerbosityHandles) -> Verbosity -> Handle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Verbosity -> VerbosityHandles
verbosityHandles

setVerbosityHandles :: Maybe Handle -> Verbosity -> Verbosity
setVerbosityHandles :: Maybe Handle -> Verbosity -> Verbosity
setVerbosityHandles Maybe Handle
Nothing Verbosity
v = Verbosity
v
setVerbosityHandles (Just Handle
h) Verbosity
v =
  Verbosity
v{verbosityHandles = VerbosityHandles{vStdoutHandle = h, vStderrHandle = h}}

mkVerbosity :: VerbosityHandles -> VerbosityFlags -> Verbosity
mkVerbosity :: VerbosityHandles -> VerbosityFlags -> Verbosity
mkVerbosity VerbosityHandles
handles VerbosityFlags
flags =
  Verbosity
    { verbosityFlags :: VerbosityFlags
verbosityFlags = VerbosityFlags
flags
    , verbosityHandles :: VerbosityHandles
verbosityHandles = VerbosityHandles
handles
    }

modifyVerbosityFlags :: (VerbosityFlags -> VerbosityFlags) -> Verbosity -> Verbosity
modifyVerbosityFlags :: (VerbosityFlags -> VerbosityFlags) -> Verbosity -> Verbosity
modifyVerbosityFlags VerbosityFlags -> VerbosityFlags
f v :: Verbosity
v@(Verbosity{verbosityFlags :: Verbosity -> VerbosityFlags
verbosityFlags = VerbosityFlags
flags}) =
  Verbosity
v{verbosityFlags = f flags}

mkVerbosityFlags :: VerbosityLevel -> VerbosityFlags
mkVerbosityFlags :: VerbosityLevel -> VerbosityFlags
mkVerbosityFlags VerbosityLevel
l = VerbosityFlags{vLevel :: VerbosityLevel
vLevel = VerbosityLevel
l, vFlags :: Set VerbosityFlag
vFlags = Set VerbosityFlag
forall a. Set a
Set.empty, vQuiet :: Bool
vQuiet = Bool
False}

instance Binary VerbosityFlags
instance NFData VerbosityFlags
instance Structured VerbosityFlags

-- Hand-written instances, because there are no NFData/Structured instances
-- for Handle.
instance NFData VerbosityHandles where
  rnf :: VerbosityHandles -> ()
rnf (VerbosityHandles Handle
o Handle
e) = Handle
o Handle -> () -> ()
forall a b. a -> b -> b
`seq` Handle
e Handle -> () -> ()
forall a b. a -> b -> b
`seq` ()
instance Structured VerbosityHandles where
  structure :: Proxy VerbosityHandles -> Structure
structure Proxy VerbosityHandles
_ =
    SomeTypeRep -> TypeVersion -> String -> SopStructure -> Structure
Structure
      SomeTypeRep
tr
      TypeVersion
0
      (SomeTypeRep -> String
forall a. Show a => a -> String
show SomeTypeRep
tr)
      [
        ( String
"VerbosityHandles"
        ,
          [ Proxy Handle -> Structure
forall {k} (a :: k). Typeable a => Proxy a -> Structure
nominalStructure (Proxy Handle -> Structure) -> Proxy Handle -> Structure
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Handle
          , Proxy Handle -> Structure
forall {k} (a :: k). Typeable a => Proxy a -> Structure
nominalStructure (Proxy Handle -> Structure) -> Proxy Handle -> Structure
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Handle
          ]
        )
      ]
    where
      tr :: SomeTypeRep
tr = TypeRep VerbosityHandles -> SomeTypeRep
forall k (a :: k). TypeRep a -> SomeTypeRep
Typeable.SomeTypeRep (TypeRep VerbosityHandles -> SomeTypeRep)
-> TypeRep VerbosityHandles -> SomeTypeRep
forall a b. (a -> b) -> a -> b
$ forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
Typeable.typeRep @VerbosityHandles

instance NFData Verbosity
instance Structured Verbosity

-- | In 'silent' mode, we should not print /anything/ unless an error occurs.
silent :: VerbosityFlags
silent :: VerbosityFlags
silent = VerbosityLevel -> VerbosityFlags
mkVerbosityFlags VerbosityLevel
Silent

-- | Print stuff we want to see by default.
normal :: VerbosityFlags
normal :: VerbosityFlags
normal = VerbosityLevel -> VerbosityFlags
mkVerbosityFlags VerbosityLevel
Normal

-- | Be more verbose about what's going on.
verbose :: VerbosityFlags
verbose :: VerbosityFlags
verbose = VerbosityLevel -> VerbosityFlags
mkVerbosityFlags VerbosityLevel
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 :: VerbosityFlags
deafening :: VerbosityFlags
deafening = VerbosityLevel -> VerbosityFlags
mkVerbosityFlags VerbosityLevel
Deafening

-- | Increase verbosity level, but stay 'silent' if we are.
moreVerbose :: VerbosityFlags -> VerbosityFlags
moreVerbose :: VerbosityFlags -> VerbosityFlags
moreVerbose VerbosityFlags
v =
  case VerbosityFlags -> VerbosityLevel
vLevel VerbosityFlags
v of
    VerbosityLevel
Silent -> VerbosityFlags
v -- silent should stay silent
    VerbosityLevel
Normal -> VerbosityFlags
v{vLevel = Verbose}
    VerbosityLevel
Verbose -> VerbosityFlags
v{vLevel = Deafening}
    VerbosityLevel
Deafening -> VerbosityFlags
v

-- | Make sure the verbosity level is at least 'verbose',
-- but stay 'silent' if we are.
makeVerbose :: VerbosityFlags -> VerbosityFlags
makeVerbose :: VerbosityFlags -> VerbosityFlags
makeVerbose VerbosityFlags
v =
  case VerbosityFlags -> VerbosityLevel
vLevel VerbosityFlags
v of
    VerbosityLevel
Silent -> VerbosityFlags
v -- silent should stay silent
    VerbosityLevel
Normal -> VerbosityFlags
v{vLevel = Verbose}
    VerbosityLevel
Verbose -> VerbosityFlags
v
    VerbosityLevel
Deafening -> VerbosityFlags
v

-- | Decrease verbosity level, but stay 'deafening' if we are.
lessVerbose :: VerbosityFlags -> VerbosityFlags
lessVerbose :: VerbosityFlags -> VerbosityFlags
lessVerbose VerbosityFlags
v =
  VerbosityFlags -> VerbosityFlags
verboseQuiet (VerbosityFlags -> VerbosityFlags)
-> VerbosityFlags -> VerbosityFlags
forall a b. (a -> b) -> a -> b
$
    case VerbosityFlags -> VerbosityLevel
vLevel VerbosityFlags
v of
      VerbosityLevel
Deafening -> VerbosityFlags
v -- deafening stays deafening
      VerbosityLevel
Verbose -> VerbosityFlags
v{vLevel = Normal}
      VerbosityLevel
Normal -> VerbosityFlags
v{vLevel = Silent}
      VerbosityLevel
Silent -> VerbosityFlags
v

-- | Numeric verbosity level @0..3@: @0@ is 'silent', @3@ is 'deafening'.
intToVerbosity :: Int -> Maybe VerbosityFlags
intToVerbosity :: Int -> Maybe VerbosityFlags
intToVerbosity Int
0 = VerbosityFlags -> Maybe VerbosityFlags
forall a. a -> Maybe a
Just (VerbosityLevel -> VerbosityFlags
mkVerbosityFlags VerbosityLevel
Silent)
intToVerbosity Int
1 = VerbosityFlags -> Maybe VerbosityFlags
forall a. a -> Maybe a
Just (VerbosityLevel -> VerbosityFlags
mkVerbosityFlags VerbosityLevel
Normal)
intToVerbosity Int
2 = VerbosityFlags -> Maybe VerbosityFlags
forall a. a -> Maybe a
Just (VerbosityLevel -> VerbosityFlags
mkVerbosityFlags VerbosityLevel
Verbose)
intToVerbosity Int
3 = VerbosityFlags -> Maybe VerbosityFlags
forall a. a -> Maybe a
Just (VerbosityLevel -> VerbosityFlags
mkVerbosityFlags VerbosityLevel
Deafening)
intToVerbosity Int
_ = Maybe VerbosityFlags
forall a. Maybe a
Nothing

-- | Parser verbosity
--
-- >>> explicitEitherParsec parsecVerbosity "normal"
-- Right (VerbosityFlags {vLevel = Normal, vFlags = fromList [], vQuiet = False})
--
-- >>> explicitEitherParsec parsecVerbosity "normal+nowrap  "
-- Right (VerbosityFlags {vLevel = Normal, vFlags = fromList [VNoWrap], vQuiet = False})
--
-- >>> explicitEitherParsec parsecVerbosity "normal+nowrap +markoutput"
-- Right (VerbosityFlags {vLevel = Normal, vFlags = fromList [VNoWrap,VMarkOutput], vQuiet = False})
--
-- >>> explicitEitherParsec parsecVerbosity "normal +nowrap +markoutput"
-- Right (VerbosityFlags {vLevel = Normal, vFlags = fromList [VNoWrap,VMarkOutput], vQuiet = False})
--
-- >>> explicitEitherParsec parsecVerbosity "normal+nowrap+markoutput"
-- Right (VerbosityFlags {vLevel = Normal, vFlags = fromList [VNoWrap,VMarkOutput], vQuiet = False})
--
-- >>> explicitEitherParsec parsecVerbosity "deafening+nowrap+stdout+stderr+callsite+callstack"
-- Right (VerbosityFlags {vLevel = Deafening, vFlags = fromList [VCallStack,VCallSite,VNoWrap,VStderr], vQuiet = False})
--
-- /Note:/ this parser will eat trailing spaces.
instance Parsec VerbosityFlags where
  parsec :: forall (m :: * -> *). CabalParsing m => m VerbosityFlags
parsec = m VerbosityFlags
forall (m :: * -> *). CabalParsing m => m VerbosityFlags
parsecVerbosity

instance Pretty VerbosityFlags where
  pretty :: VerbosityFlags -> Doc
pretty = String -> Doc
PP.text (String -> Doc)
-> (VerbosityFlags -> String) -> VerbosityFlags -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerbosityFlags -> String
showForCabal

parsecVerbosity :: CabalParsing m => m VerbosityFlags
parsecVerbosity :: forall (m :: * -> *). CabalParsing m => m VerbosityFlags
parsecVerbosity = m VerbosityFlags
parseIntVerbosity m VerbosityFlags -> m VerbosityFlags -> m VerbosityFlags
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m VerbosityFlags
parseStringVerbosity
  where
    parseIntVerbosity :: m VerbosityFlags
parseIntVerbosity = do
      i <- m Int
forall (m :: * -> *) a. (CharParsing m, Integral a) => m a
P.integral
      case intToVerbosity i of
        Just VerbosityFlags
v -> VerbosityFlags -> m VerbosityFlags
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return VerbosityFlags
v
        Maybe VerbosityFlags
Nothing -> String -> m VerbosityFlags
forall a. String -> m a
forall (m :: * -> *) a. Parsing m => String -> m a
P.unexpected (String -> m VerbosityFlags) -> String -> m VerbosityFlags
forall a b. (a -> b) -> a -> b
$ String
"Bad integral verbosity: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
". Valid values are 0..3"

    parseStringVerbosity :: m VerbosityFlags
parseStringVerbosity = do
      level <- m VerbosityLevel
parseVerbosityLevel
      _ <- P.spaces
      flags <- many (parseFlag <* P.spaces)
      return $ foldl' (flip ($)) (mkVerbosityFlags level) flags

    parseVerbosityLevel :: m VerbosityLevel
parseVerbosityLevel = do
      token <- (Char -> Bool) -> m String
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m String
P.munch1 Char -> Bool
isAsciiAlpha
      case token of
        String
"silent" -> VerbosityLevel -> m VerbosityLevel
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return VerbosityLevel
Silent
        String
"normal" -> VerbosityLevel -> m VerbosityLevel
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return VerbosityLevel
Normal
        String
"verbose" -> VerbosityLevel -> m VerbosityLevel
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return VerbosityLevel
Verbose
        String
"debug" -> VerbosityLevel -> m VerbosityLevel
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return VerbosityLevel
Deafening
        String
"deafening" -> VerbosityLevel -> m VerbosityLevel
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return VerbosityLevel
Deafening
        String
_ -> String -> m VerbosityLevel
forall a. String -> m a
forall (m :: * -> *) a. Parsing m => String -> m a
P.unexpected (String -> m VerbosityLevel) -> String -> m VerbosityLevel
forall a b. (a -> b) -> a -> b
$ String
"Bad verbosity level: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
token
    parseFlag :: m (VerbosityFlags -> VerbosityFlags)
parseFlag = do
      _ <- Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'+'
      token <- P.munch1 isAsciiAlpha
      case token of
        String
"callsite" -> (VerbosityFlags -> VerbosityFlags)
-> m (VerbosityFlags -> VerbosityFlags)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return VerbosityFlags -> VerbosityFlags
verboseCallSite
        String
"callstack" -> (VerbosityFlags -> VerbosityFlags)
-> m (VerbosityFlags -> VerbosityFlags)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return VerbosityFlags -> VerbosityFlags
verboseCallStack
        String
"nowrap" -> (VerbosityFlags -> VerbosityFlags)
-> m (VerbosityFlags -> VerbosityFlags)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return VerbosityFlags -> VerbosityFlags
verboseNoWrap
        String
"markoutput" -> (VerbosityFlags -> VerbosityFlags)
-> m (VerbosityFlags -> VerbosityFlags)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return VerbosityFlags -> VerbosityFlags
verboseMarkOutput
        String
"timestamp" -> (VerbosityFlags -> VerbosityFlags)
-> m (VerbosityFlags -> VerbosityFlags)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return VerbosityFlags -> VerbosityFlags
verboseTimestamp
        String
"stderr" -> (VerbosityFlags -> VerbosityFlags)
-> m (VerbosityFlags -> VerbosityFlags)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return VerbosityFlags -> VerbosityFlags
verboseStderr
        String
"stdout" -> (VerbosityFlags -> VerbosityFlags)
-> m (VerbosityFlags -> VerbosityFlags)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return VerbosityFlags -> VerbosityFlags
verboseNoStderr
        String
"nowarn" -> (VerbosityFlags -> VerbosityFlags)
-> m (VerbosityFlags -> VerbosityFlags)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return VerbosityFlags -> VerbosityFlags
verboseNoWarn
        String
_ -> String -> m (VerbosityFlags -> VerbosityFlags)
forall a. String -> m a
forall (m :: * -> *) a. Parsing m => String -> m a
P.unexpected (String -> m (VerbosityFlags -> VerbosityFlags))
-> String -> m (VerbosityFlags -> VerbosityFlags)
forall a b. (a -> b) -> a -> b
$ String
"Bad verbosity flag: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
token

flagToVerbosity :: ReadE VerbosityFlags
flagToVerbosity :: ReadE VerbosityFlags
flagToVerbosity = ShowS -> ParsecParser VerbosityFlags -> ReadE VerbosityFlags
forall a. ShowS -> ParsecParser a -> ReadE a
parsecToReadE ShowS
forall a. a -> a
id ParsecParser VerbosityFlags
forall (m :: * -> *). CabalParsing m => m VerbosityFlags
parsecVerbosity

showForCabal :: VerbosityFlags -> String
showForCabal :: VerbosityFlags -> String
showForCabal (VerbosityFlags{vLevel :: VerbosityFlags -> VerbosityLevel
vLevel = VerbosityLevel
lvl, vFlags :: VerbosityFlags -> Set VerbosityFlag
vFlags = Set VerbosityFlag
flags})
  | Set VerbosityFlag -> Bool
forall a. Set a -> Bool
Set.null Set VerbosityFlag
flags =
      String -> (Int -> String) -> Maybe Int -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ShowS
forall a. HasCallStack => String -> a
error String
"unknown verbosity") Int -> String
forall a. Show a => a -> String
show (Maybe Int -> String) -> Maybe Int -> String
forall a b. (a -> b) -> a -> b
$
        VerbosityLevel -> [VerbosityLevel] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex VerbosityLevel
lvl [VerbosityLevel
Silent, VerbosityLevel
Normal, VerbosityLevel
Verbose, VerbosityLevel
Deafening]
  | Bool
otherwise =
      [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
        VerbosityLevel -> String
showLevel VerbosityLevel
lvl
          String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (VerbosityFlag -> [String]) -> [VerbosityFlag] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap VerbosityFlag -> [String]
showFlag (Set VerbosityFlag -> [VerbosityFlag]
forall a. Set a -> [a]
Set.toList Set VerbosityFlag
flags)
  where
    showLevel :: VerbosityLevel -> String
showLevel VerbosityLevel
Silent = String
"silent"
    showLevel VerbosityLevel
Normal = String
"normal"
    showLevel VerbosityLevel
Verbose = String
"verbose"
    showLevel VerbosityLevel
Deafening = String
"debug"

    showFlag :: VerbosityFlag -> [String]
showFlag VerbosityFlag
VCallSite = [String
"+callsite"]
    showFlag VerbosityFlag
VCallStack = [String
"+callstack"]
    showFlag VerbosityFlag
VNoWrap = [String
"+nowrap"]
    showFlag VerbosityFlag
VMarkOutput = [String
"+markoutput"]
    showFlag VerbosityFlag
VTimestamp = [String
"+timestamp"]
    showFlag VerbosityFlag
VStderr = [String
"+stderr"]
    showFlag VerbosityFlag
VNoWarn = [String
"+nowarn"]

showForGHC :: VerbosityFlags -> String
showForGHC :: VerbosityFlags -> String
showForGHC VerbosityFlags
v =
  String -> (Int -> String) -> Maybe Int -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ShowS
forall a. HasCallStack => String -> a
error String
"unknown verbosity") Int -> String
forall a. Show a => a -> String
show (Maybe Int -> String) -> Maybe Int -> String
forall a b. (a -> b) -> a -> b
$
    VerbosityLevel -> [VerbosityLevel] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex (VerbosityFlags -> VerbosityLevel
vLevel VerbosityFlags
v) [VerbosityLevel
Silent, VerbosityLevel
Normal, VerbosityLevel
__, VerbosityLevel
Verbose, VerbosityLevel
Deafening]
  where
    __ :: VerbosityLevel
__ = VerbosityLevel
Silent -- this will be always ignored by elemIndex

-- | Turn on verbose call-site printing when we log.
verboseCallSite :: VerbosityFlags -> VerbosityFlags
verboseCallSite :: VerbosityFlags -> VerbosityFlags
verboseCallSite = VerbosityFlag -> VerbosityFlags -> VerbosityFlags
verboseFlag VerbosityFlag
VCallSite

-- | Turn on verbose call-stack printing when we log.
verboseCallStack :: VerbosityFlags -> VerbosityFlags
verboseCallStack :: VerbosityFlags -> VerbosityFlags
verboseCallStack = VerbosityFlag -> VerbosityFlags -> VerbosityFlags
verboseFlag VerbosityFlag
VCallStack

-- | Turn on @-----BEGIN CABAL OUTPUT-----@ markers for output
-- from Cabal (as opposed to GHC, or system dependent).
verboseMarkOutput :: VerbosityFlags -> VerbosityFlags
verboseMarkOutput :: VerbosityFlags -> VerbosityFlags
verboseMarkOutput = VerbosityFlag -> VerbosityFlags -> VerbosityFlags
verboseFlag VerbosityFlag
VMarkOutput

-- | Turn off marking; useful for suppressing nondeterministic output.
verboseUnmarkOutput :: VerbosityFlags -> VerbosityFlags
verboseUnmarkOutput :: VerbosityFlags -> VerbosityFlags
verboseUnmarkOutput = VerbosityFlag -> VerbosityFlags -> VerbosityFlags
verboseNoFlag VerbosityFlag
VMarkOutput

-- | Disable line-wrapping for log messages.
verboseNoWrap :: VerbosityFlags -> VerbosityFlags
verboseNoWrap :: VerbosityFlags -> VerbosityFlags
verboseNoWrap = VerbosityFlag -> VerbosityFlags -> VerbosityFlags
verboseFlag VerbosityFlag
VNoWrap

-- | Mark the verbosity as quiet.
verboseQuiet :: VerbosityFlags -> VerbosityFlags
verboseQuiet :: VerbosityFlags -> VerbosityFlags
verboseQuiet VerbosityFlags
v = VerbosityFlags
v{vQuiet = True}

-- | Turn on timestamps for log messages.
verboseTimestamp :: VerbosityFlags -> VerbosityFlags
verboseTimestamp :: VerbosityFlags -> VerbosityFlags
verboseTimestamp = VerbosityFlag -> VerbosityFlags -> VerbosityFlags
verboseFlag VerbosityFlag
VTimestamp

-- | Turn off timestamps for log messages.
verboseNoTimestamp :: VerbosityFlags -> VerbosityFlags
verboseNoTimestamp :: VerbosityFlags -> VerbosityFlags
verboseNoTimestamp = VerbosityFlag -> VerbosityFlags -> VerbosityFlags
verboseNoFlag VerbosityFlag
VTimestamp

-- | Switch logging to 'stderr'.
--
-- @since 3.4.0.0
verboseStderr :: VerbosityFlags -> VerbosityFlags
verboseStderr :: VerbosityFlags -> VerbosityFlags
verboseStderr = VerbosityFlag -> VerbosityFlags -> VerbosityFlags
verboseFlag VerbosityFlag
VStderr

-- | Switch logging to 'stdout'.
--
-- @since 3.4.0.0
verboseNoStderr :: VerbosityFlags -> VerbosityFlags
verboseNoStderr :: VerbosityFlags -> VerbosityFlags
verboseNoStderr = VerbosityFlag -> VerbosityFlags -> VerbosityFlags
verboseNoFlag VerbosityFlag
VStderr

-- | Turn off warnings for log messages.
verboseNoWarn :: VerbosityFlags -> VerbosityFlags
verboseNoWarn :: VerbosityFlags -> VerbosityFlags
verboseNoWarn = VerbosityFlag -> VerbosityFlags -> VerbosityFlags
verboseFlag VerbosityFlag
VNoWarn

-- | Helper function for flag enabling functions.
verboseFlag :: VerbosityFlag -> (VerbosityFlags -> VerbosityFlags)
verboseFlag :: VerbosityFlag -> VerbosityFlags -> VerbosityFlags
verboseFlag VerbosityFlag
flag v :: VerbosityFlags
v@(VerbosityFlags{vFlags :: VerbosityFlags -> Set VerbosityFlag
vFlags = Set VerbosityFlag
flags}) = VerbosityFlags
v{vFlags = Set.insert flag flags}

-- | Helper function for flag disabling functions.
verboseNoFlag :: VerbosityFlag -> (VerbosityFlags -> VerbosityFlags)
verboseNoFlag :: VerbosityFlag -> VerbosityFlags -> VerbosityFlags
verboseNoFlag VerbosityFlag
flag v :: VerbosityFlags
v@(VerbosityFlags{vFlags :: VerbosityFlags -> Set VerbosityFlag
vFlags = Set VerbosityFlag
flags}) = VerbosityFlags
v{vFlags = Set.delete flag flags}

-- | Turn off all flags.
verboseNoFlags :: VerbosityFlags -> VerbosityFlags
verboseNoFlags :: VerbosityFlags -> VerbosityFlags
verboseNoFlags VerbosityFlags
v = VerbosityFlags
v{vFlags = Set.empty}

verboseHasFlags :: VerbosityFlags -> Bool
verboseHasFlags :: VerbosityFlags -> Bool
verboseHasFlags (VerbosityFlags{vFlags :: VerbosityFlags -> Set VerbosityFlag
vFlags = Set VerbosityFlag
flags}) = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Set VerbosityFlag -> Bool
forall a. Set a -> Bool
Set.null Set VerbosityFlag
flags

-- | Test if we should output call sites when we log.
isVerboseCallSite :: VerbosityFlags -> Bool
isVerboseCallSite :: VerbosityFlags -> Bool
isVerboseCallSite = VerbosityFlag -> VerbosityFlags -> Bool
isVerboseFlag VerbosityFlag
VCallSite

-- | Test if we should output call stacks when we log.
isVerboseCallStack :: VerbosityFlags -> Bool
isVerboseCallStack :: VerbosityFlags -> Bool
isVerboseCallStack = VerbosityFlag -> VerbosityFlags -> Bool
isVerboseFlag VerbosityFlag
VCallStack

-- | Test if we should output markers.
isVerboseMarkOutput :: VerbosityFlags -> Bool
isVerboseMarkOutput :: VerbosityFlags -> Bool
isVerboseMarkOutput = VerbosityFlag -> VerbosityFlags -> Bool
isVerboseFlag VerbosityFlag
VMarkOutput

-- | Test if line-wrapping is disabled for log messages.
isVerboseNoWrap :: VerbosityFlags -> Bool
isVerboseNoWrap :: VerbosityFlags -> Bool
isVerboseNoWrap = VerbosityFlag -> VerbosityFlags -> Bool
isVerboseFlag VerbosityFlag
VNoWrap

-- | Test if we had called 'lessVerbose' on the verbosity.
isVerboseQuiet :: VerbosityFlags -> Bool
isVerboseQuiet :: VerbosityFlags -> Bool
isVerboseQuiet = VerbosityFlags -> Bool
vQuiet

-- | Test if we should output timestamps when we log.
isVerboseTimestamp :: VerbosityFlags -> Bool
isVerboseTimestamp :: VerbosityFlags -> Bool
isVerboseTimestamp = VerbosityFlag -> VerbosityFlags -> Bool
isVerboseFlag VerbosityFlag
VTimestamp

-- | Test if we should output to 'stderr' when we log.
--
-- @since 3.4.0.0
isVerboseStderr :: VerbosityFlags -> Bool
isVerboseStderr :: VerbosityFlags -> Bool
isVerboseStderr = VerbosityFlag -> VerbosityFlags -> Bool
isVerboseFlag VerbosityFlag
VStderr

-- | Test if we should output warnings when we log.
isVerboseNoWarn :: VerbosityFlags -> Bool
isVerboseNoWarn :: VerbosityFlags -> Bool
isVerboseNoWarn = VerbosityFlag -> VerbosityFlags -> Bool
isVerboseFlag VerbosityFlag
VNoWarn

-- | Helper function for flag testing functions.
isVerboseFlag :: VerbosityFlag -> VerbosityFlags -> Bool
isVerboseFlag :: VerbosityFlag -> VerbosityFlags -> Bool
isVerboseFlag VerbosityFlag
flag VerbosityFlags
v = VerbosityFlag
flag VerbosityFlag -> Set VerbosityFlag -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` VerbosityFlags -> Set VerbosityFlag
vFlags VerbosityFlags
v

-- $setup
-- >>> import Test.QuickCheck (Arbitrary (..), arbitraryBoundedEnum)
-- >>> instance Arbitrary VerbosityLevel where arbitrary = arbitraryBoundedEnum
-- >>> instance Arbitrary VerbosityFlags where arbitrary = fmap mkVerbosityFlags arbitrary