{-# 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,
  ) where

import Prelude ()
import Distribution.Compat.Prelude

import Distribution.ReadE

import Data.List (elemIndex)
import Distribution.Parsec
import Distribution.Verbosity.Internal

import qualified Data.Set as Set
import qualified Distribution.Compat.CharParsing as P

data Verbosity = Verbosity {
    Verbosity -> VerbosityLevel
vLevel :: VerbosityLevel,
    Verbosity -> Set VerbosityFlag
vFlags :: Set VerbosityFlag,
    Verbosity -> Bool
vQuiet :: Bool
  } 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
$cto :: forall x. Rep Verbosity x -> Verbosity
$cfrom :: forall x. Verbosity -> Rep Verbosity x
Generic, Int -> Verbosity -> ShowS
[Verbosity] -> ShowS
Verbosity -> String
(Int -> Verbosity -> ShowS)
-> (Verbosity -> String)
-> ([Verbosity] -> ShowS)
-> Show Verbosity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Verbosity] -> ShowS
$cshowList :: [Verbosity] -> ShowS
show :: Verbosity -> String
$cshow :: Verbosity -> String
showsPrec :: Int -> Verbosity -> ShowS
$cshowsPrec :: Int -> Verbosity -> ShowS
External instance of the constraint type Show VerbosityFlag
External instance of the constraint type Show Bool
External instance of the constraint type Show VerbosityFlag
External instance of the constraint type forall a. Show a => Show (Set a)
External instance of the constraint type Show VerbosityLevel
External instance of the constraint type Ord Int
Show, ReadPrec [Verbosity]
ReadPrec Verbosity
Int -> ReadS Verbosity
ReadS [Verbosity]
(Int -> ReadS Verbosity)
-> ReadS [Verbosity]
-> ReadPrec Verbosity
-> ReadPrec [Verbosity]
-> Read Verbosity
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Verbosity]
$creadListPrec :: ReadPrec [Verbosity]
readPrec :: ReadPrec Verbosity
$creadPrec :: ReadPrec Verbosity
readList :: ReadS [Verbosity]
$creadList :: ReadS [Verbosity]
readsPrec :: Int -> ReadS Verbosity
$creadsPrec :: Int -> ReadS Verbosity
External instance of the constraint type Read VerbosityFlag
External instance of the constraint type Read Bool
External instance of the constraint type Read VerbosityFlag
External instance of the constraint type forall a. (Read a, Ord a) => Read (Set a)
External instance of the constraint type Read VerbosityLevel
External instance of the constraint type Monad ReadPrec
External instance of the constraint type Monad ReadPrec
External instance of the constraint type Ord VerbosityFlag
Instance of class: Read of the constraint type Read Verbosity
Read, Typeable)

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

instance Eq Verbosity where
    Verbosity
x == :: Verbosity -> Verbosity -> Bool
== Verbosity
y = Verbosity -> VerbosityLevel
vLevel Verbosity
x VerbosityLevel -> VerbosityLevel -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq VerbosityLevel
== Verbosity -> VerbosityLevel
vLevel Verbosity
y

instance Ord Verbosity where
    compare :: Verbosity -> Verbosity -> Ordering
compare Verbosity
x Verbosity
y = VerbosityLevel -> VerbosityLevel -> Ordering
forall a. Ord a => a -> a -> Ordering
External instance of the constraint type Ord VerbosityLevel
compare (Verbosity -> VerbosityLevel
vLevel Verbosity
x) (Verbosity -> VerbosityLevel
vLevel Verbosity
y)

instance Enum Verbosity where
    toEnum :: Int -> Verbosity
toEnum = VerbosityLevel -> Verbosity
mkVerbosity (VerbosityLevel -> Verbosity)
-> (Int -> VerbosityLevel) -> Int -> Verbosity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> VerbosityLevel
forall a. Enum a => Int -> a
External instance of the constraint type Enum VerbosityLevel
toEnum
    fromEnum :: Verbosity -> Int
fromEnum = VerbosityLevel -> Int
forall a. Enum a => a -> Int
External instance of the constraint type Enum VerbosityLevel
fromEnum (VerbosityLevel -> Int)
-> (Verbosity -> VerbosityLevel) -> Verbosity -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Verbosity -> VerbosityLevel
vLevel

instance Bounded Verbosity where
    minBound :: Verbosity
minBound = VerbosityLevel -> Verbosity
mkVerbosity VerbosityLevel
forall a. Bounded a => a
External instance of the constraint type Bounded VerbosityLevel
minBound
    maxBound :: Verbosity
maxBound = VerbosityLevel -> Verbosity
mkVerbosity VerbosityLevel
forall a. Bounded a => a
External instance of the constraint type Bounded VerbosityLevel
maxBound

instance Binary Verbosity
instance Structured Verbosity

-- We shouldn't print /anything/ unless an error occurs in silent mode
silent :: Verbosity
silent :: Verbosity
silent = VerbosityLevel -> Verbosity
mkVerbosity VerbosityLevel
Silent

-- Print stuff we want to see by default
normal :: Verbosity
normal :: Verbosity
normal = VerbosityLevel -> Verbosity
mkVerbosity VerbosityLevel
Normal

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

moreVerbose :: Verbosity -> Verbosity
moreVerbose :: Verbosity -> Verbosity
moreVerbose Verbosity
v =
    case Verbosity -> VerbosityLevel
vLevel Verbosity
v of
        VerbosityLevel
Silent    -> Verbosity
v -- silent should stay silent
        VerbosityLevel
Normal    -> Verbosity
v { vLevel :: VerbosityLevel
vLevel = VerbosityLevel
Verbose }
        VerbosityLevel
Verbose   -> Verbosity
v { vLevel :: VerbosityLevel
vLevel = VerbosityLevel
Deafening }
        VerbosityLevel
Deafening -> Verbosity
v

lessVerbose :: Verbosity -> Verbosity
lessVerbose :: Verbosity -> Verbosity
lessVerbose Verbosity
v =
    Verbosity -> Verbosity
verboseQuiet (Verbosity -> Verbosity) -> Verbosity -> Verbosity
forall a b. (a -> b) -> a -> b
$
    case Verbosity -> VerbosityLevel
vLevel Verbosity
v of
        VerbosityLevel
Deafening -> Verbosity
v -- deafening stays deafening
        VerbosityLevel
Verbose   -> Verbosity
v { vLevel :: VerbosityLevel
vLevel = VerbosityLevel
Normal }
        VerbosityLevel
Normal    -> Verbosity
v { vLevel :: VerbosityLevel
vLevel = VerbosityLevel
Silent }
        VerbosityLevel
Silent    -> Verbosity
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 :: (Verbosity -> Verbosity) -> Verbosity -> Verbosity
modifyVerbosity Verbosity -> Verbosity
f Verbosity
v = Verbosity
v { vLevel :: VerbosityLevel
vLevel = Verbosity -> VerbosityLevel
vLevel (Verbosity -> Verbosity
f Verbosity
v) }

intToVerbosity :: Int -> Maybe Verbosity
intToVerbosity :: Int -> Maybe Verbosity
intToVerbosity Int
0 = Verbosity -> Maybe Verbosity
forall a. a -> Maybe a
Just (VerbosityLevel -> Verbosity
mkVerbosity VerbosityLevel
Silent)
intToVerbosity Int
1 = Verbosity -> Maybe Verbosity
forall a. a -> Maybe a
Just (VerbosityLevel -> Verbosity
mkVerbosity VerbosityLevel
Normal)
intToVerbosity Int
2 = Verbosity -> Maybe Verbosity
forall a. a -> Maybe a
Just (VerbosityLevel -> Verbosity
mkVerbosity VerbosityLevel
Verbose)
intToVerbosity Int
3 = Verbosity -> Maybe Verbosity
forall a. a -> Maybe a
Just (VerbosityLevel -> Verbosity
mkVerbosity VerbosityLevel
Deafening)
intToVerbosity Int
_ = Maybe Verbosity
forall a. Maybe a
Nothing

-- | Parser verbosity
--
-- >>> explicitEitherParsec parsecVerbosity "normal"
-- Right (Right (Verbosity {vLevel = Normal, vFlags = fromList [], vQuiet = False}))
--
-- >>> explicitEitherParsec parsecVerbosity "normal+nowrap  "
-- Right (Right (Verbosity {vLevel = Normal, vFlags = fromList [VNoWrap], vQuiet = False}))
--
-- >>> explicitEitherParsec parsecVerbosity "normal+nowrap +markoutput"
-- Right (Right (Verbosity {vLevel = Normal, vFlags = fromList [VNoWrap,VMarkOutput], vQuiet = False}))
--
-- >>> explicitEitherParsec parsecVerbosity "normal +nowrap +markoutput"
-- Right (Right (Verbosity {vLevel = Normal, vFlags = fromList [VNoWrap,VMarkOutput], vQuiet = False}))
--
-- >>> explicitEitherParsec parsecVerbosity "normal+nowrap+markoutput"
-- Right (Right (Verbosity {vLevel = Normal, vFlags = fromList [VNoWrap,VMarkOutput], vQuiet = False}))
--
-- /Note:/ this parser will eat trailing spaces.
--
parsecVerbosity :: CabalParsing m => m (Either Int Verbosity)
parsecVerbosity :: m (Either Int Verbosity)
parsecVerbosity = m (Either Int Verbosity)
forall {b}. m (Either Int b)
parseIntVerbosity m (Either Int Verbosity)
-> m (Either Int Verbosity) -> m (Either Int Verbosity)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
External instance of the constraint type forall (m :: * -> *). Parsing m => Alternative m
External instance of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
<|> m (Either Int Verbosity)
forall {a}. m (Either a Verbosity)
parseStringVerbosity
  where
    parseIntVerbosity :: m (Either Int b)
parseIntVerbosity = (Int -> Either Int b) -> m Int -> m (Either Int b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type forall (f :: * -> *). Applicative f => Functor f
External instance of the constraint type forall (f :: * -> *). Alternative f => Applicative f
External instance of the constraint type forall (m :: * -> *). Parsing m => Alternative m
External instance of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
fmap Int -> Either Int b
forall a b. a -> Either a b
Left m Int
forall (m :: * -> *) a. (CharParsing m, Integral a) => m a
External instance of the constraint type Integral Int
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
P.integral
    parseStringVerbosity :: m (Either a Verbosity)
parseStringVerbosity = (Verbosity -> Either a Verbosity)
-> m Verbosity -> m (Either a Verbosity)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type forall (f :: * -> *). Applicative f => Functor f
External instance of the constraint type forall (f :: * -> *). Alternative f => Applicative f
External instance of the constraint type forall (m :: * -> *). Parsing m => Alternative m
External instance of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
fmap Verbosity -> Either a Verbosity
forall a b. b -> Either a b
Right (m Verbosity -> m (Either a Verbosity))
-> m Verbosity -> m (Either a Verbosity)
forall a b. (a -> b) -> a -> b
$ do
        VerbosityLevel
level <- m VerbosityLevel
parseVerbosityLevel
        ()
_ <- m ()
forall (m :: * -> *). CharParsing m => m ()
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
P.spaces
        [Verbosity -> Verbosity]
extras <- m (Verbosity -> Verbosity) -> m [Verbosity -> Verbosity]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
External instance of the constraint type forall (m :: * -> *). Parsing m => Alternative m
External instance of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
many (m (Verbosity -> Verbosity)
parseExtra m (Verbosity -> Verbosity) -> m () -> m (Verbosity -> Verbosity)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
External instance of the constraint type forall (f :: * -> *). Alternative f => Applicative f
External instance of the constraint type forall (m :: * -> *). Parsing m => Alternative m
External instance of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
<* m ()
forall (m :: * -> *). CharParsing m => m ()
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
P.spaces)
        Verbosity -> m Verbosity
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => MonadPlus m
Evidence bound by a type signature of the constraint type CabalParsing m
return (((Verbosity -> Verbosity)
 -> (Verbosity -> Verbosity) -> Verbosity -> Verbosity)
-> (Verbosity -> Verbosity)
-> [Verbosity -> Verbosity]
-> Verbosity
-> Verbosity
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
External instance of the constraint type Foldable []
foldr (Verbosity -> Verbosity)
-> (Verbosity -> Verbosity) -> Verbosity -> Verbosity
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) Verbosity -> Verbosity
forall a. a -> a
id [Verbosity -> Verbosity]
extras (VerbosityLevel -> Verbosity
mkVerbosity VerbosityLevel
level))
    parseVerbosityLevel :: m VerbosityLevel
parseVerbosityLevel = [m VerbosityLevel] -> m VerbosityLevel
forall (m :: * -> *) a. Alternative m => [m a] -> m a
External instance of the constraint type forall (m :: * -> *). Parsing m => Alternative m
External instance of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
P.choice
        [ String -> m String
forall (m :: * -> *). CharParsing m => String -> m String
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
P.string String
"silent" m String -> m VerbosityLevel -> m VerbosityLevel
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => MonadPlus m
Evidence bound by a type signature of the constraint type CabalParsing m
>> VerbosityLevel -> m VerbosityLevel
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => MonadPlus m
Evidence bound by a type signature of the constraint type CabalParsing m
return VerbosityLevel
Silent
        , String -> m String
forall (m :: * -> *). CharParsing m => String -> m String
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
P.string String
"normal" m String -> m VerbosityLevel -> m VerbosityLevel
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => MonadPlus m
Evidence bound by a type signature of the constraint type CabalParsing m
>> VerbosityLevel -> m VerbosityLevel
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => MonadPlus m
Evidence bound by a type signature of the constraint type CabalParsing m
return VerbosityLevel
Normal
        , String -> m String
forall (m :: * -> *). CharParsing m => String -> m String
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
P.string String
"verbose" m String -> m VerbosityLevel -> m VerbosityLevel
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => MonadPlus m
Evidence bound by a type signature of the constraint type CabalParsing m
>> VerbosityLevel -> m VerbosityLevel
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => MonadPlus m
Evidence bound by a type signature of the constraint type CabalParsing m
return VerbosityLevel
Verbose
        , String -> m String
forall (m :: * -> *). CharParsing m => String -> m String
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
P.string String
"debug"  m String -> m VerbosityLevel -> m VerbosityLevel
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => MonadPlus m
Evidence bound by a type signature of the constraint type CabalParsing m
>> VerbosityLevel -> m VerbosityLevel
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => MonadPlus m
Evidence bound by a type signature of the constraint type CabalParsing m
return VerbosityLevel
Deafening
        , String -> m String
forall (m :: * -> *). CharParsing m => String -> m String
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
P.string String
"deafening" m String -> m VerbosityLevel -> m VerbosityLevel
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => MonadPlus m
Evidence bound by a type signature of the constraint type CabalParsing m
>> VerbosityLevel -> m VerbosityLevel
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => MonadPlus m
Evidence bound by a type signature of the constraint type CabalParsing m
return VerbosityLevel
Deafening
        ]
    parseExtra :: m (Verbosity -> Verbosity)
parseExtra = Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
P.char Char
'+' m Char -> m (Verbosity -> Verbosity) -> m (Verbosity -> Verbosity)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => MonadPlus m
Evidence bound by a type signature of the constraint type CabalParsing m
>> [m (Verbosity -> Verbosity)] -> m (Verbosity -> Verbosity)
forall (m :: * -> *) a. Alternative m => [m a] -> m a
External instance of the constraint type forall (m :: * -> *). Parsing m => Alternative m
External instance of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
P.choice
        [ String -> m String
forall (m :: * -> *). CharParsing m => String -> m String
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
P.string String
"callsite"  m String
-> m (Verbosity -> Verbosity) -> m (Verbosity -> Verbosity)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => MonadPlus m
Evidence bound by a type signature of the constraint type CabalParsing m
>> (Verbosity -> Verbosity) -> m (Verbosity -> Verbosity)
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => MonadPlus m
Evidence bound by a type signature of the constraint type CabalParsing m
return Verbosity -> Verbosity
verboseCallSite
        , String -> m String
forall (m :: * -> *). CharParsing m => String -> m String
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
P.string String
"callstack" m String
-> m (Verbosity -> Verbosity) -> m (Verbosity -> Verbosity)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => MonadPlus m
Evidence bound by a type signature of the constraint type CabalParsing m
>> (Verbosity -> Verbosity) -> m (Verbosity -> Verbosity)
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => MonadPlus m
Evidence bound by a type signature of the constraint type CabalParsing m
return Verbosity -> Verbosity
verboseCallStack
        , String -> m String
forall (m :: * -> *). CharParsing m => String -> m String
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
P.string String
"nowrap"    m String
-> m (Verbosity -> Verbosity) -> m (Verbosity -> Verbosity)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => MonadPlus m
Evidence bound by a type signature of the constraint type CabalParsing m
>> (Verbosity -> Verbosity) -> m (Verbosity -> Verbosity)
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => MonadPlus m
Evidence bound by a type signature of the constraint type CabalParsing m
return Verbosity -> Verbosity
verboseNoWrap
        , String -> m String
forall (m :: * -> *). CharParsing m => String -> m String
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
P.string String
"markoutput" m String
-> m (Verbosity -> Verbosity) -> m (Verbosity -> Verbosity)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => MonadPlus m
Evidence bound by a type signature of the constraint type CabalParsing m
>> (Verbosity -> Verbosity) -> m (Verbosity -> Verbosity)
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => MonadPlus m
Evidence bound by a type signature of the constraint type CabalParsing m
return Verbosity -> Verbosity
verboseMarkOutput
        , String -> m String
forall (m :: * -> *). CharParsing m => String -> m String
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
P.string String
"timestamp" m String
-> m (Verbosity -> Verbosity) -> m (Verbosity -> Verbosity)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => MonadPlus m
Evidence bound by a type signature of the constraint type CabalParsing m
>> (Verbosity -> Verbosity) -> m (Verbosity -> Verbosity)
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => MonadPlus m
Evidence bound by a type signature of the constraint type CabalParsing m
return Verbosity -> Verbosity
verboseTimestamp
        ]

flagToVerbosity :: ReadE Verbosity
flagToVerbosity :: ReadE Verbosity
flagToVerbosity = ShowS -> ParsecParser Verbosity -> ReadE Verbosity
forall a. ShowS -> ParsecParser a -> ReadE a
parsecToReadE ShowS
forall a. a -> a
id (ParsecParser Verbosity -> ReadE Verbosity)
-> ParsecParser Verbosity -> ReadE Verbosity
forall a b. (a -> b) -> a -> b
$ do
    Either Int Verbosity
e <- ParsecParser (Either Int Verbosity)
forall (m :: * -> *). CabalParsing m => m (Either Int Verbosity)
External instance of the constraint type CabalParsing ParsecParser
parsecVerbosity
    case Either Int Verbosity
e of
       Right Verbosity
v -> Verbosity -> ParsecParser Verbosity
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad ParsecParser
return Verbosity
v
       Left Int
i -> case Int -> Maybe Verbosity
intToVerbosity Int
i of
           Just Verbosity
v  -> Verbosity -> ParsecParser Verbosity
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad ParsecParser
return Verbosity
v
           Maybe Verbosity
Nothing -> String -> ParsecParser Verbosity
forall (m :: * -> *) a. MonadFail m => String -> m a
External instance of the constraint type MonadFail ParsecParser
fail (String -> ParsecParser Verbosity)
-> String -> ParsecParser Verbosity
forall a b. (a -> b) -> a -> b
$ String
"Bad verbosity: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
External instance of the constraint type Show Int
show Int
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
". Valid values are 0..3"

showForCabal, showForGHC :: Verbosity -> String

showForCabal :: Verbosity -> String
showForCabal Verbosity
v
    | Set VerbosityFlag -> Bool
forall a. Set a -> Bool
Set.null (Verbosity -> Set VerbosityFlag
vFlags Verbosity
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
External instance of the constraint type Show Int
show (Maybe Int -> String) -> Maybe Int -> String
forall a b. (a -> b) -> a -> b
$
        Verbosity -> [Verbosity] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
Instance of class: Eq of the constraint type Eq Verbosity
elemIndex Verbosity
v [Verbosity
silent,Verbosity
normal,Verbosity
verbose,Verbosity
deafening]
    | Bool
otherwise
    = [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (case Verbosity -> VerbosityLevel
vLevel Verbosity
v of
                    VerbosityLevel
Silent -> String
"silent"
                    VerbosityLevel
Normal -> String
"normal"
                    VerbosityLevel
Verbose -> String
"verbose"
                    VerbosityLevel
Deafening -> String
"debug")
              String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (VerbosityFlag -> [String]) -> [VerbosityFlag] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
External instance of the constraint type Foldable []
concatMap VerbosityFlag -> [String]
showFlag (Set VerbosityFlag -> [VerbosityFlag]
forall a. Set a -> [a]
Set.toList (Verbosity -> Set VerbosityFlag
vFlags Verbosity
v))
  where
    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"]
showForGHC :: Verbosity -> String
showForGHC   Verbosity
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
External instance of the constraint type Show Int
show (Maybe Int -> String) -> Maybe Int -> String
forall a b. (a -> b) -> a -> b
$
    Verbosity -> [Verbosity] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
Instance of class: Eq of the constraint type Eq Verbosity
elemIndex Verbosity
v [Verbosity
silent,Verbosity
normal,Verbosity
__,Verbosity
verbose,Verbosity
deafening]
        where __ :: Verbosity
__ = Verbosity
silent -- this will be always ignored by elemIndex

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

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

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

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

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

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

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

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

-- | Helper function for flag enabling functions
verboseFlag :: VerbosityFlag -> (Verbosity -> Verbosity)
verboseFlag :: VerbosityFlag -> Verbosity -> Verbosity
verboseFlag VerbosityFlag
flag Verbosity
v = Verbosity
v { vFlags :: Set VerbosityFlag
vFlags = VerbosityFlag -> Set VerbosityFlag -> Set VerbosityFlag
forall a. Ord a => a -> Set a -> Set a
External instance of the constraint type Ord VerbosityFlag
Set.insert VerbosityFlag
flag (Verbosity -> Set VerbosityFlag
vFlags Verbosity
v) }

-- | Helper function for flag disabling functions
verboseNoFlag :: VerbosityFlag -> (Verbosity -> Verbosity)
verboseNoFlag :: VerbosityFlag -> Verbosity -> Verbosity
verboseNoFlag VerbosityFlag
flag Verbosity
v = Verbosity
v { vFlags :: Set VerbosityFlag
vFlags = VerbosityFlag -> Set VerbosityFlag -> Set VerbosityFlag
forall a. Ord a => a -> Set a -> Set a
External instance of the constraint type Ord VerbosityFlag
Set.delete VerbosityFlag
flag (Verbosity -> Set VerbosityFlag
vFlags Verbosity
v) }

-- | Turn off all flags
verboseNoFlags :: Verbosity -> Verbosity
verboseNoFlags :: Verbosity -> Verbosity
verboseNoFlags Verbosity
v = Verbosity
v { vFlags :: Set VerbosityFlag
vFlags = Set VerbosityFlag
forall a. Set a
Set.empty }

verboseHasFlags :: Verbosity -> Bool
verboseHasFlags :: Verbosity -> Bool
verboseHasFlags = Bool -> Bool
not (Bool -> Bool) -> (Verbosity -> Bool) -> Verbosity -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set VerbosityFlag -> Bool
forall a. Set a -> Bool
Set.null (Set VerbosityFlag -> Bool)
-> (Verbosity -> Set VerbosityFlag) -> Verbosity -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Verbosity -> Set VerbosityFlag
vFlags

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

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

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

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

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

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

-- | Helper function for flag testing functions.
isVerboseFlag :: VerbosityFlag -> Verbosity -> Bool
isVerboseFlag :: VerbosityFlag -> Verbosity -> Bool
isVerboseFlag VerbosityFlag
flag = (VerbosityFlag -> Set VerbosityFlag -> Bool
forall a. Ord a => a -> Set a -> Bool
External instance of the constraint type Ord VerbosityFlag
Set.member VerbosityFlag
flag) (Set VerbosityFlag -> Bool)
-> (Verbosity -> Set VerbosityFlag) -> Verbosity -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Verbosity -> Set VerbosityFlag
vFlags

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