{-# 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 :: forall env. HasConfig env Config => Utf8Builder -> RIO env ()
logDebug = forall env. RIO (InnerEnv env) () -> RIO env ()
unwrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
RIO.logDebug
logInfo :: (HasConfig env Config) => Utf8Builder -> RIO env ()
logInfo :: forall env. HasConfig env Config => Utf8Builder -> RIO env ()
logInfo = forall env. RIO (InnerEnv env) () -> RIO env ()
unwrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
RIO.logInfo
logWarn :: (HasConfig env Config) => Utf8Builder -> RIO env ()
logWarn :: forall env. HasConfig env Config => Utf8Builder -> RIO env ()
logWarn = forall env. RIO (InnerEnv env) () -> RIO env ()
unwrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
RIO.logWarn
logError :: (HasConfig env Config) => Utf8Builder -> RIO env ()
logError :: forall env. HasConfig env Config => Utf8Builder -> RIO env ()
logError = forall env. RIO (InnerEnv env) () -> RIO env ()
unwrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
RIO.logError
logOther :: (HasConfig env Config)
=> Text
-> Utf8Builder -> RIO env ()
logOther :: forall env.
HasConfig env Config =>
Text -> Utf8Builder -> RIO env ()
logOther Text
level = forall env. RIO (InnerEnv env) () -> RIO env ()
unwrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall env.
HasConfig env Config =>
Text -> Utf8Builder -> RIO env ()
logDebugS Text
src = forall env. RIO (InnerEnv env) () -> RIO env ()
unwrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall env.
HasConfig env Config =>
Text -> Utf8Builder -> RIO env ()
logInfoS Text
src = forall env. RIO (InnerEnv env) () -> RIO env ()
unwrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall env.
HasConfig env Config =>
Text -> Utf8Builder -> RIO env ()
logWarnS Text
src = forall env. RIO (InnerEnv env) () -> RIO env ()
unwrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall env.
HasConfig env Config =>
Text -> Utf8Builder -> RIO env ()
logErrorS Text
src = forall env. RIO (InnerEnv env) () -> RIO env ()
unwrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall env.
HasConfig env Config =>
Text -> Text -> Utf8Builder -> RIO env ()
logOtherS Text
level Text
src = forall env. RIO (InnerEnv env) () -> RIO env ()
unwrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall env. HasConfig env Config => Utf8Builder -> RIO env ()
logSticky = forall env. RIO (InnerEnv env) () -> RIO env ()
unwrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) env.
(MonadIO m, HasCallStack, MonadReader env m, HasLogFunc env) =>
Utf8Builder -> m ()
RIO.logSticky
logStickyDone :: (HasConfig env Config) => Utf8Builder -> RIO env ()
logStickyDone :: forall env. HasConfig env Config => Utf8Builder -> RIO env ()
logStickyDone = forall env. RIO (InnerEnv env) () -> RIO env ()
unwrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall env.
HasConfig env Config =>
Text -> LogLevel -> Utf8Builder -> RIO env ()
logGeneric Text
src LogLevel
level Utf8Builder
str = forall env. RIO (InnerEnv env) () -> RIO env ()
unwrap forall a b. (a -> b) -> a -> b
$ 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 :: forall env. RIO (InnerEnv env) () -> RIO env ()
unwrap RIO (InnerEnv env) ()
action = do
env
env <- forall r (m :: * -> *). MonadReader r m => m r
ask
forall (m :: * -> *) env a. MonadIO m => env -> RIO env a -> m a
runRIO (forall env. env -> InnerEnv env
InnerEnv env
env) RIO (InnerEnv env) ()
action
newtype InnerEnv env = InnerEnv { forall env. InnerEnv env -> env
unInnerEnv :: env }
instance (HasConfig env Config) => HasLogFunc (InnerEnv env) where
logFuncL :: Lens' (InnerEnv env) LogFunc
logFuncL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (Config -> LogFunc
logFunc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall env config. HasConfig env config => env -> config
config forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall env. InnerEnv env -> env
unInnerEnv) forall a b. (a -> b) -> a -> b
$
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 <- forall a. HasParser a => Parser a
parser
Verbose
verbose <- forall a. HasParser a => Parser a
parser
forall a. ((a -> IO ()) -> IO ()) -> Parser a
liftWith forall a b. (a -> b) -> a -> b
$ \Config -> IO ()
action -> do
LogOptions
options <- forall (m :: * -> *).
MonadIO m =>
DeployMode -> Verbose -> m LogOptions
defaultLogOptions DeployMode
mode Verbose
verbose
forall (m :: * -> *) a.
MonadUnliftIO m =>
LogOptions -> (LogFunc -> m a) -> m a
withLogFunc LogOptions
options forall a b. (a -> b) -> a -> b
$ \LogFunc
lf ->
Config -> IO ()
action 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]
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]
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
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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
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
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. 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]
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]
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
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]
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 = forall a. Show a => a -> [Char]
show
fromVar :: [Char] -> Maybe DeployMode
fromVar = forall a. Read a => [Char] -> Maybe a
readMaybe
instance HasParser DeployMode where
parser :: Parser DeployMode
parser =
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 :: forall (m :: * -> *).
MonadIO m =>
DeployMode -> Verbose -> m LogOptions
defaultLogOptions DeployMode
env Verbose
verbose = do
forall (m :: * -> *). MonadIO m => Handle -> Bool -> m LogOptions
logOptionsHandle Handle
stderr 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