{-# LANGUAGE OverloadedStrings, TypeSynonymInstances, FlexibleInstances, ExistentialQuantification, TypeFamilies, GeneralizedNewtypeDeriving, StandaloneDeriving, MultiParamTypeClasses, UndecidableInstances, AllowAmbiguousTypes, ScopedTypeVariables, FunctionalDependencies, FlexibleContexts, ConstraintKinds #-}
-- | This module contains default implementation of @HasLogBackend@,
-- @HasLogContext@, @HasLogger@ instances, based on @ReaderT@ - @LoggingT@
-- monad transformer.
module System.Log.Heavy.LoggingT
  (
    LoggingT (LoggingT), LoggingTState (..),
    runLoggingT
  ) where

import Control.Monad.Reader
import Control.Monad.Base
import Control.Monad.Trans.Control

import System.Log.Heavy.Types

-- | State of @LoggingT@ monad
data LoggingTState = LoggingTState {
    LoggingTState -> SpecializedLogger
ltsLogger :: SpecializedLogger
  , LoggingTState -> AnyLogBackend
ltsBackend :: AnyLogBackend
  , LoggingTState -> LogContext
ltsContext :: LogContext
  }

-- | Logging monad transformer.
-- This is just a default implementation of @HasLogging@ interface.
-- Applications are free to use this or another implementation.
newtype LoggingT m a = LoggingT {
    LoggingT m a -> ReaderT LoggingTState m a
runLoggingT_ :: ReaderT LoggingTState m a
  }
  deriving (a -> LoggingT m b -> LoggingT m a
(a -> b) -> LoggingT m a -> LoggingT m b
(forall a b. (a -> b) -> LoggingT m a -> LoggingT m b)
-> (forall a b. a -> LoggingT m b -> LoggingT m a)
-> Functor (LoggingT m)
forall a b. a -> LoggingT m b -> LoggingT m a
forall a b. (a -> b) -> LoggingT m a -> LoggingT m b
forall (m :: * -> *) a b.
Functor m =>
a -> LoggingT m b -> LoggingT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> LoggingT m a -> LoggingT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> LoggingT m b -> LoggingT m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> LoggingT m b -> LoggingT m a
fmap :: (a -> b) -> LoggingT m a -> LoggingT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> LoggingT m a -> LoggingT m b
Functor, Functor (LoggingT m)
a -> LoggingT m a
Functor (LoggingT m)
-> (forall a. a -> LoggingT m a)
-> (forall a b.
    LoggingT m (a -> b) -> LoggingT m a -> LoggingT m b)
-> (forall a b c.
    (a -> b -> c) -> LoggingT m a -> LoggingT m b -> LoggingT m c)
-> (forall a b. LoggingT m a -> LoggingT m b -> LoggingT m b)
-> (forall a b. LoggingT m a -> LoggingT m b -> LoggingT m a)
-> Applicative (LoggingT m)
LoggingT m a -> LoggingT m b -> LoggingT m b
LoggingT m a -> LoggingT m b -> LoggingT m a
LoggingT m (a -> b) -> LoggingT m a -> LoggingT m b
(a -> b -> c) -> LoggingT m a -> LoggingT m b -> LoggingT m c
forall a. a -> LoggingT m a
forall a b. LoggingT m a -> LoggingT m b -> LoggingT m a
forall a b. LoggingT m a -> LoggingT m b -> LoggingT m b
forall a b. LoggingT m (a -> b) -> LoggingT m a -> LoggingT m b
forall a b c.
(a -> b -> c) -> LoggingT m a -> LoggingT m b -> LoggingT 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 (LoggingT m)
forall (m :: * -> *) a. Applicative m => a -> LoggingT m a
forall (m :: * -> *) a b.
Applicative m =>
LoggingT m a -> LoggingT m b -> LoggingT m a
forall (m :: * -> *) a b.
Applicative m =>
LoggingT m a -> LoggingT m b -> LoggingT m b
forall (m :: * -> *) a b.
Applicative m =>
LoggingT m (a -> b) -> LoggingT m a -> LoggingT m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> LoggingT m a -> LoggingT m b -> LoggingT m c
<* :: LoggingT m a -> LoggingT m b -> LoggingT m a
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
LoggingT m a -> LoggingT m b -> LoggingT m a
*> :: LoggingT m a -> LoggingT m b -> LoggingT m b
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
LoggingT m a -> LoggingT m b -> LoggingT m b
liftA2 :: (a -> b -> c) -> LoggingT m a -> LoggingT m b -> LoggingT m c
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> LoggingT m a -> LoggingT m b -> LoggingT m c
<*> :: LoggingT m (a -> b) -> LoggingT m a -> LoggingT m b
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
LoggingT m (a -> b) -> LoggingT m a -> LoggingT m b
pure :: a -> LoggingT m a
$cpure :: forall (m :: * -> *) a. Applicative m => a -> LoggingT m a
$cp1Applicative :: forall (m :: * -> *). Applicative m => Functor (LoggingT m)
Applicative, Applicative (LoggingT m)
a -> LoggingT m a
Applicative (LoggingT m)
-> (forall a b.
    LoggingT m a -> (a -> LoggingT m b) -> LoggingT m b)
-> (forall a b. LoggingT m a -> LoggingT m b -> LoggingT m b)
-> (forall a. a -> LoggingT m a)
-> Monad (LoggingT m)
LoggingT m a -> (a -> LoggingT m b) -> LoggingT m b
LoggingT m a -> LoggingT m b -> LoggingT m b
forall a. a -> LoggingT m a
forall a b. LoggingT m a -> LoggingT m b -> LoggingT m b
forall a b. LoggingT m a -> (a -> LoggingT m b) -> LoggingT m b
forall (m :: * -> *). Monad m => Applicative (LoggingT m)
forall (m :: * -> *) a. Monad m => a -> LoggingT m a
forall (m :: * -> *) a b.
Monad m =>
LoggingT m a -> LoggingT m b -> LoggingT m b
forall (m :: * -> *) a b.
Monad m =>
LoggingT m a -> (a -> LoggingT m b) -> LoggingT 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 -> LoggingT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> LoggingT m a
>> :: LoggingT m a -> LoggingT m b -> LoggingT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
LoggingT m a -> LoggingT m b -> LoggingT m b
>>= :: LoggingT m a -> (a -> LoggingT m b) -> LoggingT m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
LoggingT m a -> (a -> LoggingT m b) -> LoggingT m b
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (LoggingT m)
Monad, MonadReader LoggingTState, m a -> LoggingT m a
(forall (m :: * -> *) a. Monad m => m a -> LoggingT m a)
-> MonadTrans LoggingT
forall (m :: * -> *) a. Monad m => m a -> LoggingT m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> LoggingT m a
$clift :: forall (m :: * -> *) a. Monad m => m a -> LoggingT m a
MonadTrans)

deriving instance MonadIO m => MonadIO (LoggingT m)

instance MonadIO m => MonadBase IO (LoggingT m) where
  liftBase :: IO α -> LoggingT m α
liftBase = IO α -> LoggingT m α
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

instance MonadTransControl LoggingT where
    type StT LoggingT a = StT (ReaderT LoggingTState) a
    liftWith :: (Run LoggingT -> m a) -> LoggingT m a
liftWith = (forall b. ReaderT LoggingTState m b -> LoggingT m b)
-> (forall (o :: * -> *) b.
    LoggingT o b -> ReaderT LoggingTState o b)
-> (RunDefault LoggingT (ReaderT LoggingTState) -> m a)
-> LoggingT 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 LoggingTState m b -> LoggingT m b
forall (m :: * -> *) a. ReaderT LoggingTState m a -> LoggingT m a
LoggingT forall (o :: * -> *) b. LoggingT o b -> ReaderT LoggingTState o b
runLoggingT_
    restoreT :: m (StT LoggingT a) -> LoggingT m a
restoreT = (ReaderT LoggingTState m a -> LoggingT m a)
-> m (StT (ReaderT LoggingTState) a) -> LoggingT 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 LoggingTState m a -> LoggingT m a
forall (m :: * -> *) a. ReaderT LoggingTState m a -> LoggingT m a
LoggingT

instance (MonadBaseControl IO m, MonadIO m) => MonadBaseControl IO (LoggingT m) where
    type StM (LoggingT m) a = ComposeSt LoggingT m a
    liftBaseWith :: (RunInBase (LoggingT m) IO -> IO a) -> LoggingT m a
liftBaseWith     = (RunInBase (LoggingT m) IO -> IO a) -> LoggingT m a
forall (t :: (* -> *) -> * -> *) (b :: * -> *) (m :: * -> *) a.
(MonadTransControl t, MonadBaseControl b m) =>
(RunInBaseDefault t m b -> b a) -> t m a
defaultLiftBaseWith
    restoreM :: StM (LoggingT m) a -> LoggingT m a
restoreM         = StM (LoggingT m) a -> LoggingT m a
forall (t :: (* -> *) -> * -> *) (b :: * -> *) (m :: * -> *) a.
(MonadTransControl t, MonadBaseControl b m) =>
ComposeSt t m a -> t m a
defaultRestoreM

instance Monad m => HasLogger (LoggingT m) where
  getLogger :: LoggingT m SpecializedLogger
getLogger = (LoggingTState -> SpecializedLogger)
-> LoggingT m SpecializedLogger
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks LoggingTState -> SpecializedLogger
ltsLogger
  localLogger :: SpecializedLogger -> LoggingT m a -> LoggingT m a
localLogger SpecializedLogger
l LoggingT m a
actions = ReaderT LoggingTState m a -> LoggingT m a
forall (m :: * -> *) a. ReaderT LoggingTState m a -> LoggingT m a
LoggingT (ReaderT LoggingTState m a -> LoggingT m a)
-> ReaderT LoggingTState m a -> LoggingT m a
forall a b. (a -> b) -> a -> b
$ (LoggingTState -> m a) -> ReaderT LoggingTState m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((LoggingTState -> m a) -> ReaderT LoggingTState m a)
-> (LoggingTState -> m a) -> ReaderT LoggingTState m a
forall a b. (a -> b) -> a -> b
$ \LoggingTState
lts -> ReaderT LoggingTState m a -> LoggingTState -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (LoggingT m a -> ReaderT LoggingTState m a
forall (o :: * -> *) b. LoggingT o b -> ReaderT LoggingTState o b
runLoggingT_ LoggingT m a
actions) (LoggingTState -> m a) -> LoggingTState -> m a
forall a b. (a -> b) -> a -> b
$ LoggingTState
lts {ltsLogger :: SpecializedLogger
ltsLogger = SpecializedLogger
l}

instance (Monad m) => HasLogContext (LoggingT m) where
  getLogContext :: LoggingT m LogContext
getLogContext = (LoggingTState -> LogContext) -> LoggingT m LogContext
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks LoggingTState -> LogContext
ltsContext

  withLogContext :: LogContextFrame -> LoggingT m a -> LoggingT m a
withLogContext LogContextFrame
frame LoggingT m a
actions =
    ReaderT LoggingTState m a -> LoggingT m a
forall (m :: * -> *) a. ReaderT LoggingTState m a -> LoggingT m a
LoggingT (ReaderT LoggingTState m a -> LoggingT m a)
-> ReaderT LoggingTState m a -> LoggingT m a
forall a b. (a -> b) -> a -> b
$ (LoggingTState -> m a) -> ReaderT LoggingTState m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((LoggingTState -> m a) -> ReaderT LoggingTState m a)
-> (LoggingTState -> m a) -> ReaderT LoggingTState m a
forall a b. (a -> b) -> a -> b
$ \LoggingTState
lts -> ReaderT LoggingTState m a -> LoggingTState -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (LoggingT m a -> ReaderT LoggingTState m a
forall (o :: * -> *) b. LoggingT o b -> ReaderT LoggingTState o b
runLoggingT_ LoggingT m a
actions) (LoggingTState -> m a) -> LoggingTState -> m a
forall a b. (a -> b) -> a -> b
$ LoggingTState
lts {ltsContext :: LogContext
ltsContext = LogContextFrame
frameLogContextFrame -> LogContext -> LogContext
forall a. a -> [a] -> [a]
: LoggingTState -> LogContext
ltsContext LoggingTState
lts}

-- | Run logging monad
runLoggingT :: LoggingT m a -> LoggingTState -> m a
runLoggingT :: LoggingT m a -> LoggingTState -> m a
runLoggingT LoggingT m a
actions LoggingTState
context = ReaderT LoggingTState m a -> LoggingTState -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (LoggingT m a -> ReaderT LoggingTState m a
forall (o :: * -> *) b. LoggingT o b -> ReaderT LoggingTState o b
runLoggingT_ LoggingT m a
actions) LoggingTState
context

instance Monad m => HasLogBackend AnyLogBackend (LoggingT m) where
  getLogBackend :: LoggingT m AnyLogBackend
getLogBackend = (LoggingTState -> AnyLogBackend) -> LoggingT m AnyLogBackend
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks LoggingTState -> AnyLogBackend
ltsBackend