{-# 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
$cfmap :: forall cfg a b. (a -> b) -> KeterM cfg a -> KeterM cfg b
fmap :: forall a b. (a -> b) -> KeterM cfg a -> KeterM cfg b
$c<$ :: forall cfg a b. a -> KeterM cfg b -> KeterM cfg a
<$ :: forall a b. a -> KeterM cfg b -> KeterM cfg a
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
$cpure :: forall cfg a. a -> KeterM cfg a
pure :: forall a. a -> KeterM cfg a
$c<*> :: forall cfg a b. KeterM cfg (a -> b) -> KeterM cfg a -> KeterM cfg b
<*> :: forall a b. KeterM cfg (a -> b) -> KeterM cfg a -> KeterM cfg b
$cliftA2 :: forall cfg a b c.
(a -> b -> c) -> KeterM cfg a -> KeterM cfg b -> KeterM cfg c
liftA2 :: forall a b c.
(a -> b -> c) -> KeterM cfg a -> KeterM cfg b -> KeterM cfg c
$c*> :: forall cfg a b. KeterM cfg a -> KeterM cfg b -> KeterM cfg b
*> :: 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 a
<* :: forall a b. KeterM cfg a -> KeterM cfg b -> 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
$c>>= :: forall cfg a b. KeterM cfg a -> (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 -> KeterM cfg b -> KeterM cfg b
>> :: forall a b. KeterM cfg a -> KeterM cfg b -> KeterM cfg b
$creturn :: forall cfg a. a -> KeterM cfg a
return :: forall a. a -> KeterM cfg a
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
$cwithRunInIO :: forall cfg b.
((forall a. KeterM cfg a -> IO a) -> IO b) -> KeterM cfg b
withRunInIO :: forall 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
$cliftIO :: forall cfg a. IO a -> KeterM cfg a
liftIO :: forall 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
$cmonadLoggerLog :: forall cfg msg.
ToLogStr msg =>
Loc -> LogSource -> LogLevel -> msg -> KeterM cfg ()
monadLoggerLog :: forall 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
$caskLoggerIO :: forall cfg.
KeterM cfg (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
askLoggerIO :: 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