{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE UndecidableInstances #-}
module Tonatona.Logger
( Config(..)
, DeployMode(..)
, Verbose(..)
, defaultVerbosity
, Tonatona.Logger.logDebug
, Tonatona.Logger.logInfo
, Tonatona.Logger.logWarn
, Tonatona.Logger.logError
, Tonatona.Logger.logOther
, Tonatona.Logger.logSticky
, Tonatona.Logger.logStickyDone
, Tonatona.Logger.logDebugS
, Tonatona.Logger.logInfoS
, Tonatona.Logger.logWarnS
, Tonatona.Logger.logErrorS
, Tonatona.Logger.logOtherS
, Tonatona.Logger.logGeneric
, LogLevel (..)
, LogSource
) where
import RIO
import Tonatona (HasConfig(..), HasParser(..))
import TonaParser
( Var(..)
, (.||)
, argLong
, envVar
, liftWith
, optionalEnum
)
logDebug :: (HasConfig env Config) => Utf8Builder -> RIO env ()
logDebug :: Utf8Builder -> RIO env ()
logDebug = RIO (InnerEnv env) () -> RIO env ()
forall env. RIO (InnerEnv env) () -> RIO env ()
unwrap (RIO (InnerEnv env) () -> RIO env ())
-> (Utf8Builder -> RIO (InnerEnv env) ())
-> Utf8Builder
-> RIO env ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Utf8Builder -> RIO (InnerEnv env) ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
RIO.logDebug
logInfo :: (HasConfig env Config) => Utf8Builder -> RIO env ()
logInfo :: Utf8Builder -> RIO env ()
logInfo = RIO (InnerEnv env) () -> RIO env ()
forall env. RIO (InnerEnv env) () -> RIO env ()
unwrap (RIO (InnerEnv env) () -> RIO env ())
-> (Utf8Builder -> RIO (InnerEnv env) ())
-> Utf8Builder
-> RIO env ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Utf8Builder -> RIO (InnerEnv env) ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
RIO.logInfo
logWarn :: (HasConfig env Config) => Utf8Builder -> RIO env ()
logWarn :: Utf8Builder -> RIO env ()
logWarn = RIO (InnerEnv env) () -> RIO env ()
forall env. RIO (InnerEnv env) () -> RIO env ()
unwrap (RIO (InnerEnv env) () -> RIO env ())
-> (Utf8Builder -> RIO (InnerEnv env) ())
-> Utf8Builder
-> RIO env ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Utf8Builder -> RIO (InnerEnv env) ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
RIO.logWarn
logError :: (HasConfig env Config) => Utf8Builder -> RIO env ()
logError :: Utf8Builder -> RIO env ()
logError = RIO (InnerEnv env) () -> RIO env ()
forall env. RIO (InnerEnv env) () -> RIO env ()
unwrap (RIO (InnerEnv env) () -> RIO env ())
-> (Utf8Builder -> RIO (InnerEnv env) ())
-> Utf8Builder
-> RIO env ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Utf8Builder -> RIO (InnerEnv env) ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
RIO.logError
logOther :: (HasConfig env Config)
=> Text
-> Utf8Builder -> RIO env ()
logOther :: Text -> Utf8Builder -> RIO env ()
logOther Text
level = RIO (InnerEnv env) () -> RIO env ()
forall env. RIO (InnerEnv env) () -> RIO env ()
unwrap (RIO (InnerEnv env) () -> RIO env ())
-> (Utf8Builder -> RIO (InnerEnv env) ())
-> Utf8Builder
-> RIO env ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Utf8Builder -> RIO (InnerEnv env) ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Text -> Utf8Builder -> m ()
RIO.logOther Text
level
logDebugS
:: (HasConfig env Config)
=> LogSource
-> Utf8Builder
-> RIO env ()
logDebugS :: Text -> Utf8Builder -> RIO env ()
logDebugS Text
src = RIO (InnerEnv env) () -> RIO env ()
forall env. RIO (InnerEnv env) () -> RIO env ()
unwrap (RIO (InnerEnv env) () -> RIO env ())
-> (Utf8Builder -> RIO (InnerEnv env) ())
-> Utf8Builder
-> RIO env ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Utf8Builder -> RIO (InnerEnv env) ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Text -> Utf8Builder -> m ()
RIO.logDebugS Text
src
logInfoS
:: (HasConfig env Config)
=> LogSource
-> Utf8Builder
-> RIO env ()
logInfoS :: Text -> Utf8Builder -> RIO env ()
logInfoS Text
src = RIO (InnerEnv env) () -> RIO env ()
forall env. RIO (InnerEnv env) () -> RIO env ()
unwrap (RIO (InnerEnv env) () -> RIO env ())
-> (Utf8Builder -> RIO (InnerEnv env) ())
-> Utf8Builder
-> RIO env ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Utf8Builder -> RIO (InnerEnv env) ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Text -> Utf8Builder -> m ()
RIO.logInfoS Text
src
logWarnS
:: (HasConfig env Config)
=> LogSource
-> Utf8Builder
-> RIO env ()
logWarnS :: Text -> Utf8Builder -> RIO env ()
logWarnS Text
src = RIO (InnerEnv env) () -> RIO env ()
forall env. RIO (InnerEnv env) () -> RIO env ()
unwrap (RIO (InnerEnv env) () -> RIO env ())
-> (Utf8Builder -> RIO (InnerEnv env) ())
-> Utf8Builder
-> RIO env ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Utf8Builder -> RIO (InnerEnv env) ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Text -> Utf8Builder -> m ()
RIO.logWarnS Text
src
logErrorS
:: (HasConfig env Config)
=> LogSource
-> Utf8Builder
-> RIO env ()
logErrorS :: Text -> Utf8Builder -> RIO env ()
logErrorS Text
src = RIO (InnerEnv env) () -> RIO env ()
forall env. RIO (InnerEnv env) () -> RIO env ()
unwrap (RIO (InnerEnv env) () -> RIO env ())
-> (Utf8Builder -> RIO (InnerEnv env) ())
-> Utf8Builder
-> RIO env ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Utf8Builder -> RIO (InnerEnv env) ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Text -> Utf8Builder -> m ()
RIO.logErrorS Text
src
logOtherS
:: (HasConfig env Config)
=> Text
-> LogSource
-> Utf8Builder
-> RIO env ()
logOtherS :: Text -> Text -> Utf8Builder -> RIO env ()
logOtherS Text
level Text
src = RIO (InnerEnv env) () -> RIO env ()
forall env. RIO (InnerEnv env) () -> RIO env ()
unwrap (RIO (InnerEnv env) () -> RIO env ())
-> (Utf8Builder -> RIO (InnerEnv env) ())
-> Utf8Builder
-> RIO env ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Utf8Builder -> RIO (InnerEnv env) ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Text -> Text -> Utf8Builder -> m ()
RIO.logOtherS Text
level Text
src
logSticky :: (HasConfig env Config) => Utf8Builder -> RIO env ()
logSticky :: Utf8Builder -> RIO env ()
logSticky = RIO (InnerEnv env) () -> RIO env ()
forall env. RIO (InnerEnv env) () -> RIO env ()
unwrap (RIO (InnerEnv env) () -> RIO env ())
-> (Utf8Builder -> RIO (InnerEnv env) ())
-> Utf8Builder
-> RIO env ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Utf8Builder -> RIO (InnerEnv env) ()
forall (m :: * -> *) env.
(MonadIO m, HasCallStack, MonadReader env m, HasLogFunc env) =>
Utf8Builder -> m ()
RIO.logSticky
logStickyDone :: (HasConfig env Config) => Utf8Builder -> RIO env ()
logStickyDone :: Utf8Builder -> RIO env ()
logStickyDone = RIO (InnerEnv env) () -> RIO env ()
forall env. RIO (InnerEnv env) () -> RIO env ()
unwrap (RIO (InnerEnv env) () -> RIO env ())
-> (Utf8Builder -> RIO (InnerEnv env) ())
-> Utf8Builder
-> RIO env ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Utf8Builder -> RIO (InnerEnv env) ()
forall (m :: * -> *) env.
(MonadIO m, HasCallStack, MonadReader env m, HasLogFunc env) =>
Utf8Builder -> m ()
RIO.logStickyDone
logGeneric ::
(HasConfig env Config)
=> LogSource
-> LogLevel
-> Utf8Builder
-> RIO env ()
logGeneric :: Text -> LogLevel -> Utf8Builder -> RIO env ()
logGeneric Text
src LogLevel
level Utf8Builder
str = RIO (InnerEnv env) () -> RIO env ()
forall env. RIO (InnerEnv env) () -> RIO env ()
unwrap (RIO (InnerEnv env) () -> RIO env ())
-> RIO (InnerEnv env) () -> RIO env ()
forall a b. (a -> b) -> a -> b
$ Text -> LogLevel -> Utf8Builder -> RIO (InnerEnv env) ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Text -> LogLevel -> Utf8Builder -> m ()
RIO.logGeneric Text
src LogLevel
level Utf8Builder
str
unwrap :: RIO (InnerEnv env) () -> RIO env ()
unwrap :: RIO (InnerEnv env) () -> RIO env ()
unwrap RIO (InnerEnv env) ()
action = do
env
env <- RIO env env
forall r (m :: * -> *). MonadReader r m => m r
ask
InnerEnv env -> RIO (InnerEnv env) () -> RIO env ()
forall (m :: * -> *) env a. MonadIO m => env -> RIO env a -> m a
runRIO (env -> InnerEnv env
forall env. env -> InnerEnv env
InnerEnv env
env) RIO (InnerEnv env) ()
action
newtype InnerEnv env = InnerEnv { InnerEnv env -> env
unInnerEnv :: env }
instance (HasConfig env Config) => HasLogFunc (InnerEnv env) where
logFuncL :: (LogFunc -> f LogFunc) -> InnerEnv env -> f (InnerEnv env)
logFuncL = (InnerEnv env -> LogFunc)
-> (InnerEnv env -> LogFunc -> InnerEnv env)
-> Lens' (InnerEnv env) LogFunc
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (Config -> LogFunc
logFunc (Config -> LogFunc)
-> (InnerEnv env -> Config) -> InnerEnv env -> LogFunc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. env -> Config
forall env config. HasConfig env config => env -> config
config (env -> Config) -> (InnerEnv env -> env) -> InnerEnv env -> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InnerEnv env -> env
forall env. InnerEnv env -> env
unInnerEnv) ((InnerEnv env -> LogFunc -> InnerEnv env)
-> Lens' (InnerEnv env) LogFunc)
-> (InnerEnv env -> LogFunc -> InnerEnv env)
-> Lens' (InnerEnv env) LogFunc
forall a b. (a -> b) -> a -> b
$
[Char] -> InnerEnv env -> LogFunc -> InnerEnv env
forall a. HasCallStack => [Char] -> a
error [Char]
"Setter for logFuncL is not defined"
data Config = Config
{ Config -> DeployMode
mode :: DeployMode
, Config -> Verbose
verbose :: Verbose
, Config -> LogOptions
logOptions :: LogOptions
, Config -> LogFunc
logFunc :: LogFunc
}
instance HasParser Config where
parser :: Parser Config
parser = do
DeployMode
mode <- Parser DeployMode
forall a. HasParser a => Parser a
parser
Verbose
verbose <- Parser Verbose
forall a. HasParser a => Parser a
parser
((Config -> IO ()) -> IO ()) -> Parser Config
forall a. ((a -> IO ()) -> IO ()) -> Parser a
liftWith (((Config -> IO ()) -> IO ()) -> Parser Config)
-> ((Config -> IO ()) -> IO ()) -> Parser Config
forall a b. (a -> b) -> a -> b
$ \Config -> IO ()
action -> do
LogOptions
options <- DeployMode -> Verbose -> IO LogOptions
forall (m :: * -> *).
MonadIO m =>
DeployMode -> Verbose -> m LogOptions
defaultLogOptions DeployMode
mode Verbose
verbose
LogOptions -> (LogFunc -> IO ()) -> IO ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
LogOptions -> (LogFunc -> m a) -> m a
withLogFunc LogOptions
options ((LogFunc -> IO ()) -> IO ()) -> (LogFunc -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \LogFunc
lf ->
Config -> IO ()
action (Config -> IO ()) -> Config -> IO ()
forall a b. (a -> b) -> a -> b
$ DeployMode -> Verbose -> LogOptions -> LogFunc -> Config
Config DeployMode
mode Verbose
verbose LogOptions
options LogFunc
lf
newtype Verbose = Verbose { Verbose -> Bool
unVerbose :: Bool }
deriving (Int -> Verbose -> ShowS
[Verbose] -> ShowS
Verbose -> [Char]
(Int -> Verbose -> ShowS)
-> (Verbose -> [Char]) -> ([Verbose] -> ShowS) -> Show Verbose
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Verbose] -> ShowS
$cshowList :: [Verbose] -> ShowS
show :: Verbose -> [Char]
$cshow :: Verbose -> [Char]
showsPrec :: Int -> Verbose -> ShowS
$cshowsPrec :: Int -> Verbose -> ShowS
Show, ReadPrec [Verbose]
ReadPrec Verbose
Int -> ReadS Verbose
ReadS [Verbose]
(Int -> ReadS Verbose)
-> ReadS [Verbose]
-> ReadPrec Verbose
-> ReadPrec [Verbose]
-> Read Verbose
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Verbose]
$creadListPrec :: ReadPrec [Verbose]
readPrec :: ReadPrec Verbose
$creadPrec :: ReadPrec Verbose
readList :: ReadS [Verbose]
$creadList :: ReadS [Verbose]
readsPrec :: Int -> ReadS Verbose
$creadsPrec :: Int -> ReadS Verbose
Read, Verbose -> Verbose -> Bool
(Verbose -> Verbose -> Bool)
-> (Verbose -> Verbose -> Bool) -> Eq Verbose
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Verbose -> Verbose -> Bool
$c/= :: Verbose -> Verbose -> Bool
== :: Verbose -> Verbose -> Bool
$c== :: Verbose -> Verbose -> Bool
Eq)
instance HasParser Verbose where
parser :: Parser Verbose
parser = Bool -> Verbose
Verbose (Bool -> Verbose) -> Parser Bool -> Parser Verbose
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Description -> Source -> Bool -> Parser Bool
forall a.
(Var a, Enum a, Bounded a) =>
Description -> Source -> a -> Parser a
optionalEnum
Description
"Make the operation more talkative"
([Char] -> Source
argLong [Char]
"verbose" Source -> Source -> Source
.|| [Char] -> Source
envVar [Char]
"VERBOSE")
Bool
False
data DeployMode
= Development
| Production
| Staging
| Test
deriving (DeployMode -> DeployMode -> Bool
(DeployMode -> DeployMode -> Bool)
-> (DeployMode -> DeployMode -> Bool) -> Eq DeployMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeployMode -> DeployMode -> Bool
$c/= :: DeployMode -> DeployMode -> Bool
== :: DeployMode -> DeployMode -> Bool
$c== :: DeployMode -> DeployMode -> Bool
Eq, (forall x. DeployMode -> Rep DeployMode x)
-> (forall x. Rep DeployMode x -> DeployMode) -> Generic DeployMode
forall x. Rep DeployMode x -> DeployMode
forall x. DeployMode -> Rep DeployMode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeployMode x -> DeployMode
$cfrom :: forall x. DeployMode -> Rep DeployMode x
Generic, Int -> DeployMode -> ShowS
[DeployMode] -> ShowS
DeployMode -> [Char]
(Int -> DeployMode -> ShowS)
-> (DeployMode -> [Char])
-> ([DeployMode] -> ShowS)
-> Show DeployMode
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [DeployMode] -> ShowS
$cshowList :: [DeployMode] -> ShowS
show :: DeployMode -> [Char]
$cshow :: DeployMode -> [Char]
showsPrec :: Int -> DeployMode -> ShowS
$cshowsPrec :: Int -> DeployMode -> ShowS
Show, ReadPrec [DeployMode]
ReadPrec DeployMode
Int -> ReadS DeployMode
ReadS [DeployMode]
(Int -> ReadS DeployMode)
-> ReadS [DeployMode]
-> ReadPrec DeployMode
-> ReadPrec [DeployMode]
-> Read DeployMode
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeployMode]
$creadListPrec :: ReadPrec [DeployMode]
readPrec :: ReadPrec DeployMode
$creadPrec :: ReadPrec DeployMode
readList :: ReadS [DeployMode]
$creadList :: ReadS [DeployMode]
readsPrec :: Int -> ReadS DeployMode
$creadsPrec :: Int -> ReadS DeployMode
Read, DeployMode
DeployMode -> DeployMode -> Bounded DeployMode
forall a. a -> a -> Bounded a
maxBound :: DeployMode
$cmaxBound :: DeployMode
minBound :: DeployMode
$cminBound :: DeployMode
Bounded, Int -> DeployMode
DeployMode -> Int
DeployMode -> [DeployMode]
DeployMode -> DeployMode
DeployMode -> DeployMode -> [DeployMode]
DeployMode -> DeployMode -> DeployMode -> [DeployMode]
(DeployMode -> DeployMode)
-> (DeployMode -> DeployMode)
-> (Int -> DeployMode)
-> (DeployMode -> Int)
-> (DeployMode -> [DeployMode])
-> (DeployMode -> DeployMode -> [DeployMode])
-> (DeployMode -> DeployMode -> [DeployMode])
-> (DeployMode -> DeployMode -> DeployMode -> [DeployMode])
-> Enum DeployMode
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 :: DeployMode -> DeployMode -> DeployMode -> [DeployMode]
$cenumFromThenTo :: DeployMode -> DeployMode -> DeployMode -> [DeployMode]
enumFromTo :: DeployMode -> DeployMode -> [DeployMode]
$cenumFromTo :: DeployMode -> DeployMode -> [DeployMode]
enumFromThen :: DeployMode -> DeployMode -> [DeployMode]
$cenumFromThen :: DeployMode -> DeployMode -> [DeployMode]
enumFrom :: DeployMode -> [DeployMode]
$cenumFrom :: DeployMode -> [DeployMode]
fromEnum :: DeployMode -> Int
$cfromEnum :: DeployMode -> Int
toEnum :: Int -> DeployMode
$ctoEnum :: Int -> DeployMode
pred :: DeployMode -> DeployMode
$cpred :: DeployMode -> DeployMode
succ :: DeployMode -> DeployMode
$csucc :: DeployMode -> DeployMode
Enum)
instance Var DeployMode where
toVar :: DeployMode -> [Char]
toVar = DeployMode -> [Char]
forall a. Show a => a -> [Char]
show
fromVar :: [Char] -> Maybe DeployMode
fromVar = [Char] -> Maybe DeployMode
forall a. Read a => [Char] -> Maybe a
readMaybe
instance HasParser DeployMode where
parser :: Parser DeployMode
parser =
Description -> Source -> DeployMode -> Parser DeployMode
forall a.
(Var a, Enum a, Bounded a) =>
Description -> Source -> a -> Parser a
optionalEnum
Description
"Application deployment mode to run"
([Char] -> Source
argLong [Char]
"env" Source -> Source -> Source
.|| [Char] -> Source
envVar [Char]
"ENV")
DeployMode
Development
defaultLogOptions :: (MonadIO m) => DeployMode -> Verbose -> m LogOptions
defaultLogOptions :: DeployMode -> Verbose -> m LogOptions
defaultLogOptions DeployMode
env Verbose
verbose = do
Handle -> Bool -> m LogOptions
forall (m :: * -> *). MonadIO m => Handle -> Bool -> m LogOptions
logOptionsHandle Handle
stderr (Bool -> m LogOptions) -> Bool -> m LogOptions
forall a b. (a -> b) -> a -> b
$ DeployMode -> Verbose -> Bool
defaultVerbosity DeployMode
env Verbose
verbose
defaultVerbosity :: DeployMode -> Verbose -> Bool
defaultVerbosity :: DeployMode -> Verbose -> Bool
defaultVerbosity DeployMode
env (Verbose Bool
v) =
case (Bool
v, DeployMode
env) of
(Bool
False, DeployMode
Development) -> Bool
True
(Bool, DeployMode)
_ -> Bool
v