{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
module Distribution.Verbosity (
Verbosity,
silent, normal, verbose, deafening,
moreVerbose, lessVerbose, isVerboseQuiet,
intToVerbosity, flagToVerbosity,
showForCabal, showForGHC,
verboseNoFlags, verboseHasFlags,
modifyVerbosity,
verboseCallSite, verboseCallStack,
isVerboseCallSite, isVerboseCallStack,
verboseMarkOutput, isVerboseMarkOutput,
verboseUnmarkOutput,
verboseNoWrap, isVerboseNoWrap,
verboseTimestamp, isVerboseTimestamp,
verboseNoTimestamp,
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 {
Verbosity -> VerbosityLevel
vLevel :: VerbosityLevel,
Verbosity -> Set VerbosityFlag
vFlags :: Set VerbosityFlag,
Verbosity -> Bool
vQuiet :: Bool
} deriving (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
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
Show, ReadPrec [Verbosity]
ReadPrec Verbosity
Int -> ReadS Verbosity
ReadS [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
Read, Typeable)
mkVerbosity :: VerbosityLevel -> Verbosity
mkVerbosity :: VerbosityLevel -> Verbosity
mkVerbosity VerbosityLevel
l = Verbosity { vLevel :: VerbosityLevel
vLevel = VerbosityLevel
l, vFlags :: Set VerbosityFlag
vFlags = 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 forall a. Eq a => a -> a -> Bool
== Verbosity -> VerbosityLevel
vLevel Verbosity
y
instance Ord Verbosity where
compare :: Verbosity -> Verbosity -> Ordering
compare Verbosity
x Verbosity
y = forall a. Ord a => a -> a -> Ordering
compare (Verbosity -> VerbosityLevel
vLevel Verbosity
x) (Verbosity -> VerbosityLevel
vLevel Verbosity
y)
instance Enum Verbosity where
toEnum :: Int -> Verbosity
toEnum = VerbosityLevel -> Verbosity
mkVerbosity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => Int -> a
toEnum
fromEnum :: Verbosity -> Int
fromEnum = forall a. Enum a => a -> Int
fromEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. Verbosity -> VerbosityLevel
vLevel
instance Bounded Verbosity where
minBound :: Verbosity
minBound = VerbosityLevel -> Verbosity
mkVerbosity forall a. Bounded a => a
minBound
maxBound :: Verbosity
maxBound = VerbosityLevel -> Verbosity
mkVerbosity forall a. Bounded a => a
maxBound
instance Binary Verbosity
instance Structured Verbosity
silent :: Verbosity
silent :: Verbosity
silent = VerbosityLevel -> Verbosity
mkVerbosity VerbosityLevel
Silent
normal :: Verbosity
normal :: Verbosity
normal = VerbosityLevel -> Verbosity
mkVerbosity VerbosityLevel
Normal
verbose :: Verbosity
verbose :: Verbosity
verbose = VerbosityLevel -> Verbosity
mkVerbosity VerbosityLevel
Verbose
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
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 forall a b. (a -> b) -> a -> b
$
case Verbosity -> VerbosityLevel
vLevel Verbosity
v of
VerbosityLevel
Deafening -> Verbosity
v
VerbosityLevel
Verbose -> Verbosity
v { vLevel :: VerbosityLevel
vLevel = VerbosityLevel
Normal }
VerbosityLevel
Normal -> Verbosity
v { vLevel :: VerbosityLevel
vLevel = VerbosityLevel
Silent }
VerbosityLevel
Silent -> Verbosity
v
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 = forall a. a -> Maybe a
Just (VerbosityLevel -> Verbosity
mkVerbosity VerbosityLevel
Silent)
intToVerbosity Int
1 = forall a. a -> Maybe a
Just (VerbosityLevel -> Verbosity
mkVerbosity VerbosityLevel
Normal)
intToVerbosity Int
2 = forall a. a -> Maybe a
Just (VerbosityLevel -> Verbosity
mkVerbosity VerbosityLevel
Verbose)
intToVerbosity Int
3 = forall a. a -> Maybe a
Just (VerbosityLevel -> Verbosity
mkVerbosity VerbosityLevel
Deafening)
intToVerbosity Int
_ = forall a. Maybe a
Nothing
instance Parsec Verbosity where
parsec :: forall (m :: * -> *). CabalParsing m => m Verbosity
parsec = forall (m :: * -> *). CabalParsing m => m Verbosity
parsecVerbosity
instance Pretty Verbosity where
pretty :: Verbosity -> Doc
pretty = String -> Doc
PP.text forall b c a. (b -> c) -> (a -> b) -> a -> c
. Verbosity -> String
showForCabal
parsecVerbosity :: CabalParsing m => m Verbosity
parsecVerbosity :: forall (m :: * -> *). CabalParsing m => m Verbosity
parsecVerbosity = m Verbosity
parseIntVerbosity forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m Verbosity
parseStringVerbosity
where
parseIntVerbosity :: m Verbosity
parseIntVerbosity = do
Int
i <- forall (m :: * -> *) a. (CharParsing m, Integral a) => m a
P.integral
case Int -> Maybe Verbosity
intToVerbosity Int
i of
Just Verbosity
v -> forall (m :: * -> *) a. Monad m => a -> m a
return Verbosity
v
Maybe Verbosity
Nothing -> forall (m :: * -> *) a. Parsing m => String -> m a
P.unexpected forall a b. (a -> b) -> a -> b
$ String
"Bad integral verbosity: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
i forall a. [a] -> [a] -> [a]
++ String
". Valid values are 0..3"
parseStringVerbosity :: m Verbosity
parseStringVerbosity = do
VerbosityLevel
level <- m VerbosityLevel
parseVerbosityLevel
()
_ <- forall (m :: * -> *). CharParsing m => m ()
P.spaces
[Verbosity -> Verbosity]
flags <- forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (m (Verbosity -> Verbosity)
parseFlag forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). CharParsing m => m ()
P.spaces)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> a -> b
($)) (VerbosityLevel -> Verbosity
mkVerbosity VerbosityLevel
level) [Verbosity -> Verbosity]
flags
parseVerbosityLevel :: m VerbosityLevel
parseVerbosityLevel = do
String
token <- forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m String
P.munch1 Char -> Bool
isAsciiAlpha
case String
token of
String
"silent" -> forall (m :: * -> *) a. Monad m => a -> m a
return VerbosityLevel
Silent
String
"normal" -> forall (m :: * -> *) a. Monad m => a -> m a
return VerbosityLevel
Normal
String
"verbose" -> forall (m :: * -> *) a. Monad m => a -> m a
return VerbosityLevel
Verbose
String
"debug" -> forall (m :: * -> *) a. Monad m => a -> m a
return VerbosityLevel
Deafening
String
"deafening" -> forall (m :: * -> *) a. Monad m => a -> m a
return VerbosityLevel
Deafening
String
_ -> forall (m :: * -> *) a. Parsing m => String -> m a
P.unexpected forall a b. (a -> b) -> a -> b
$ String
"Bad verbosity level: " forall a. [a] -> [a] -> [a]
++ String
token
parseFlag :: m (Verbosity -> Verbosity)
parseFlag = do
Char
_ <- forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'+'
String
token <- forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m String
P.munch1 Char -> Bool
isAsciiAlpha
case String
token of
String
"callsite" -> forall (m :: * -> *) a. Monad m => a -> m a
return Verbosity -> Verbosity
verboseCallSite
String
"callstack" -> forall (m :: * -> *) a. Monad m => a -> m a
return Verbosity -> Verbosity
verboseCallStack
String
"nowrap" -> forall (m :: * -> *) a. Monad m => a -> m a
return Verbosity -> Verbosity
verboseNoWrap
String
"markoutput" -> forall (m :: * -> *) a. Monad m => a -> m a
return Verbosity -> Verbosity
verboseMarkOutput
String
"timestamp" -> forall (m :: * -> *) a. Monad m => a -> m a
return Verbosity -> Verbosity
verboseTimestamp
String
"stderr" -> forall (m :: * -> *) a. Monad m => a -> m a
return Verbosity -> Verbosity
verboseStderr
String
"stdout" -> forall (m :: * -> *) a. Monad m => a -> m a
return Verbosity -> Verbosity
verboseNoStderr
String
_ -> forall (m :: * -> *) a. Parsing m => String -> m a
P.unexpected forall a b. (a -> b) -> a -> b
$ String
"Bad verbosity flag: " forall a. [a] -> [a] -> [a]
++ String
token
flagToVerbosity :: ReadE Verbosity
flagToVerbosity :: ReadE Verbosity
flagToVerbosity = forall a. ShowS -> ParsecParser a -> ReadE a
parsecToReadE forall a. a -> a
id forall (m :: * -> *). CabalParsing m => m Verbosity
parsecVerbosity
showForCabal :: Verbosity -> String
showForCabal :: Verbosity -> String
showForCabal Verbosity
v
| forall a. Set a -> Bool
Set.null (Verbosity -> Set VerbosityFlag
vFlags Verbosity
v)
= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. HasCallStack => String -> a
error String
"unknown verbosity") forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex Verbosity
v [Verbosity
silent,Verbosity
normal,Verbosity
verbose,Verbosity
deafening]
| Bool
otherwise
= [String] -> String
unwords
forall a b. (a -> b) -> a -> b
$ VerbosityLevel -> String
showLevel (Verbosity -> VerbosityLevel
vLevel Verbosity
v)
forall a. a -> [a] -> [a]
: forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap VerbosityFlag -> [String]
showFlag (forall a. Set a -> [a]
Set.toList (Verbosity -> Set VerbosityFlag
vFlags Verbosity
v))
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"]
showForGHC :: Verbosity -> String
showForGHC :: Verbosity -> String
showForGHC Verbosity
v = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. HasCallStack => String -> a
error String
"unknown verbosity") forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex Verbosity
v [Verbosity
silent,Verbosity
normal,Verbosity
__,Verbosity
verbose,Verbosity
deafening]
where __ :: Verbosity
__ = Verbosity
silent
verboseCallSite :: Verbosity -> Verbosity
verboseCallSite :: Verbosity -> Verbosity
verboseCallSite = VerbosityFlag -> Verbosity -> Verbosity
verboseFlag VerbosityFlag
VCallSite
verboseCallStack :: Verbosity -> Verbosity
verboseCallStack :: Verbosity -> Verbosity
verboseCallStack = VerbosityFlag -> Verbosity -> Verbosity
verboseFlag VerbosityFlag
VCallStack
verboseMarkOutput :: Verbosity -> Verbosity
verboseMarkOutput :: Verbosity -> Verbosity
verboseMarkOutput = VerbosityFlag -> Verbosity -> Verbosity
verboseFlag VerbosityFlag
VMarkOutput
verboseUnmarkOutput :: Verbosity -> Verbosity
verboseUnmarkOutput :: Verbosity -> Verbosity
verboseUnmarkOutput = VerbosityFlag -> Verbosity -> Verbosity
verboseNoFlag VerbosityFlag
VMarkOutput
verboseNoWrap :: Verbosity -> Verbosity
verboseNoWrap :: Verbosity -> Verbosity
verboseNoWrap = VerbosityFlag -> Verbosity -> Verbosity
verboseFlag VerbosityFlag
VNoWrap
verboseQuiet :: Verbosity -> Verbosity
verboseQuiet :: Verbosity -> Verbosity
verboseQuiet Verbosity
v = Verbosity
v { vQuiet :: Bool
vQuiet = Bool
True }
verboseTimestamp :: Verbosity -> Verbosity
verboseTimestamp :: Verbosity -> Verbosity
verboseTimestamp = VerbosityFlag -> Verbosity -> Verbosity
verboseFlag VerbosityFlag
VTimestamp
verboseNoTimestamp :: Verbosity -> Verbosity
verboseNoTimestamp :: Verbosity -> Verbosity
verboseNoTimestamp = VerbosityFlag -> Verbosity -> Verbosity
verboseNoFlag VerbosityFlag
VTimestamp
verboseStderr :: Verbosity -> Verbosity
verboseStderr :: Verbosity -> Verbosity
verboseStderr = VerbosityFlag -> Verbosity -> Verbosity
verboseFlag VerbosityFlag
VStderr
verboseNoStderr :: Verbosity -> Verbosity
verboseNoStderr :: Verbosity -> Verbosity
verboseNoStderr = VerbosityFlag -> Verbosity -> Verbosity
verboseNoFlag VerbosityFlag
VStderr
verboseFlag :: VerbosityFlag -> (Verbosity -> Verbosity)
verboseFlag :: VerbosityFlag -> Verbosity -> Verbosity
verboseFlag VerbosityFlag
flag Verbosity
v = Verbosity
v { vFlags :: Set VerbosityFlag
vFlags = forall a. Ord a => a -> Set a -> Set a
Set.insert VerbosityFlag
flag (Verbosity -> Set VerbosityFlag
vFlags Verbosity
v) }
verboseNoFlag :: VerbosityFlag -> (Verbosity -> Verbosity)
verboseNoFlag :: VerbosityFlag -> Verbosity -> Verbosity
verboseNoFlag VerbosityFlag
flag Verbosity
v = Verbosity
v { vFlags :: Set VerbosityFlag
vFlags = forall a. Ord a => a -> Set a -> Set a
Set.delete VerbosityFlag
flag (Verbosity -> Set VerbosityFlag
vFlags Verbosity
v) }
verboseNoFlags :: Verbosity -> Verbosity
verboseNoFlags :: Verbosity -> Verbosity
verboseNoFlags Verbosity
v = Verbosity
v { vFlags :: Set VerbosityFlag
vFlags = forall a. Set a
Set.empty }
verboseHasFlags :: Verbosity -> Bool
verboseHasFlags :: Verbosity -> Bool
verboseHasFlags = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Set a -> Bool
Set.null forall b c a. (b -> c) -> (a -> b) -> a -> c
. Verbosity -> Set VerbosityFlag
vFlags
isVerboseCallSite :: Verbosity -> Bool
isVerboseCallSite :: Verbosity -> Bool
isVerboseCallSite = VerbosityFlag -> Verbosity -> Bool
isVerboseFlag VerbosityFlag
VCallSite
isVerboseCallStack :: Verbosity -> Bool
isVerboseCallStack :: Verbosity -> Bool
isVerboseCallStack = VerbosityFlag -> Verbosity -> Bool
isVerboseFlag VerbosityFlag
VCallStack
isVerboseMarkOutput :: Verbosity -> Bool
isVerboseMarkOutput :: Verbosity -> Bool
isVerboseMarkOutput = VerbosityFlag -> Verbosity -> Bool
isVerboseFlag VerbosityFlag
VMarkOutput
isVerboseNoWrap :: Verbosity -> Bool
isVerboseNoWrap :: Verbosity -> Bool
isVerboseNoWrap = VerbosityFlag -> Verbosity -> Bool
isVerboseFlag VerbosityFlag
VNoWrap
isVerboseQuiet :: Verbosity -> Bool
isVerboseQuiet :: Verbosity -> Bool
isVerboseQuiet = Verbosity -> Bool
vQuiet
isVerboseTimestamp :: Verbosity -> Bool
isVerboseTimestamp :: Verbosity -> Bool
isVerboseTimestamp = VerbosityFlag -> Verbosity -> Bool
isVerboseFlag VerbosityFlag
VTimestamp
isVerboseStderr :: Verbosity -> Bool
isVerboseStderr :: Verbosity -> Bool
isVerboseStderr = VerbosityFlag -> Verbosity -> Bool
isVerboseFlag VerbosityFlag
VStderr
isVerboseFlag :: VerbosityFlag -> Verbosity -> Bool
isVerboseFlag :: VerbosityFlag -> Verbosity -> Bool
isVerboseFlag VerbosityFlag
flag = (forall a. Ord a => a -> Set a -> Bool
Set.member VerbosityFlag
flag) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Verbosity -> Set VerbosityFlag
vFlags