{-# LANGUAGE CPP #-}
module Log.Monad (
Logger
, LoggerEnv(..)
, InnerLogT
, LogT(..)
, runLogT
, mapLogT
, logMessageIO
, getLoggerIO
) where
import Control.Applicative
import Control.DeepSeq
import Control.Monad.Base
import Control.Monad.Catch
import Control.Monad.Error.Class
import Control.Monad.Fail (MonadFail)
import Control.Monad.IO.Unlift
import Control.Monad.Morph (MFunctor (..))
import Control.Monad.Reader
import Control.Monad.State.Class
import Control.Monad.Trans.Control
import Control.Monad.Writer.Class
import Data.Aeson
import Data.Text (Text)
import Prelude
import qualified Control.Exception as E
import qualified Data.HashMap.Strict as H
import Log.Class
import Log.Data
import Log.Logger
type InnerLogT = ReaderT LoggerEnv
newtype LogT m a = LogT { LogT m a -> InnerLogT m a
unLogT :: InnerLogT m a }
deriving (Applicative (LogT m)
LogT m a
Applicative (LogT m)
-> (forall a. LogT m a)
-> (forall a. LogT m a -> LogT m a -> LogT m a)
-> (forall a. LogT m a -> LogT m [a])
-> (forall a. LogT m a -> LogT m [a])
-> Alternative (LogT m)
LogT m a -> LogT m a -> LogT m a
LogT m a -> LogT m [a]
LogT m a -> LogT m [a]
forall a. LogT m a
forall a. LogT m a -> LogT m [a]
forall a. LogT m a -> LogT m a -> LogT m a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
forall (m :: * -> *). Alternative m => Applicative (LogT m)
forall (m :: * -> *) a. Alternative m => LogT m a
forall (m :: * -> *) a. Alternative m => LogT m a -> LogT m [a]
forall (m :: * -> *) a.
Alternative m =>
LogT m a -> LogT m a -> LogT m a
many :: LogT m a -> LogT m [a]
$cmany :: forall (m :: * -> *) a. Alternative m => LogT m a -> LogT m [a]
some :: LogT m a -> LogT m [a]
$csome :: forall (m :: * -> *) a. Alternative m => LogT m a -> LogT m [a]
<|> :: LogT m a -> LogT m a -> LogT m a
$c<|> :: forall (m :: * -> *) a.
Alternative m =>
LogT m a -> LogT m a -> LogT m a
empty :: LogT m a
$cempty :: forall (m :: * -> *) a. Alternative m => LogT m a
$cp1Alternative :: forall (m :: * -> *). Alternative m => Applicative (LogT m)
Alternative, Functor (LogT m)
a -> LogT m a
Functor (LogT m)
-> (forall a. a -> LogT m a)
-> (forall a b. LogT m (a -> b) -> LogT m a -> LogT m b)
-> (forall a b c.
(a -> b -> c) -> LogT m a -> LogT m b -> LogT m c)
-> (forall a b. LogT m a -> LogT m b -> LogT m b)
-> (forall a b. LogT m a -> LogT m b -> LogT m a)
-> Applicative (LogT m)
LogT m a -> LogT m b -> LogT m b
LogT m a -> LogT m b -> LogT m a
LogT m (a -> b) -> LogT m a -> LogT m b
(a -> b -> c) -> LogT m a -> LogT m b -> LogT m c
forall a. a -> LogT m a
forall a b. LogT m a -> LogT m b -> LogT m a
forall a b. LogT m a -> LogT m b -> LogT m b
forall a b. LogT m (a -> b) -> LogT m a -> LogT m b
forall a b c. (a -> b -> c) -> LogT m a -> LogT m b -> LogT m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (m :: * -> *). Applicative m => Functor (LogT m)
forall (m :: * -> *) a. Applicative m => a -> LogT m a
forall (m :: * -> *) a b.
Applicative m =>
LogT m a -> LogT m b -> LogT m a
forall (m :: * -> *) a b.
Applicative m =>
LogT m a -> LogT m b -> LogT m b
forall (m :: * -> *) a b.
Applicative m =>
LogT m (a -> b) -> LogT m a -> LogT m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> LogT m a -> LogT m b -> LogT m c
<* :: LogT m a -> LogT m b -> LogT m a
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
LogT m a -> LogT m b -> LogT m a
*> :: LogT m a -> LogT m b -> LogT m b
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
LogT m a -> LogT m b -> LogT m b
liftA2 :: (a -> b -> c) -> LogT m a -> LogT m b -> LogT m c
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> LogT m a -> LogT m b -> LogT m c
<*> :: LogT m (a -> b) -> LogT m a -> LogT m b
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
LogT m (a -> b) -> LogT m a -> LogT m b
pure :: a -> LogT m a
$cpure :: forall (m :: * -> *) a. Applicative m => a -> LogT m a
$cp1Applicative :: forall (m :: * -> *). Applicative m => Functor (LogT m)
Applicative, a -> LogT m b -> LogT m a
(a -> b) -> LogT m a -> LogT m b
(forall a b. (a -> b) -> LogT m a -> LogT m b)
-> (forall a b. a -> LogT m b -> LogT m a) -> Functor (LogT m)
forall a b. a -> LogT m b -> LogT m a
forall a b. (a -> b) -> LogT m a -> LogT m b
forall (m :: * -> *) a b. Functor m => a -> LogT m b -> LogT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> LogT m a -> LogT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> LogT m b -> LogT m a
$c<$ :: forall (m :: * -> *) a b. Functor m => a -> LogT m b -> LogT m a
fmap :: (a -> b) -> LogT m a -> LogT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> LogT m a -> LogT m b
Functor, Applicative (LogT m)
a -> LogT m a
Applicative (LogT m)
-> (forall a b. LogT m a -> (a -> LogT m b) -> LogT m b)
-> (forall a b. LogT m a -> LogT m b -> LogT m b)
-> (forall a. a -> LogT m a)
-> Monad (LogT m)
LogT m a -> (a -> LogT m b) -> LogT m b
LogT m a -> LogT m b -> LogT m b
forall a. a -> LogT m a
forall a b. LogT m a -> LogT m b -> LogT m b
forall a b. LogT m a -> (a -> LogT m b) -> LogT m b
forall (m :: * -> *). Monad m => Applicative (LogT m)
forall (m :: * -> *) a. Monad m => a -> LogT m a
forall (m :: * -> *) a b.
Monad m =>
LogT m a -> LogT m b -> LogT m b
forall (m :: * -> *) a b.
Monad m =>
LogT m a -> (a -> LogT m b) -> LogT m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> LogT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> LogT m a
>> :: LogT m a -> LogT m b -> LogT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
LogT m a -> LogT m b -> LogT m b
>>= :: LogT m a -> (a -> LogT m b) -> LogT m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
LogT m a -> (a -> LogT m b) -> LogT m b
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (LogT m)
Monad, MonadBase b, MonadThrow (LogT m)
MonadThrow (LogT m)
-> (forall e a.
Exception e =>
LogT m a -> (e -> LogT m a) -> LogT m a)
-> MonadCatch (LogT m)
LogT m a -> (e -> LogT m a) -> LogT m a
forall e a. Exception e => LogT m a -> (e -> LogT m a) -> LogT m a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
forall (m :: * -> *). MonadCatch m => MonadThrow (LogT m)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
LogT m a -> (e -> LogT m a) -> LogT m a
catch :: LogT m a -> (e -> LogT m a) -> LogT m a
$ccatch :: forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
LogT m a -> (e -> LogT m a) -> LogT m a
$cp1MonadCatch :: forall (m :: * -> *). MonadCatch m => MonadThrow (LogT m)
MonadCatch
,Monad (LogT m)
Monad (LogT m) -> (forall a. IO a -> LogT m a) -> MonadIO (LogT m)
IO a -> LogT m a
forall a. IO a -> LogT m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall (m :: * -> *). MonadIO m => Monad (LogT m)
forall (m :: * -> *) a. MonadIO m => IO a -> LogT m a
liftIO :: IO a -> LogT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> LogT m a
$cp1MonadIO :: forall (m :: * -> *). MonadIO m => Monad (LogT m)
MonadIO, MonadCatch (LogT m)
MonadCatch (LogT m)
-> (forall b.
((forall a. LogT m a -> LogT m a) -> LogT m b) -> LogT m b)
-> (forall b.
((forall a. LogT m a -> LogT m a) -> LogT m b) -> LogT m b)
-> (forall a b c.
LogT m a
-> (a -> ExitCase b -> LogT m c)
-> (a -> LogT m b)
-> LogT m (b, c))
-> MonadMask (LogT m)
LogT m a
-> (a -> ExitCase b -> LogT m c)
-> (a -> LogT m b)
-> LogT m (b, c)
((forall a. LogT m a -> LogT m a) -> LogT m b) -> LogT m b
((forall a. LogT m a -> LogT m a) -> LogT m b) -> LogT m b
forall b.
((forall a. LogT m a -> LogT m a) -> LogT m b) -> LogT m b
forall a b c.
LogT m a
-> (a -> ExitCase b -> LogT m c)
-> (a -> LogT m b)
-> LogT m (b, c)
forall (m :: * -> *).
MonadCatch m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
forall (m :: * -> *). MonadMask m => MonadCatch (LogT m)
forall (m :: * -> *) b.
MonadMask m =>
((forall a. LogT m a -> LogT m a) -> LogT m b) -> LogT m b
forall (m :: * -> *) a b c.
MonadMask m =>
LogT m a
-> (a -> ExitCase b -> LogT m c)
-> (a -> LogT m b)
-> LogT m (b, c)
generalBracket :: LogT m a
-> (a -> ExitCase b -> LogT m c)
-> (a -> LogT m b)
-> LogT m (b, c)
$cgeneralBracket :: forall (m :: * -> *) a b c.
MonadMask m =>
LogT m a
-> (a -> ExitCase b -> LogT m c)
-> (a -> LogT m b)
-> LogT m (b, c)
uninterruptibleMask :: ((forall a. LogT m a -> LogT m a) -> LogT m b) -> LogT m b
$cuninterruptibleMask :: forall (m :: * -> *) b.
MonadMask m =>
((forall a. LogT m a -> LogT m a) -> LogT m b) -> LogT m b
mask :: ((forall a. LogT m a -> LogT m a) -> LogT m b) -> LogT m b
$cmask :: forall (m :: * -> *) b.
MonadMask m =>
((forall a. LogT m a -> LogT m a) -> LogT m b) -> LogT m b
$cp1MonadMask :: forall (m :: * -> *). MonadMask m => MonadCatch (LogT m)
MonadMask, Monad (LogT m)
Alternative (LogT m)
LogT m a
Alternative (LogT m)
-> Monad (LogT m)
-> (forall a. LogT m a)
-> (forall a. LogT m a -> LogT m a -> LogT m a)
-> MonadPlus (LogT m)
LogT m a -> LogT m a -> LogT m a
forall a. LogT m a
forall a. LogT m a -> LogT m a -> LogT m a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
forall (m :: * -> *). MonadPlus m => Monad (LogT m)
forall (m :: * -> *). MonadPlus m => Alternative (LogT m)
forall (m :: * -> *) a. MonadPlus m => LogT m a
forall (m :: * -> *) a.
MonadPlus m =>
LogT m a -> LogT m a -> LogT m a
mplus :: LogT m a -> LogT m a -> LogT m a
$cmplus :: forall (m :: * -> *) a.
MonadPlus m =>
LogT m a -> LogT m a -> LogT m a
mzero :: LogT m a
$cmzero :: forall (m :: * -> *) a. MonadPlus m => LogT m a
$cp2MonadPlus :: forall (m :: * -> *). MonadPlus m => Monad (LogT m)
$cp1MonadPlus :: forall (m :: * -> *). MonadPlus m => Alternative (LogT m)
MonadPlus, Monad (LogT m)
e -> LogT m a
Monad (LogT m)
-> (forall e a. Exception e => e -> LogT m a)
-> MonadThrow (LogT m)
forall e a. Exception e => e -> LogT m a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
forall (m :: * -> *). MonadThrow m => Monad (LogT m)
forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> LogT m a
throwM :: e -> LogT m a
$cthrowM :: forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> LogT m a
$cp1MonadThrow :: forall (m :: * -> *). MonadThrow m => Monad (LogT m)
MonadThrow, m a -> LogT m a
(forall (m :: * -> *) a. Monad m => m a -> LogT m a)
-> MonadTrans LogT
forall (m :: * -> *) a. Monad m => m a -> LogT m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> LogT m a
$clift :: forall (m :: * -> *) a. Monad m => m a -> LogT m a
MonadTrans, Monad (LogT m)
Monad (LogT m)
-> (forall a. String -> LogT m a) -> MonadFail (LogT m)
String -> LogT m a
forall a. String -> LogT m a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
forall (m :: * -> *). MonadFail m => Monad (LogT m)
forall (m :: * -> *) a. MonadFail m => String -> LogT m a
fail :: String -> LogT m a
$cfail :: forall (m :: * -> *) a. MonadFail m => String -> LogT m a
$cp1MonadFail :: forall (m :: * -> *). MonadFail m => Monad (LogT m)
MonadFail
,MonadError e, MonadWriter w, MonadState s)
instance MonadReader r m => MonadReader r (LogT m) where
ask :: LogT m r
ask = m r -> LogT m r
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m r
forall r (m :: * -> *). MonadReader r m => m r
ask
local :: (r -> r) -> LogT m a -> LogT m a
local = (m a -> m a) -> LogT m a -> LogT m a
forall (m :: * -> *) a (n :: * -> *) b.
(m a -> n b) -> LogT m a -> LogT n b
mapLogT ((m a -> m a) -> LogT m a -> LogT m a)
-> ((r -> r) -> m a -> m a) -> (r -> r) -> LogT m a -> LogT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (r -> r) -> m a -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local
runLogT :: Text
-> Logger
-> LogT m a
-> m a
runLogT :: Text -> Logger -> LogT m a -> m a
runLogT Text
component Logger
logger LogT m a
m = ReaderT LoggerEnv m a -> LoggerEnv -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (LogT m a -> ReaderT LoggerEnv m a
forall (m :: * -> *) a. LogT m a -> InnerLogT m a
unLogT LogT m a
m) LoggerEnv :: Logger -> Text -> [Text] -> [Pair] -> LoggerEnv
LoggerEnv {
leLogger :: Logger
leLogger = Logger
logger
, leComponent :: Text
leComponent = Text
component
, leDomain :: [Text]
leDomain = []
, leData :: [Pair]
leData = []
}
mapLogT :: (m a -> n b) -> LogT m a -> LogT n b
mapLogT :: (m a -> n b) -> LogT m a -> LogT n b
mapLogT m a -> n b
f = InnerLogT n b -> LogT n b
forall (m :: * -> *) a. InnerLogT m a -> LogT m a
LogT (InnerLogT n b -> LogT n b)
-> (LogT m a -> InnerLogT n b) -> LogT m a -> LogT n b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (m a -> n b) -> ReaderT LoggerEnv m a -> InnerLogT n b
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT m a -> n b
f (ReaderT LoggerEnv m a -> InnerLogT n b)
-> (LogT m a -> ReaderT LoggerEnv m a) -> LogT m a -> InnerLogT n b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogT m a -> ReaderT LoggerEnv m a
forall (m :: * -> *) a. LogT m a -> InnerLogT m a
unLogT
logMessageIO :: LoggerEnv -> UTCTime -> LogLevel -> Text -> Value -> IO ()
logMessageIO :: LoggerEnv -> UTCTime -> LogLevel -> Text -> Value -> IO ()
logMessageIO LoggerEnv{[Pair]
[Text]
Text
Logger
leData :: [Pair]
leDomain :: [Text]
leComponent :: Text
leLogger :: Logger
leData :: LoggerEnv -> [Pair]
leDomain :: LoggerEnv -> [Text]
leComponent :: LoggerEnv -> Text
leLogger :: LoggerEnv -> Logger
..} UTCTime
time LogLevel
level Text
message Value
data_ =
Logger -> LogMessage -> IO ()
execLogger Logger
leLogger (LogMessage -> IO ()) -> IO LogMessage -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LogMessage -> IO LogMessage
forall a. a -> IO a
E.evaluate (LogMessage -> LogMessage
forall a. NFData a => a -> a
force LogMessage
lm)
where
lm :: LogMessage
lm = LogMessage :: Text
-> [Text] -> UTCTime -> LogLevel -> Text -> Value -> LogMessage
LogMessage
{ lmComponent :: Text
lmComponent = Text
leComponent
, lmDomain :: [Text]
lmDomain = [Text]
leDomain
, lmTime :: UTCTime
lmTime = UTCTime
time
, lmLevel :: LogLevel
lmLevel = LogLevel
level
, lmMessage :: Text
lmMessage = Text
message
, lmData :: Value
lmData = case Value
data_ of
Object Object
obj -> Object -> Value
Object (Object -> Value) -> (Object -> Object) -> Object -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> Object -> Object
forall k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
H.union Object
obj (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> Object
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
H.fromList [Pair]
leData
Value
_ | [Pair] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Pair]
leData -> [Pair] -> Value
object [Value -> Text
dataTyped Value
data_ Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Value
data_]
| Bool
otherwise -> [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ (Value -> Text
dataTyped Value
data_, Value
data_) Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
leData
}
dataTyped :: Value -> Text
dataTyped = \case
Object{} -> Text
"__data_object"
Array{} -> Text
"__data_array"
String{} -> Text
"__data_string"
Number{} -> Text
"__data_number"
Bool{} -> Text
"__data_bool"
Null{} -> Text
"__data_null"
getLoggerIO :: MonadLog m => m (UTCTime -> LogLevel -> Text -> Value -> IO ())
getLoggerIO :: m (UTCTime -> LogLevel -> Text -> Value -> IO ())
getLoggerIO = LoggerEnv -> UTCTime -> LogLevel -> Text -> Value -> IO ()
logMessageIO (LoggerEnv -> UTCTime -> LogLevel -> Text -> Value -> IO ())
-> m LoggerEnv -> m (UTCTime -> LogLevel -> Text -> Value -> IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m LoggerEnv
forall (m :: * -> *). MonadLog m => m LoggerEnv
getLoggerEnv
instance MFunctor LogT where
hoist :: (forall a. m a -> n a) -> LogT m b -> LogT n b
hoist = (forall a. m a -> n a) -> LogT m b -> LogT n b
forall (m :: * -> *) a (n :: * -> *) b.
(m a -> n b) -> LogT m a -> LogT n b
mapLogT
instance MonadTransControl LogT where
#if MIN_VERSION_monad_control(1,0,0)
type StT LogT m = StT InnerLogT m
liftWith :: (Run LogT -> m a) -> LogT m a
liftWith = (forall b. ReaderT LoggerEnv m b -> LogT m b)
-> (forall (m :: * -> *) a. LogT m a -> InnerLogT m a)
-> (RunDefault LogT (ReaderT LoggerEnv) -> m a)
-> LogT m a
forall (m :: * -> *) (n :: (* -> *) -> * -> *)
(t :: (* -> *) -> * -> *) a.
(Monad m, MonadTransControl n) =>
(forall b. n m b -> t m b)
-> (forall (o :: * -> *) b. t o b -> n o b)
-> (RunDefault t n -> m a)
-> t m a
defaultLiftWith forall b. ReaderT LoggerEnv m b -> LogT m b
forall (m :: * -> *) a. InnerLogT m a -> LogT m a
LogT forall (m :: * -> *) a. LogT m a -> InnerLogT m a
unLogT
restoreT :: m (StT LogT a) -> LogT m a
restoreT = (ReaderT LoggerEnv m a -> LogT m a)
-> m (StT (ReaderT LoggerEnv) a) -> LogT m a
forall (m :: * -> *) (n :: (* -> *) -> * -> *) a
(t :: (* -> *) -> * -> *).
(Monad m, MonadTransControl n) =>
(n m a -> t m a) -> m (StT n a) -> t m a
defaultRestoreT ReaderT LoggerEnv m a -> LogT m a
forall (m :: * -> *) a. InnerLogT m a -> LogT m a
LogT
#else
newtype StT LogT m = StLogT { unStLogT :: StT InnerLogT m }
liftWith = defaultLiftWith LogT unLogT StLogT
restoreT = defaultRestoreT LogT unStLogT
#endif
{-# INLINE liftWith #-}
{-# INLINE restoreT #-}
instance MonadBaseControl b m => MonadBaseControl b (LogT m) where
#if MIN_VERSION_monad_control(1,0,0)
type StM (LogT m) a = ComposeSt LogT m a
liftBaseWith :: (RunInBase (LogT m) b -> b a) -> LogT m a
liftBaseWith = (RunInBase (LogT m) b -> b a) -> LogT m a
forall (t :: (* -> *) -> * -> *) (b :: * -> *) (m :: * -> *) a.
(MonadTransControl t, MonadBaseControl b m) =>
(RunInBaseDefault t m b -> b a) -> t m a
defaultLiftBaseWith
restoreM :: StM (LogT m) a -> LogT m a
restoreM = StM (LogT m) a -> LogT m a
forall (t :: (* -> *) -> * -> *) (b :: * -> *) (m :: * -> *) a.
(MonadTransControl t, MonadBaseControl b m) =>
ComposeSt t m a -> t m a
defaultRestoreM
#else
newtype StM (LogT m) a = StMLogT { unStMLogT :: ComposeSt LogT m a }
liftBaseWith = defaultLiftBaseWith StMLogT
restoreM = defaultRestoreM unStMLogT
#endif
{-# INLINE liftBaseWith #-}
{-# INLINE restoreM #-}
instance MonadUnliftIO m => MonadUnliftIO (LogT m) where
withRunInIO :: ((forall a. LogT m a -> IO a) -> IO b) -> LogT m b
withRunInIO (forall a. LogT m a -> IO a) -> IO b
inner = InnerLogT m b -> LogT m b
forall (m :: * -> *) a. InnerLogT m a -> LogT m a
LogT (InnerLogT m b -> LogT m b) -> InnerLogT m b -> LogT m b
forall a b. (a -> b) -> a -> b
$ ((forall a. ReaderT LoggerEnv m a -> IO a) -> IO b)
-> InnerLogT m b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. ReaderT LoggerEnv m a -> IO a) -> IO b)
-> InnerLogT m b)
-> ((forall a. ReaderT LoggerEnv m a -> IO a) -> IO b)
-> InnerLogT m b
forall a b. (a -> b) -> a -> b
$ \forall a. ReaderT LoggerEnv m a -> IO a
run -> (forall a. LogT m a -> IO a) -> IO b
inner (ReaderT LoggerEnv m a -> IO a
forall a. ReaderT LoggerEnv m a -> IO a
run (ReaderT LoggerEnv m a -> IO a)
-> (LogT m a -> ReaderT LoggerEnv m a) -> LogT m a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogT m a -> ReaderT LoggerEnv m a
forall (m :: * -> *) a. LogT m a -> InnerLogT m a
unLogT)
{-# INLINE withRunInIO #-}
instance (MonadBase IO m, MonadTime m) => MonadLog (LogT m) where
logMessage :: UTCTime -> LogLevel -> Text -> Value -> LogT m ()
logMessage UTCTime
time LogLevel
level Text
message Value
data_ = InnerLogT m () -> LogT m ()
forall (m :: * -> *) a. InnerLogT m a -> LogT m a
LogT (InnerLogT m () -> LogT m ())
-> ((LoggerEnv -> m ()) -> InnerLogT m ())
-> (LoggerEnv -> m ())
-> LogT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LoggerEnv -> m ()) -> InnerLogT m ()
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((LoggerEnv -> m ()) -> LogT m ())
-> (LoggerEnv -> m ()) -> LogT m ()
forall a b. (a -> b) -> a -> b
$ \LoggerEnv
logEnv ->
IO () -> m ()
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ LoggerEnv -> UTCTime -> LogLevel -> Text -> Value -> IO ()
logMessageIO LoggerEnv
logEnv UTCTime
time LogLevel
level Text
message Value
data_
localData :: [Pair] -> LogT m a -> LogT m a
localData [Pair]
data_ =
InnerLogT m a -> LogT m a
forall (m :: * -> *) a. InnerLogT m a -> LogT m a
LogT (InnerLogT m a -> LogT m a)
-> (LogT m a -> InnerLogT m a) -> LogT m a -> LogT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LoggerEnv -> LoggerEnv) -> InnerLogT m a -> InnerLogT m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\LoggerEnv
e -> LoggerEnv
e { leData :: [Pair]
leData = [Pair]
data_ [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ LoggerEnv -> [Pair]
leData LoggerEnv
e }) (InnerLogT m a -> InnerLogT m a)
-> (LogT m a -> InnerLogT m a) -> LogT m a -> InnerLogT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogT m a -> InnerLogT m a
forall (m :: * -> *) a. LogT m a -> InnerLogT m a
unLogT
localDomain :: Text -> LogT m a -> LogT m a
localDomain Text
domain =
InnerLogT m a -> LogT m a
forall (m :: * -> *) a. InnerLogT m a -> LogT m a
LogT (InnerLogT m a -> LogT m a)
-> (LogT m a -> InnerLogT m a) -> LogT m a -> LogT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LoggerEnv -> LoggerEnv) -> InnerLogT m a -> InnerLogT m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\LoggerEnv
e -> LoggerEnv
e { leDomain :: [Text]
leDomain = LoggerEnv -> [Text]
leDomain LoggerEnv
e [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
domain] }) (InnerLogT m a -> InnerLogT m a)
-> (LogT m a -> InnerLogT m a) -> LogT m a -> InnerLogT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogT m a -> InnerLogT m a
forall (m :: * -> *) a. LogT m a -> InnerLogT m a
unLogT
getLoggerEnv :: LogT m LoggerEnv
getLoggerEnv = InnerLogT m LoggerEnv -> LogT m LoggerEnv
forall (m :: * -> *) a. InnerLogT m a -> LogT m a
LogT InnerLogT m LoggerEnv
forall r (m :: * -> *). MonadReader r m => m r
ask