{-# LANGUAGE DeriveDataTypeable #-}

-- |  A module to deal with verbosity, how \'chatty\' a program should be.
--    This module defines the 'Verbosity' data type, along with functions
--    for manipulating a global verbosity value.
module System.Console.CmdArgs.Verbosity(
    Verbosity(..), setVerbosity, getVerbosity,
    isNormal, isLoud,
    whenNormal, whenLoud
    ) where

import Control.Monad
import Data.Data
import Data.IORef
import System.IO.Unsafe


-- | The verbosity data type
data Verbosity
    = Quiet  -- ^ Only output essential messages (typically errors)
    | Normal -- ^ Output normal messages (typically errors and warnings)
    | Loud   -- ^ Output lots of messages (typically errors, warnings and status updates)
      deriving (Verbosity -> Verbosity -> Bool
(Verbosity -> Verbosity -> Bool)
-> (Verbosity -> Verbosity -> Bool) -> Eq Verbosity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Verbosity -> Verbosity -> Bool
$c/= :: Verbosity -> Verbosity -> Bool
== :: Verbosity -> Verbosity -> Bool
$c== :: Verbosity -> Verbosity -> Bool
Eq,Eq Verbosity
Eq Verbosity
-> (Verbosity -> Verbosity -> Ordering)
-> (Verbosity -> Verbosity -> Bool)
-> (Verbosity -> Verbosity -> Bool)
-> (Verbosity -> Verbosity -> Bool)
-> (Verbosity -> Verbosity -> Bool)
-> (Verbosity -> Verbosity -> Verbosity)
-> (Verbosity -> Verbosity -> Verbosity)
-> Ord Verbosity
Verbosity -> Verbosity -> Bool
Verbosity -> Verbosity -> Ordering
Verbosity -> Verbosity -> Verbosity
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Verbosity -> Verbosity -> Verbosity
$cmin :: Verbosity -> Verbosity -> Verbosity
max :: Verbosity -> Verbosity -> Verbosity
$cmax :: Verbosity -> Verbosity -> Verbosity
>= :: Verbosity -> Verbosity -> Bool
$c>= :: Verbosity -> Verbosity -> Bool
> :: Verbosity -> Verbosity -> Bool
$c> :: Verbosity -> Verbosity -> Bool
<= :: Verbosity -> Verbosity -> Bool
$c<= :: Verbosity -> Verbosity -> Bool
< :: Verbosity -> Verbosity -> Bool
$c< :: Verbosity -> Verbosity -> Bool
compare :: Verbosity -> Verbosity -> Ordering
$ccompare :: Verbosity -> Verbosity -> Ordering
$cp1Ord :: Eq Verbosity
Ord,Verbosity
Verbosity -> Verbosity -> Bounded Verbosity
forall a. a -> a -> Bounded a
maxBound :: Verbosity
$cmaxBound :: Verbosity
minBound :: Verbosity
$cminBound :: Verbosity
Bounded,Int -> Verbosity
Verbosity -> Int
Verbosity -> [Verbosity]
Verbosity -> Verbosity
Verbosity -> Verbosity -> [Verbosity]
Verbosity -> Verbosity -> Verbosity -> [Verbosity]
(Verbosity -> Verbosity)
-> (Verbosity -> Verbosity)
-> (Int -> Verbosity)
-> (Verbosity -> Int)
-> (Verbosity -> [Verbosity])
-> (Verbosity -> Verbosity -> [Verbosity])
-> (Verbosity -> Verbosity -> [Verbosity])
-> (Verbosity -> Verbosity -> Verbosity -> [Verbosity])
-> Enum Verbosity
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Verbosity -> Verbosity -> Verbosity -> [Verbosity]
$cenumFromThenTo :: Verbosity -> Verbosity -> Verbosity -> [Verbosity]
enumFromTo :: Verbosity -> Verbosity -> [Verbosity]
$cenumFromTo :: Verbosity -> Verbosity -> [Verbosity]
enumFromThen :: Verbosity -> Verbosity -> [Verbosity]
$cenumFromThen :: Verbosity -> Verbosity -> [Verbosity]
enumFrom :: Verbosity -> [Verbosity]
$cenumFrom :: Verbosity -> [Verbosity]
fromEnum :: Verbosity -> Int
$cfromEnum :: Verbosity -> Int
toEnum :: Int -> Verbosity
$ctoEnum :: Int -> Verbosity
pred :: Verbosity -> Verbosity
$cpred :: Verbosity -> Verbosity
succ :: Verbosity -> Verbosity
$csucc :: Verbosity -> Verbosity
Enum,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
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
Read,Typeable Verbosity
DataType
Constr
Typeable Verbosity
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Verbosity -> c Verbosity)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Verbosity)
-> (Verbosity -> Constr)
-> (Verbosity -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Verbosity))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Verbosity))
-> ((forall b. Data b => b -> b) -> Verbosity -> Verbosity)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Verbosity -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Verbosity -> r)
-> (forall u. (forall d. Data d => d -> u) -> Verbosity -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Verbosity -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Verbosity -> m Verbosity)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Verbosity -> m Verbosity)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Verbosity -> m Verbosity)
-> Data Verbosity
Verbosity -> DataType
Verbosity -> Constr
(forall b. Data b => b -> b) -> Verbosity -> Verbosity
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Verbosity -> c Verbosity
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Verbosity
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Verbosity -> u
forall u. (forall d. Data d => d -> u) -> Verbosity -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Verbosity -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Verbosity -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Verbosity -> m Verbosity
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Verbosity -> m Verbosity
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Verbosity
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Verbosity -> c Verbosity
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Verbosity)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Verbosity)
$cLoud :: Constr
$cNormal :: Constr
$cQuiet :: Constr
$tVerbosity :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Verbosity -> m Verbosity
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Verbosity -> m Verbosity
gmapMp :: (forall d. Data d => d -> m d) -> Verbosity -> m Verbosity
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Verbosity -> m Verbosity
gmapM :: (forall d. Data d => d -> m d) -> Verbosity -> m Verbosity
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Verbosity -> m Verbosity
gmapQi :: Int -> (forall d. Data d => d -> u) -> Verbosity -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Verbosity -> u
gmapQ :: (forall d. Data d => d -> u) -> Verbosity -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Verbosity -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Verbosity -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Verbosity -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Verbosity -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Verbosity -> r
gmapT :: (forall b. Data b => b -> b) -> Verbosity -> Verbosity
$cgmapT :: (forall b. Data b => b -> b) -> Verbosity -> Verbosity
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Verbosity)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Verbosity)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Verbosity)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Verbosity)
dataTypeOf :: Verbosity -> DataType
$cdataTypeOf :: Verbosity -> DataType
toConstr :: Verbosity -> Constr
$ctoConstr :: Verbosity -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Verbosity
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Verbosity
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Verbosity -> c Verbosity
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Verbosity -> c Verbosity
$cp1Data :: Typeable Verbosity
Data,Typeable)


{-# NOINLINE ref #-}
ref :: IORef Verbosity
ref :: IORef Verbosity
ref = IO (IORef Verbosity) -> IORef Verbosity
forall a. IO a -> a
unsafePerformIO (IO (IORef Verbosity) -> IORef Verbosity)
-> IO (IORef Verbosity) -> IORef Verbosity
forall a b. (a -> b) -> a -> b
$ Verbosity -> IO (IORef Verbosity)
forall a. a -> IO (IORef a)
newIORef Verbosity
Normal


-- | Set the global verbosity.
setVerbosity :: Verbosity -> IO ()
setVerbosity :: Verbosity -> IO ()
setVerbosity = IORef Verbosity -> Verbosity -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Verbosity
ref

-- | Get the global verbosity. Initially @Normal@ before any calls to 'setVerbosity'.
getVerbosity :: IO Verbosity
getVerbosity :: IO Verbosity
getVerbosity = IORef Verbosity -> IO Verbosity
forall a. IORef a -> IO a
readIORef IORef Verbosity
ref

-- | Used to test if warnings should be output to the user.
--   @True@ if the verbosity is set to 'Normal' or 'Loud' (when @--quiet@ is /not/ specified).
isNormal :: IO Bool
isNormal :: IO Bool
isNormal = (Verbosity -> Bool) -> IO Verbosity -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Verbosity -> Verbosity -> Bool
forall a. Ord a => a -> a -> Bool
>=Verbosity
Normal) IO Verbosity
getVerbosity

-- | Used to test if status updates should be output to the user.
--   @True@ if the verbosity is set to 'Loud' (when @--verbose@ is specified).
isLoud :: IO Bool
isLoud :: IO Bool
isLoud = (Verbosity -> Bool) -> IO Verbosity -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Verbosity -> Verbosity -> Bool
forall a. Ord a => a -> a -> Bool
>=Verbosity
Loud) IO Verbosity
getVerbosity


-- | An action to perform if the verbosity is normal or higher, based on 'isNormal'.
whenNormal :: IO () -> IO ()
whenNormal :: IO () -> IO ()
whenNormal IO ()
act = do
    Bool
b <- IO Bool
isNormal
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
b IO ()
act

-- | An action to perform if the verbosity is loud, based on 'isLoud'.
whenLoud :: IO () -> IO ()
whenLoud :: IO () -> IO ()
whenLoud IO ()
act = do
    Bool
b <- IO Bool
isLoud
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
b IO ()
act