{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DerivingStrategies         #-}

module Keter.Context where

import           Keter.Common
import           Control.Monad.Trans       (lift)
import           Control.Monad.IO.Class   (MonadIO)
import           Control.Monad.IO.Unlift   (MonadUnliftIO)
import           Control.Monad.Logger      (MonadLogger, MonadLoggerIO, LoggingT(..), runLoggingT)
import           Control.Monad.Reader      (MonadReader, ReaderT, runReaderT, ask
                                           , withReaderT)

-- | The top-level keter context monad, carrying around the main logger and some locally relevant configuration structure.
--
-- See this blog post for an explanation of the design philosophy: https://www.fpcomplete.com/blog/2017/06/readert-design-pattern/
--
-- TODO: generalize as /contexts/ instead of /configs/? Since not every state being passed
-- around can be intuitively thought of as a config per se. Ex. AppManager
newtype KeterM cfg a = KeterM { forall cfg a. KeterM cfg a -> LoggingT (ReaderT cfg IO) a
runKeterM :: LoggingT (ReaderT cfg IO) a }
  deriving newtype ((forall a b. (a -> b) -> KeterM cfg a -> KeterM cfg b)
-> (forall a b. a -> KeterM cfg b -> KeterM cfg a)
-> Functor (KeterM cfg)
forall a b. a -> KeterM cfg b -> KeterM cfg a
forall a b. (a -> b) -> KeterM cfg a -> KeterM cfg b
forall cfg a b. a -> KeterM cfg b -> KeterM cfg a
forall cfg a b. (a -> b) -> KeterM cfg a -> KeterM cfg b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> KeterM cfg b -> KeterM cfg a
$c<$ :: forall cfg a b. a -> KeterM cfg b -> KeterM cfg a
fmap :: forall a b. (a -> b) -> KeterM cfg a -> KeterM cfg b
$cfmap :: forall cfg a b. (a -> b) -> KeterM cfg a -> KeterM cfg b
Functor, Functor (KeterM cfg)
Functor (KeterM cfg)
-> (forall a. a -> KeterM cfg a)
-> (forall a b.
    KeterM cfg (a -> b) -> KeterM cfg a -> KeterM cfg b)
-> (forall a b c.
    (a -> b -> c) -> KeterM cfg a -> KeterM cfg b -> KeterM cfg c)
-> (forall a b. KeterM cfg a -> KeterM cfg b -> KeterM cfg b)
-> (forall a b. KeterM cfg a -> KeterM cfg b -> KeterM cfg a)
-> Applicative (KeterM cfg)
forall cfg. Functor (KeterM cfg)
forall a. a -> KeterM cfg a
forall cfg a. a -> KeterM cfg a
forall a b. KeterM cfg a -> KeterM cfg b -> KeterM cfg a
forall a b. KeterM cfg a -> KeterM cfg b -> KeterM cfg b
forall a b. KeterM cfg (a -> b) -> KeterM cfg a -> KeterM cfg b
forall cfg a b. KeterM cfg a -> KeterM cfg b -> KeterM cfg a
forall cfg a b. KeterM cfg a -> KeterM cfg b -> KeterM cfg b
forall cfg a b. KeterM cfg (a -> b) -> KeterM cfg a -> KeterM cfg b
forall a b c.
(a -> b -> c) -> KeterM cfg a -> KeterM cfg b -> KeterM cfg c
forall cfg a b c.
(a -> b -> c) -> KeterM cfg a -> KeterM cfg b -> KeterM cfg 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 a b. KeterM cfg a -> KeterM cfg b -> KeterM cfg a
$c<* :: forall cfg a b. KeterM cfg a -> KeterM cfg b -> KeterM cfg a
*> :: forall a b. KeterM cfg a -> KeterM cfg b -> KeterM cfg b
$c*> :: forall cfg a b. KeterM cfg a -> KeterM cfg b -> KeterM cfg b
liftA2 :: forall a b c.
(a -> b -> c) -> KeterM cfg a -> KeterM cfg b -> KeterM cfg c
$cliftA2 :: forall cfg a b c.
(a -> b -> c) -> KeterM cfg a -> KeterM cfg b -> KeterM cfg c
<*> :: forall a b. KeterM cfg (a -> b) -> KeterM cfg a -> KeterM cfg b
$c<*> :: forall cfg a b. KeterM cfg (a -> b) -> KeterM cfg a -> KeterM cfg b
pure :: forall a. a -> KeterM cfg a
$cpure :: forall cfg a. a -> KeterM cfg a
Applicative, Applicative (KeterM cfg)
Applicative (KeterM cfg)
-> (forall a b.
    KeterM cfg a -> (a -> KeterM cfg b) -> KeterM cfg b)
-> (forall a b. KeterM cfg a -> KeterM cfg b -> KeterM cfg b)
-> (forall a. a -> KeterM cfg a)
-> Monad (KeterM cfg)
forall cfg. Applicative (KeterM cfg)
forall a. a -> KeterM cfg a
forall cfg a. a -> KeterM cfg a
forall a b. KeterM cfg a -> KeterM cfg b -> KeterM cfg b
forall a b. KeterM cfg a -> (a -> KeterM cfg b) -> KeterM cfg b
forall cfg a b. KeterM cfg a -> KeterM cfg b -> KeterM cfg b
forall cfg a b. KeterM cfg a -> (a -> KeterM cfg b) -> KeterM cfg 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 :: forall a. a -> KeterM cfg a
$creturn :: forall cfg a. a -> KeterM cfg a
>> :: forall a b. KeterM cfg a -> KeterM cfg b -> KeterM cfg b
$c>> :: forall cfg a b. KeterM cfg a -> KeterM cfg b -> KeterM cfg b
>>= :: forall a b. KeterM cfg a -> (a -> KeterM cfg b) -> KeterM cfg b
$c>>= :: forall cfg a b. KeterM cfg a -> (a -> KeterM cfg b) -> KeterM cfg b
Monad,
                    MonadIO (KeterM cfg)
MonadIO (KeterM cfg)
-> (forall b.
    ((forall a. KeterM cfg a -> IO a) -> IO b) -> KeterM cfg b)
-> MonadUnliftIO (KeterM cfg)
forall {cfg}. MonadIO (KeterM cfg)
forall b.
((forall a. KeterM cfg a -> IO a) -> IO b) -> KeterM cfg b
forall cfg b.
((forall a. KeterM cfg a -> IO a) -> IO b) -> KeterM cfg b
forall (m :: * -> *).
MonadIO m
-> (forall b. ((forall a. m a -> IO a) -> IO b) -> m b)
-> MonadUnliftIO m
withRunInIO :: forall b.
((forall a. KeterM cfg a -> IO a) -> IO b) -> KeterM cfg b
$cwithRunInIO :: forall cfg b.
((forall a. KeterM cfg a -> IO a) -> IO b) -> KeterM cfg b
MonadUnliftIO,
                    Monad (KeterM cfg)
Monad (KeterM cfg)
-> (forall a. IO a -> KeterM cfg a) -> MonadIO (KeterM cfg)
forall cfg. Monad (KeterM cfg)
forall a. IO a -> KeterM cfg a
forall cfg a. IO a -> KeterM cfg a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> KeterM cfg a
$cliftIO :: forall cfg a. IO a -> KeterM cfg a
MonadIO, Monad (KeterM cfg)
Monad (KeterM cfg)
-> (forall msg.
    ToLogStr msg =>
    Loc -> LogSource -> LogLevel -> msg -> KeterM cfg ())
-> MonadLogger (KeterM cfg)
forall cfg. Monad (KeterM cfg)
forall msg.
ToLogStr msg =>
Loc -> LogSource -> LogLevel -> msg -> KeterM cfg ()
forall cfg msg.
ToLogStr msg =>
Loc -> LogSource -> LogLevel -> msg -> KeterM cfg ()
forall (m :: * -> *).
Monad m
-> (forall msg.
    ToLogStr msg =>
    Loc -> LogSource -> LogLevel -> msg -> m ())
-> MonadLogger m
monadLoggerLog :: forall msg.
ToLogStr msg =>
Loc -> LogSource -> LogLevel -> msg -> KeterM cfg ()
$cmonadLoggerLog :: forall cfg msg.
ToLogStr msg =>
Loc -> LogSource -> LogLevel -> msg -> KeterM cfg ()
MonadLogger, MonadIO (KeterM cfg)
MonadLogger (KeterM cfg)
KeterM cfg (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
MonadLogger (KeterM cfg)
-> MonadIO (KeterM cfg)
-> KeterM cfg (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
-> MonadLoggerIO (KeterM cfg)
forall {cfg}. MonadIO (KeterM cfg)
forall cfg. MonadLogger (KeterM cfg)
forall cfg.
KeterM cfg (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
forall (m :: * -> *).
MonadLogger m
-> MonadIO m
-> m (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
-> MonadLoggerIO m
askLoggerIO :: KeterM cfg (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
$caskLoggerIO :: forall cfg.
KeterM cfg (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
MonadLoggerIO,
                    MonadReader cfg)

withMappedConfig :: (cfg -> cfg') -> KeterM cfg' a -> KeterM cfg a
withMappedConfig :: forall cfg cfg' a. (cfg -> cfg') -> KeterM cfg' a -> KeterM cfg a
withMappedConfig cfg -> cfg'
f (KeterM LoggingT (ReaderT cfg' IO) a
ctx) = 
    LoggingT (ReaderT cfg IO) a -> KeterM cfg a
forall cfg a. LoggingT (ReaderT cfg IO) a -> KeterM cfg a
KeterM (LoggingT (ReaderT cfg IO) a -> KeterM cfg a)
-> LoggingT (ReaderT cfg IO) a -> KeterM cfg a
forall a b. (a -> b) -> a -> b
$ ((Loc -> LogSource -> LogLevel -> LogStr -> IO ())
 -> ReaderT cfg IO a)
-> LoggingT (ReaderT cfg IO) a
forall (m :: * -> *) a.
((Loc -> LogSource -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
LoggingT (((Loc -> LogSource -> LogLevel -> LogStr -> IO ())
  -> ReaderT cfg IO a)
 -> LoggingT (ReaderT cfg IO) a)
-> ((Loc -> LogSource -> LogLevel -> LogStr -> IO ())
    -> ReaderT cfg IO a)
-> LoggingT (ReaderT cfg IO) a
forall a b. (a -> b) -> a -> b
$ \Loc -> LogSource -> LogLevel -> LogStr -> IO ()
logger -> (cfg -> cfg') -> ReaderT cfg' IO a -> ReaderT cfg IO a
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT cfg -> cfg'
f (ReaderT cfg' IO a -> ReaderT cfg IO a)
-> ReaderT cfg' IO a -> ReaderT cfg IO a
forall a b. (a -> b) -> a -> b
$ LoggingT (ReaderT cfg' IO) a
-> (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
-> ReaderT cfg' IO a
forall (m :: * -> *) a.
LoggingT m a
-> (Loc -> LogSource -> LogLevel -> LogStr -> IO ()) -> m a
runLoggingT LoggingT (ReaderT cfg' IO) a
ctx Loc -> LogSource -> LogLevel -> LogStr -> IO ()
logger