{-# 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 GHC.Generics (Generic)
import Tonatona (HasConfig(..), HasParser(..))
import TonaParser
( Var(..)
, (.||)
, argLong
, envVar
, liftWith
, optionalEnum
)
logDebug :: (HasConfig env Config) => Utf8Builder -> RIO env ()
logDebug = unwrap . RIO.logDebug
logInfo :: (HasConfig env Config) => Utf8Builder -> RIO env ()
logInfo = unwrap . RIO.logInfo
logWarn :: (HasConfig env Config) => Utf8Builder -> RIO env ()
logWarn = unwrap . RIO.logWarn
logError :: (HasConfig env Config) => Utf8Builder -> RIO env ()
logError = unwrap . RIO.logError
logOther :: (HasConfig env Config)
=> Text
-> Utf8Builder -> RIO env ()
logOther level = unwrap . RIO.logOther level
logDebugS
:: (HasConfig env Config)
=> LogSource
-> Utf8Builder
-> RIO env ()
logDebugS src = unwrap . RIO.logDebugS src
logInfoS
:: (HasConfig env Config)
=> LogSource
-> Utf8Builder
-> RIO env ()
logInfoS src = unwrap . RIO.logInfoS src
logWarnS
:: (HasConfig env Config)
=> LogSource
-> Utf8Builder
-> RIO env ()
logWarnS src = unwrap . RIO.logWarnS src
logErrorS
:: (HasConfig env Config)
=> LogSource
-> Utf8Builder
-> RIO env ()
logErrorS src = unwrap . RIO.logErrorS src
logOtherS
:: (HasConfig env Config)
=> Text
-> LogSource
-> Utf8Builder
-> RIO env ()
logOtherS level src = unwrap . RIO.logOtherS level src
logSticky :: (HasConfig env Config) => Utf8Builder -> RIO env ()
logSticky = unwrap . RIO.logSticky
logStickyDone :: (HasConfig env Config) => Utf8Builder -> RIO env ()
logStickyDone = unwrap . RIO.logStickyDone
logGeneric ::
(HasConfig env Config)
=> LogSource
-> LogLevel
-> Utf8Builder
-> RIO env ()
logGeneric src level str = unwrap $ RIO.logGeneric src level str
unwrap :: RIO (InnerEnv env) () -> RIO env ()
unwrap action = do
env <- ask
runRIO (InnerEnv env) action
newtype InnerEnv env = InnerEnv { unInnerEnv :: env }
instance (HasConfig env Config) => HasLogFunc (InnerEnv env) where
logFuncL = lens (logFunc . config . unInnerEnv) $
error "Setter for logFuncL is not defined"
data Config = Config
{ mode :: DeployMode
, verbose :: Verbose
, logOptions :: LogOptions
, logFunc :: LogFunc
}
instance HasParser Config where
parser = do
mode <- parser
verbose <- parser
liftWith $ \action -> do
options <- defaultLogOptions mode verbose
withLogFunc options $ \lf ->
action $ Config mode verbose options lf
newtype Verbose = Verbose { unVerbose :: Bool }
deriving (Show, Read, Eq)
instance HasParser Verbose where
parser = Verbose <$>
optionalEnum
"Make the operation more talkative"
(argLong "verbose" .|| envVar "VERBOSE")
False
data DeployMode
= Development
| Production
| Staging
| Test
deriving (Eq, Generic, Show, Read, Bounded, Enum)
instance Var DeployMode where
toVar = show
fromVar = readMaybe
instance HasParser DeployMode where
parser =
optionalEnum
"Application deployment mode to run"
(argLong "env" .|| envVar "ENV")
Development
defaultLogOptions :: (MonadIO m) => DeployMode -> Verbose -> m LogOptions
defaultLogOptions env verbose = do
logOptionsHandle stderr $ defaultVerbosity env verbose
defaultVerbosity :: DeployMode -> Verbose -> Bool
defaultVerbosity env (Verbose v) =
case (v, env) of
(False, Development) -> True
_ -> v