{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE CPP #-}
module Network.Nakadi.Internal.Types
( module Network.Nakadi.Internal.Types.Config
, module Network.Nakadi.Internal.Types.Committer
, module Network.Nakadi.Internal.Types.Exceptions
, module Network.Nakadi.Internal.Types.Logger
, module Network.Nakadi.Internal.Types.Problem
, module Network.Nakadi.Internal.Types.Service
, module Network.Nakadi.Internal.Types.Util
, module Network.Nakadi.Internal.Types.Base
, module Network.Nakadi.Internal.Types.Subscriptions
, module Network.Nakadi.Internal.Types.Worker
, HasNakadiConfig(..)
, MonadNakadi(..)
, MonadNakadiIO
, NakadiT(..)
, runNakadiT
)
where
import UnliftIO.STM ( readTVarIO )
import Control.Monad.Base
import Control.Monad.Catch
import Control.Monad.IO.Unlift
import Control.Monad.Logger
import Control.Monad.State.Class
import qualified Control.Monad.State.Lazy as State.Lazy
import qualified Control.Monad.State.Strict as State.Strict
import Control.Monad.Trans.Class
import Control.Monad.Trans.Control
import Control.Monad.Trans.Reader ( ReaderT(..) )
import Control.Monad.Trans.Resource hiding (release)
import qualified Control.Monad.Writer.Lazy as Writer.Lazy
import qualified Control.Monad.Writer.Strict as Writer.Strict
import Network.Nakadi.Internal.Prelude
import Network.Nakadi.Internal.Types.Base
import Network.Nakadi.Internal.Types.Committer
import Network.Nakadi.Internal.Types.Config
import Network.Nakadi.Internal.Types.Exceptions
import Network.Nakadi.Internal.Types.Logger
import Network.Nakadi.Internal.Types.Problem
import Network.Nakadi.Internal.Types.Service
import Network.Nakadi.Internal.GlobalConfig
import Network.Nakadi.Internal.Types.Subscriptions
import Network.Nakadi.Internal.Types.Util
import Network.Nakadi.Internal.Types.Worker
class HasNakadiConfig b r | r -> b where
nakadiConfig :: r -> Config b
class (MonadNakadiBase b m, MonadThrow b, MonadMask b, MonadThrow m, MonadCatch m)
=> MonadNakadi b m | m -> b where
nakadiAsk :: m (Config b)
default nakadiAsk :: (MonadNakadi b n, MonadTrans t, m ~ t n) => m (Config b)
nakadiAsk = lift nakadiAsk
type MonadNakadiIO = MonadNakadi IO
newtype NakadiT b m a = NakadiT { _runNakadiT :: Config b -> m a }
instance Functor m => Functor (NakadiT b m) where
fmap f (NakadiT n) = NakadiT (fmap f . n)
instance (Applicative m) => Applicative (NakadiT b m) where
pure a = NakadiT $ \_conf -> pure a
{-# INLINE pure #-}
f <*> v = NakadiT $ \ c -> _runNakadiT f c <*> _runNakadiT v c
{-# INLINE (<*>) #-}
u *> v = NakadiT $ \ c -> _runNakadiT u c *> _runNakadiT v c
{-# INLINE (*>) #-}
u <* v = NakadiT $ \ c -> _runNakadiT u c <* _runNakadiT v c
{-# INLINE (<*) #-}
instance (Monad m) => Monad (NakadiT b m) where
return = lift . return
m >>= k = NakadiT $ \ c -> do
a <- _runNakadiT m c
_runNakadiT (k a) c
{-# INLINE (>>=) #-}
(>>) = (*>)
{-# INLINE (>>) #-}
fail msg = lift (fail msg)
{-# INLINE fail #-}
instance MonadTrans (NakadiT b) where
lift a = NakadiT (const a)
{-# INLINE lift #-}
instance (Monad b, MonadThrow m) => MonadThrow (NakadiT b m) where
throwM e = lift $ Control.Monad.Catch.throwM e
instance (Monad b, MonadCatch m) => MonadCatch (NakadiT b m) where
catch (NakadiT b) h =
NakadiT $ \ c -> b c `Control.Monad.Catch.catch` \e -> _runNakadiT (h e) c
instance (Monad b, MonadMask m) => MonadMask (NakadiT b m) where
mask a = NakadiT $ \e -> mask $ \u -> _runNakadiT (a $ q u) e
where q :: (m a -> m a) -> NakadiT e m a -> NakadiT e m a
q u (NakadiT b) = NakadiT (u . b)
uninterruptibleMask a =
NakadiT $ \e -> uninterruptibleMask $ \u -> _runNakadiT (a $ q u) e
where q :: (m a -> m a) -> NakadiT e m a -> NakadiT e m a
q u (NakadiT b) = NakadiT (u . b)
#if MIN_VERSION_exceptions(0, 10, 0)
generalBracket acquire release use = NakadiT $ \ conf ->
generalBracket
(_runNakadiT acquire conf)
(\resource exitCase -> _runNakadiT (release resource exitCase) conf)
(\resource -> _runNakadiT (use resource) conf)
#endif
instance (Monad b, MonadIO m) => MonadIO (NakadiT b m) where
liftIO = lift . liftIO
instance (Monad m, MonadBase b' m) => MonadBase b' (NakadiT b m) where
liftBase = liftBaseDefault
instance (Monad b, MonadReader r m) => MonadReader r (NakadiT b m) where
ask = lift ask
local = mapNakadiT . local
instance MonadLogger m => MonadLogger (NakadiT b m)
instance (Monad b, MonadLoggerIO m) => MonadLoggerIO (NakadiT b m)
instance (Monad b, MonadState s m) => MonadState s (NakadiT b m) where
get = lift get
put = lift . put
instance (Monad b, MonadResource m) => MonadResource (NakadiT b m) where
liftResourceT = lift . liftResourceT
instance (Monad b, MonadUnliftIO m) => MonadUnliftIO (NakadiT b m) where
{-# INLINE askUnliftIO #-}
askUnliftIO =
NakadiT $ \r ->
withUnliftIO $ \u ->
return (UnliftIO (unliftIO u . runNakadiT r))
instance MonadTransControl (NakadiT b) where
type StT (NakadiT b) a = a
liftWith f = NakadiT $ \r -> f $ \t -> _runNakadiT t r
restoreT = NakadiT . const
{-# INLINABLE liftWith #-}
{-# INLINABLE restoreT #-}
instance MonadBaseControl b' m => MonadBaseControl b' (NakadiT b m) where
type StM (NakadiT b m) a = ComposeSt (NakadiT b) m a
liftBaseWith = defaultLiftBaseWith
restoreM = defaultRestoreM
instance {-# OVERLAPPABLE #-} MonadNakadiBase b m => MonadNakadiBase b (NakadiT b m)
instance MonadNakadi IO IO where
nakadiAsk =
liftIO (readTVarIO globalConfiguration) >>= \case
Nothing -> throwIO ConfigurationMissing
Just config -> pure config
instance ( MonadMask b
, MonadCatch m
, MonadNakadiBase b (ReaderT r m)
, HasNakadiConfig b r )
=> MonadNakadi b (ReaderT r m) where
nakadiAsk = asks nakadiConfig
instance ( MonadCatch m
, MonadMask b
, MonadNakadiBase b (NakadiT b m) )
=> MonadNakadi b (NakadiT b m) where
nakadiAsk = NakadiT return
instance (MonadNakadi b m, Monoid w) => MonadNakadi b (Writer.Lazy.WriterT w m)
instance (MonadNakadi b m, Monoid w) => MonadNakadi b (Writer.Strict.WriterT w m)
instance (MonadNakadi b m) => MonadNakadi b (State.Strict.StateT s m)
instance (MonadNakadi b m) => MonadNakadi b (State.Lazy.StateT s m)
instance (MonadNakadi b m) => MonadNakadi b (LoggingT m)
instance (MonadNakadi b m) => MonadNakadi b (NoLoggingT m)
instance (MonadNakadi b m) => MonadNakadi b (ResourceT m)
runNakadiT :: Config b -> NakadiT b m a -> m a
runNakadiT = flip _runNakadiT
mapNakadiT :: (m a -> m a) -> NakadiT b m a -> NakadiT b m a
mapNakadiT f n = NakadiT $ \c -> f (_runNakadiT n c)