module Distribution.Verbosity (
Verbosity,
silent, normal, verbose, deafening,
moreVerbose, lessVerbose,
intToVerbosity, flagToVerbosity,
showForCabal, showForGHC
) where
import Data.Binary
import Data.List (elemIndex)
import Distribution.ReadE
import GHC.Generics
data Verbosity = Silent | Normal | Verbose | Deafening
deriving (Generic, Show, Read, Eq, Ord, Enum, Bounded)
instance Binary Verbosity
silent :: Verbosity
silent = Silent
normal :: Verbosity
normal = Normal
verbose :: Verbosity
verbose = Verbose
deafening :: Verbosity
deafening = Deafening
moreVerbose :: Verbosity -> Verbosity
moreVerbose Silent = Silent
moreVerbose Normal = Verbose
moreVerbose Verbose = Deafening
moreVerbose Deafening = Deafening
lessVerbose :: Verbosity -> Verbosity
lessVerbose Deafening = Deafening
lessVerbose Verbose = Normal
lessVerbose Normal = Silent
lessVerbose Silent = Silent
intToVerbosity :: Int -> Maybe Verbosity
intToVerbosity 0 = Just Silent
intToVerbosity 1 = Just Normal
intToVerbosity 2 = Just Verbose
intToVerbosity 3 = Just Deafening
intToVerbosity _ = Nothing
flagToVerbosity :: ReadE Verbosity
flagToVerbosity = ReadE $ \s ->
case reads s of
[(i, "")] ->
case intToVerbosity i of
Just v -> Right v
Nothing -> Left ("Bad verbosity: " ++ show i ++
". Valid values are 0..3")
_ -> Left ("Can't parse verbosity " ++ s)
showForCabal, showForGHC :: Verbosity -> String
showForCabal v = maybe (error "unknown verbosity") show $
elemIndex v [silent,normal,verbose,deafening]
showForGHC v = maybe (error "unknown verbosity") show $
elemIndex v [silent,normal,__,verbose,deafening]
where __ = silent