module Blammo.Logging.WithLogger (WithLogger (..), runWithLogger) where

import Prelude

import Blammo.Logging.Logger (HasLogger (..), runLogAction)
import Control.Lens (view)
import Control.Monad.IO.Class (MonadIO (..))
import Control.Monad.Logger.Aeson (MonadLogger (..), MonadLoggerIO (..))
import Control.Monad.Reader (MonadReader, ReaderT (ReaderT), asks)

-- | Useful with the @DerivingVia@ language extension to derive
--   'MonadLogger' for your application monad
newtype WithLogger env m a = WithLogger (ReaderT env m a)
  deriving newtype ((forall a b. (a -> b) -> WithLogger env m a -> WithLogger env m b)
-> (forall a b. a -> WithLogger env m b -> WithLogger env m a)
-> Functor (WithLogger env m)
forall a b. a -> WithLogger env m b -> WithLogger env m a
forall a b. (a -> b) -> WithLogger env m a -> WithLogger env m b
forall env (m :: * -> *) a b.
Functor m =>
a -> WithLogger env m b -> WithLogger env m a
forall env (m :: * -> *) a b.
Functor m =>
(a -> b) -> WithLogger env m a -> WithLogger env m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall env (m :: * -> *) a b.
Functor m =>
(a -> b) -> WithLogger env m a -> WithLogger env m b
fmap :: forall a b. (a -> b) -> WithLogger env m a -> WithLogger env m b
$c<$ :: forall env (m :: * -> *) a b.
Functor m =>
a -> WithLogger env m b -> WithLogger env m a
<$ :: forall a b. a -> WithLogger env m b -> WithLogger env m a
Functor, Functor (WithLogger env m)
Functor (WithLogger env m) =>
(forall a. a -> WithLogger env m a)
-> (forall a b.
    WithLogger env m (a -> b)
    -> WithLogger env m a -> WithLogger env m b)
-> (forall a b c.
    (a -> b -> c)
    -> WithLogger env m a -> WithLogger env m b -> WithLogger env m c)
-> (forall a b.
    WithLogger env m a -> WithLogger env m b -> WithLogger env m b)
-> (forall a b.
    WithLogger env m a -> WithLogger env m b -> WithLogger env m a)
-> Applicative (WithLogger env m)
forall a. a -> WithLogger env m a
forall a b.
WithLogger env m a -> WithLogger env m b -> WithLogger env m a
forall a b.
WithLogger env m a -> WithLogger env m b -> WithLogger env m b
forall a b.
WithLogger env m (a -> b)
-> WithLogger env m a -> WithLogger env m b
forall a b c.
(a -> b -> c)
-> WithLogger env m a -> WithLogger env m b -> WithLogger env m c
forall env (m :: * -> *).
Applicative m =>
Functor (WithLogger env m)
forall env (m :: * -> *) a.
Applicative m =>
a -> WithLogger env m a
forall env (m :: * -> *) a b.
Applicative m =>
WithLogger env m a -> WithLogger env m b -> WithLogger env m a
forall env (m :: * -> *) a b.
Applicative m =>
WithLogger env m a -> WithLogger env m b -> WithLogger env m b
forall env (m :: * -> *) a b.
Applicative m =>
WithLogger env m (a -> b)
-> WithLogger env m a -> WithLogger env m b
forall env (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> WithLogger env m a -> WithLogger env m b -> WithLogger env 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
$cpure :: forall env (m :: * -> *) a.
Applicative m =>
a -> WithLogger env m a
pure :: forall a. a -> WithLogger env m a
$c<*> :: forall env (m :: * -> *) a b.
Applicative m =>
WithLogger env m (a -> b)
-> WithLogger env m a -> WithLogger env m b
<*> :: forall a b.
WithLogger env m (a -> b)
-> WithLogger env m a -> WithLogger env m b
$cliftA2 :: forall env (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> WithLogger env m a -> WithLogger env m b -> WithLogger env m c
liftA2 :: forall a b c.
(a -> b -> c)
-> WithLogger env m a -> WithLogger env m b -> WithLogger env m c
$c*> :: forall env (m :: * -> *) a b.
Applicative m =>
WithLogger env m a -> WithLogger env m b -> WithLogger env m b
*> :: forall a b.
WithLogger env m a -> WithLogger env m b -> WithLogger env m b
$c<* :: forall env (m :: * -> *) a b.
Applicative m =>
WithLogger env m a -> WithLogger env m b -> WithLogger env m a
<* :: forall a b.
WithLogger env m a -> WithLogger env m b -> WithLogger env m a
Applicative, Applicative (WithLogger env m)
Applicative (WithLogger env m) =>
(forall a b.
 WithLogger env m a
 -> (a -> WithLogger env m b) -> WithLogger env m b)
-> (forall a b.
    WithLogger env m a -> WithLogger env m b -> WithLogger env m b)
-> (forall a. a -> WithLogger env m a)
-> Monad (WithLogger env m)
forall a. a -> WithLogger env m a
forall a b.
WithLogger env m a -> WithLogger env m b -> WithLogger env m b
forall a b.
WithLogger env m a
-> (a -> WithLogger env m b) -> WithLogger env m b
forall env (m :: * -> *). Monad m => Applicative (WithLogger env m)
forall env (m :: * -> *) a. Monad m => a -> WithLogger env m a
forall env (m :: * -> *) a b.
Monad m =>
WithLogger env m a -> WithLogger env m b -> WithLogger env m b
forall env (m :: * -> *) a b.
Monad m =>
WithLogger env m a
-> (a -> WithLogger env m b) -> WithLogger env 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
$c>>= :: forall env (m :: * -> *) a b.
Monad m =>
WithLogger env m a
-> (a -> WithLogger env m b) -> WithLogger env m b
>>= :: forall a b.
WithLogger env m a
-> (a -> WithLogger env m b) -> WithLogger env m b
$c>> :: forall env (m :: * -> *) a b.
Monad m =>
WithLogger env m a -> WithLogger env m b -> WithLogger env m b
>> :: forall a b.
WithLogger env m a -> WithLogger env m b -> WithLogger env m b
$creturn :: forall env (m :: * -> *) a. Monad m => a -> WithLogger env m a
return :: forall a. a -> WithLogger env m a
Monad, Monad (WithLogger env m)
Monad (WithLogger env m) =>
(forall a. IO a -> WithLogger env m a)
-> MonadIO (WithLogger env m)
forall a. IO a -> WithLogger env m a
forall env (m :: * -> *). MonadIO m => Monad (WithLogger env m)
forall env (m :: * -> *) a. MonadIO m => IO a -> WithLogger env m a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall env (m :: * -> *) a. MonadIO m => IO a -> WithLogger env m a
liftIO :: forall a. IO a -> WithLogger env m a
MonadIO, MonadReader env)

runWithLogger :: env -> WithLogger env m a -> m a
runWithLogger :: forall env (m :: * -> *) a. env -> WithLogger env m a -> m a
runWithLogger env
env (WithLogger (ReaderT env -> m a
f)) = env -> m a
f env
env

instance (MonadIO m, HasLogger env) => MonadLogger (WithLogger env m) where
  monadLoggerLog :: forall msg.
ToLogStr msg =>
Loc -> LogSource -> LogLevel -> msg -> WithLogger env m ()
monadLoggerLog Loc
loc LogSource
source LogLevel
level msg
msg = do
    Logger
logger <- (env -> Logger) -> WithLogger env m Logger
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Getting Logger env Logger -> env -> Logger
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Logger env Logger
forall env. HasLogger env => Lens' env Logger
Lens' env Logger
loggerL)
    Logger
-> Loc -> LogSource -> LogLevel -> msg -> WithLogger env m ()
forall (m :: * -> *) msg.
(MonadIO m, ToLogStr msg) =>
Logger -> Loc -> LogSource -> LogLevel -> msg -> m ()
runLogAction Logger
logger Loc
loc LogSource
source LogLevel
level msg
msg

instance (MonadIO m, HasLogger env) => MonadLoggerIO (WithLogger env m) where
  askLoggerIO :: WithLogger env m (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
askLoggerIO = do
    Logger
logger <- (env -> Logger) -> WithLogger env m Logger
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Getting Logger env Logger -> env -> Logger
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Logger env Logger
forall env. HasLogger env => Lens' env Logger
Lens' env Logger
loggerL)
    (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
-> WithLogger
     env m (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
forall a. a -> WithLogger env m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Loc -> LogSource -> LogLevel -> LogStr -> IO ())
 -> WithLogger
      env m (Loc -> LogSource -> LogLevel -> LogStr -> IO ()))
-> (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
-> WithLogger
     env m (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
forall a b. (a -> b) -> a -> b
$ \Loc
loc LogSource
source LogLevel
level LogStr
msg ->
      IO () -> IO ()
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Logger -> Loc -> LogSource -> LogLevel -> LogStr -> IO ()
forall (m :: * -> *) msg.
(MonadIO m, ToLogStr msg) =>
Logger -> Loc -> LogSource -> LogLevel -> msg -> m ()
runLogAction Logger
logger Loc
loc LogSource
source LogLevel
level LogStr
msg