{-# LANGUAGE CPP #-}
{-# LANGUAGE UndecidableInstances #-}
-- Required to make passthrough instances for MonadContext for things like ReaderT work as they do not satisfy the functional dependency | m -> c

-- |Module with a `ReaderT` style monad specialized to holding a record.
module Control.Monad.Composite.Context
  ( ContextT(ContextT, runContextT), runInContext, withContext, mapContextT
  , MonadContext(askContext, localContext), asksContext, askField
  ) where

import Composite.Record (Record)
import Control.Applicative (Alternative(empty, (<|>)))
import Control.Lens (Getter, view)
import Control.Monad (MonadPlus(mzero, mplus))
import Control.Monad.Base (MonadBase(liftBase))
import Control.Monad.Catch
  ( MonadThrow(throwM), MonadCatch(catch)
#if MIN_VERSION_exceptions(0,9,0)
  , MonadMask(mask, uninterruptibleMask, generalBracket)
#else
  , MonadMask(mask, uninterruptibleMask)
#endif
  )
import Control.Monad.Cont (ContT(ContT), runContT)
import Control.Monad.Cont.Class (MonadCont(callCC))
import Control.Monad.Error.Class (MonadError(throwError, catchError))
import Control.Monad.Except (ExceptT(ExceptT), runExceptT)
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail (MonadFail)
#endif
import qualified Control.Monad.Fail as MonadFail
import Control.Monad.Fix (MonadFix(mfix))
import Control.Monad.IO.Class (MonadIO(liftIO))
import Control.Monad.Reader (ReaderT(ReaderT), runReaderT)
import Control.Monad.Reader.Class (MonadReader(local, ask, reader))
import qualified Control.Monad.RWS.Lazy as Lazy
import qualified Control.Monad.RWS.Strict as Strict
import Control.Monad.RWS.Class (MonadRWS)
import qualified Control.Monad.State.Lazy as Lazy
import qualified Control.Monad.State.Strict as Strict
import Control.Monad.State.Class (MonadState(get, put, state))
import Control.Monad.Trans.Class (MonadTrans(lift))
import Control.Monad.Trans.Control (MonadTransControl(type StT, liftWith, restoreT), MonadBaseControl(type StM, liftBaseWith, restoreM))
import Control.Monad.Trans.Identity (IdentityT(IdentityT), runIdentityT)
import Control.Monad.Trans.Maybe (MaybeT(MaybeT), runMaybeT)
import qualified Control.Monad.Writer.Lazy as Lazy
import qualified Control.Monad.Writer.Strict as Strict
import Control.Monad.Writer.Class (MonadWriter(writer, tell, listen, pass))

import Control.Monad.IO.Unlift
  ( MonadUnliftIO
#if !MIN_VERSION_unliftio_core(0,2,0)
  , UnliftIO(UnliftIO), askUnliftIO, unliftIO, withUnliftIO
#endif
#if MIN_VERSION_unliftio_core(0,1,1)
  , withRunInIO
#endif
  )

-- |Class of monad (stacks) which have context reading functionality baked in. Similar to 'Control.Monad.Reader.MonadReader' but can coexist with a
-- another monad that provides 'Control.Monad.Reader.MonadReader' and requires the context to be a record.
class Monad m => MonadContext (c :: [*]) m | m -> c where
  -- |Fetch the context record from the environment.
  askContext :: m (Record c)

  -- |Run some action which has the same type of context with the context modified.
  localContext :: (Record c -> Record c) -> m a -> m a

instance MonadContext c ((->) (Record c)) where
  askContext :: Record c -> Record c
askContext = forall a. a -> a
id
  localContext :: forall a.
(Record c -> Record c) -> (Record c -> a) -> Record c -> a
localContext Record c -> Record c
f = (forall b c a. (b -> c) -> (a -> b) -> a -> c
. Record c -> Record c
f)

instance MonadContext c m => MonadContext c (ReaderT r m) where
  askContext :: ReaderT r m (Record c)
askContext = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (c :: [*]) (m :: * -> *). MonadContext c m => m (Record c)
askContext
  localContext :: forall a. (Record c -> Record c) -> ReaderT r m a -> ReaderT r m a
localContext Record c -> Record c
f ReaderT r m a
m = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \ r
r -> forall (c :: [*]) (m :: * -> *) a.
MonadContext c m =>
(Record c -> Record c) -> m a -> m a
localContext Record c -> Record c
f (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT r m a
m r
r)

instance MonadContext c m => MonadContext c (MaybeT m) where
  askContext :: MaybeT m (Record c)
askContext = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (c :: [*]) (m :: * -> *). MonadContext c m => m (Record c)
askContext
  localContext :: forall a. (Record c -> Record c) -> MaybeT m a -> MaybeT m a
localContext Record c -> Record c
f MaybeT m a
m = forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall (c :: [*]) (m :: * -> *) a.
MonadContext c m =>
(Record c -> Record c) -> m a -> m a
localContext Record c -> Record c
f (forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT MaybeT m a
m)

instance (MonadContext c m, Monoid w) => MonadContext c (Strict.WriterT w m) where
  askContext :: WriterT w m (Record c)
askContext = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (c :: [*]) (m :: * -> *). MonadContext c m => m (Record c)
askContext
  localContext :: forall a. (Record c -> Record c) -> WriterT w m a -> WriterT w m a
localContext Record c -> Record c
f WriterT w m a
m = forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Strict.WriterT forall a b. (a -> b) -> a -> b
$ forall (c :: [*]) (m :: * -> *) a.
MonadContext c m =>
(Record c -> Record c) -> m a -> m a
localContext Record c -> Record c
f (forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
Strict.runWriterT WriterT w m a
m)

instance (MonadContext c m, Monoid w) => MonadContext c (Lazy.WriterT w m) where
  askContext :: WriterT w m (Record c)
askContext = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (c :: [*]) (m :: * -> *). MonadContext c m => m (Record c)
askContext
  localContext :: forall a. (Record c -> Record c) -> WriterT w m a -> WriterT w m a
localContext Record c -> Record c
f WriterT w m a
m = forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Lazy.WriterT forall a b. (a -> b) -> a -> b
$ forall (c :: [*]) (m :: * -> *) a.
MonadContext c m =>
(Record c -> Record c) -> m a -> m a
localContext Record c -> Record c
f (forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
Lazy.runWriterT WriterT w m a
m)

instance MonadContext c m => MonadContext c (Strict.StateT s m) where
  askContext :: StateT s m (Record c)
askContext = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (c :: [*]) (m :: * -> *). MonadContext c m => m (Record c)
askContext
  localContext :: forall a. (Record c -> Record c) -> StateT s m a -> StateT s m a
localContext Record c -> Record c
f StateT s m a
m = forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Strict.StateT forall a b. (a -> b) -> a -> b
$ \ s
s -> forall (c :: [*]) (m :: * -> *) a.
MonadContext c m =>
(Record c -> Record c) -> m a -> m a
localContext Record c -> Record c
f (forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
Strict.runStateT StateT s m a
m s
s)

instance MonadContext c m => MonadContext c (Lazy.StateT s m) where
  askContext :: StateT s m (Record c)
askContext = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (c :: [*]) (m :: * -> *). MonadContext c m => m (Record c)
askContext
  localContext :: forall a. (Record c -> Record c) -> StateT s m a -> StateT s m a
localContext Record c -> Record c
f StateT s m a
m = forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Lazy.StateT forall a b. (a -> b) -> a -> b
$ \ s
s -> forall (c :: [*]) (m :: * -> *) a.
MonadContext c m =>
(Record c -> Record c) -> m a -> m a
localContext Record c -> Record c
f (forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
Lazy.runStateT StateT s m a
m s
s)

instance MonadContext c m => MonadContext c (IdentityT m) where
  askContext :: IdentityT m (Record c)
askContext = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (c :: [*]) (m :: * -> *). MonadContext c m => m (Record c)
askContext
  localContext :: forall a. (Record c -> Record c) -> IdentityT m a -> IdentityT m a
localContext Record c -> Record c
f IdentityT m a
m = forall {k} (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT forall a b. (a -> b) -> a -> b
$ forall (c :: [*]) (m :: * -> *) a.
MonadContext c m =>
(Record c -> Record c) -> m a -> m a
localContext Record c -> Record c
f (forall {k} (f :: k -> *) (a :: k). IdentityT f a -> f a
runIdentityT IdentityT m a
m)

instance MonadContext c m => MonadContext c (ExceptT e m) where
  askContext :: ExceptT e m (Record c)
askContext = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (c :: [*]) (m :: * -> *). MonadContext c m => m (Record c)
askContext
  localContext :: forall a. (Record c -> Record c) -> ExceptT e m a -> ExceptT e m a
localContext Record c -> Record c
f ExceptT e m a
m = forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ forall (c :: [*]) (m :: * -> *) a.
MonadContext c m =>
(Record c -> Record c) -> m a -> m a
localContext Record c -> Record c
f (forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT e m a
m)

instance MonadContext c m => MonadContext c (ContT r m) where
  askContext :: ContT r m (Record c)
askContext = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (c :: [*]) (m :: * -> *). MonadContext c m => m (Record c)
askContext
  localContext :: forall a. (Record c -> Record c) -> ContT r m a -> ContT r m a
localContext Record c -> Record c
f ContT r m a
m = forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT forall a b. (a -> b) -> a -> b
$ \ a -> m r
k -> forall (c :: [*]) (m :: * -> *) a.
MonadContext c m =>
(Record c -> Record c) -> m a -> m a
localContext Record c -> Record c
f (forall {k} (r :: k) (m :: k -> *) a.
ContT r m a -> (a -> m r) -> m r
runContT ContT r m a
m a -> m r
k)

instance (MonadContext c m, Monoid w) => MonadContext c (Strict.RWST r w s m) where
  askContext :: RWST r w s m (Record c)
askContext = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (c :: [*]) (m :: * -> *). MonadContext c m => m (Record c)
askContext
  localContext :: forall a.
(Record c -> Record c) -> RWST r w s m a -> RWST r w s m a
localContext Record c -> Record c
f RWST r w s m a
m = forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Strict.RWST forall a b. (a -> b) -> a -> b
$ \ r
r s
s -> forall (c :: [*]) (m :: * -> *) a.
MonadContext c m =>
(Record c -> Record c) -> m a -> m a
localContext Record c -> Record c
f (forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
Strict.runRWST RWST r w s m a
m r
r s
s)

instance (MonadContext c m, Monoid w) => MonadContext c (Lazy.RWST r w s m) where
  askContext :: RWST r w s m (Record c)
askContext = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (c :: [*]) (m :: * -> *). MonadContext c m => m (Record c)
askContext
  localContext :: forall a.
(Record c -> Record c) -> RWST r w s m a -> RWST r w s m a
localContext Record c -> Record c
f RWST r w s m a
m = forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Lazy.RWST forall a b. (a -> b) -> a -> b
$ \ r
r s
s -> forall (c :: [*]) (m :: * -> *) a.
MonadContext c m =>
(Record c -> Record c) -> m a -> m a
localContext Record c -> Record c
f (forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
Lazy.runRWST RWST r w s m a
m r
r s
s)

-- |Project some value out of the context using a function.
asksContext :: MonadContext c m => (Record c -> a) -> m a
asksContext :: forall (c :: [*]) (m :: * -> *) a.
MonadContext c m =>
(Record c -> a) -> m a
asksContext Record c -> a
f = Record c -> a
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (c :: [*]) (m :: * -> *). MonadContext c m => m (Record c)
askContext

-- |Project some value out of the context using a lens (typically a field lens).
askField :: MonadContext c m => Getter (Record c) a -> m a
askField :: forall (c :: [*]) (m :: * -> *) a.
MonadContext c m =>
Getter (Record c) a -> m a
askField Getter (Record c) a
l = forall (c :: [*]) (m :: * -> *) a.
MonadContext c m =>
(Record c -> a) -> m a
asksContext forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getter (Record c) a
l

-- |Monad transformer which adds an implicit environment which is a record. Isomorphic to @ReaderT (Record c) m@.
newtype ContextT (c :: [*]) (m :: (* -> *)) a = ContextT { forall (c :: [*]) (m :: * -> *) a.
ContextT c m a -> Record c -> m a
runContextT :: Record c -> m a }

-- |Run some action in a given context, equivalent to 'runContextT' but with the arguments flipped.
runInContext :: Record c -> ContextT c m a -> m a
runInContext :: forall (c :: [*]) (m :: * -> *) a.
Record c -> ContextT c m a -> m a
runInContext = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (c :: [*]) (m :: * -> *) a.
ContextT c m a -> Record c -> m a
runContextT

-- |Permute the current context with a function and then run some action with that modified context.
withContext :: (Record c' -> Record c) -> ContextT c m a -> ContextT c' m a
withContext :: forall (c' :: [*]) (c :: [*]) (m :: * -> *) a.
(Record c' -> Record c) -> ContextT c m a -> ContextT c' m a
withContext Record c' -> Record c
f ContextT c m a
action = forall (c :: [*]) (m :: * -> *) a.
(Record c -> m a) -> ContextT c m a
ContextT forall a b. (a -> b) -> a -> b
$ \ Record c'
c' -> forall (c :: [*]) (m :: * -> *) a.
ContextT c m a -> Record c -> m a
runContextT ContextT c m a
action (Record c' -> Record c
f Record c'
c')

-- |Transform the monad underlying a 'ContextT' using a natural transform.
mapContextT :: (m a -> n b) -> ContextT c m a -> ContextT c n b
mapContextT :: forall (m :: * -> *) a (n :: * -> *) b (c :: [*]).
(m a -> n b) -> ContextT c m a -> ContextT c n b
mapContextT m a -> n b
f ContextT c m a
m = forall (c :: [*]) (m :: * -> *) a.
(Record c -> m a) -> ContextT c m a
ContextT forall a b. (a -> b) -> a -> b
$ m a -> n b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (c :: [*]) (m :: * -> *) a.
ContextT c m a -> Record c -> m a
runContextT ContextT c m a
m

instance Monad m => MonadContext c (ContextT c m) where
  askContext :: ContextT c m (Record c)
askContext = forall (c :: [*]) (m :: * -> *) a.
(Record c -> m a) -> ContextT c m a
ContextT forall (f :: * -> *) a. Applicative f => a -> f a
pure
  localContext :: forall a.
(Record c -> Record c) -> ContextT c m a -> ContextT c m a
localContext Record c -> Record c
f ContextT c m a
action = forall (c :: [*]) (m :: * -> *) a.
(Record c -> m a) -> ContextT c m a
ContextT forall a b. (a -> b) -> a -> b
$ forall (c :: [*]) (m :: * -> *) a.
ContextT c m a -> Record c -> m a
runContextT ContextT c m a
action forall b c a. (b -> c) -> (a -> b) -> a -> c
. Record c -> Record c
f

instance Functor m => Functor (ContextT c m) where
  fmap :: forall a b. (a -> b) -> ContextT c m a -> ContextT c m b
fmap a -> b
f ContextT c m a
clt = forall (c :: [*]) (m :: * -> *) a.
(Record c -> m a) -> ContextT c m a
ContextT forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (c :: [*]) (m :: * -> *) a.
ContextT c m a -> Record c -> m a
runContextT ContextT c m a
clt

instance Applicative m => Applicative (ContextT c m) where
  pure :: forall a. a -> ContextT c m a
pure = forall (c :: [*]) (m :: * -> *) a.
(Record c -> m a) -> ContextT c m a
ContextT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
  ContextT c m (a -> b)
cltab <*> :: forall a b.
ContextT c m (a -> b) -> ContextT c m a -> ContextT c m b
<*> ContextT c m a
clta = forall (c :: [*]) (m :: * -> *) a.
(Record c -> m a) -> ContextT c m a
ContextT forall a b. (a -> b) -> a -> b
$ \ Record c
r -> forall (c :: [*]) (m :: * -> *) a.
ContextT c m a -> Record c -> m a
runContextT ContextT c m (a -> b)
cltab Record c
r forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (c :: [*]) (m :: * -> *) a.
ContextT c m a -> Record c -> m a
runContextT ContextT c m a
clta Record c
r

instance Alternative m => Alternative (ContextT c m) where
  empty :: forall a. ContextT c m a
empty = forall (c :: [*]) (m :: * -> *) a.
(Record c -> m a) -> ContextT c m a
ContextT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Alternative f => f a
empty
  ContextT c m a
m <|> :: forall a. ContextT c m a -> ContextT c m a -> ContextT c m a
<|> ContextT c m a
n = forall (c :: [*]) (m :: * -> *) a.
(Record c -> m a) -> ContextT c m a
ContextT forall a b. (a -> b) -> a -> b
$ \ Record c
r -> forall (c :: [*]) (m :: * -> *) a.
ContextT c m a -> Record c -> m a
runContextT ContextT c m a
m Record c
r forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (c :: [*]) (m :: * -> *) a.
ContextT c m a -> Record c -> m a
runContextT ContextT c m a
n Record c
r

instance Monad m => Monad (ContextT c m) where
  ContextT c m a
clt >>= :: forall a b.
ContextT c m a -> (a -> ContextT c m b) -> ContextT c m b
>>= a -> ContextT c m b
k = forall (c :: [*]) (m :: * -> *) a.
(Record c -> m a) -> ContextT c m a
ContextT forall a b. (a -> b) -> a -> b
$ \ Record c
ctx -> do
    a
a <- forall (c :: [*]) (m :: * -> *) a.
ContextT c m a -> Record c -> m a
runContextT ContextT c m a
clt Record c
ctx
    forall (c :: [*]) (m :: * -> *) a.
ContextT c m a -> Record c -> m a
runContextT (a -> ContextT c m b
k a
a) Record c
ctx

#if !MIN_VERSION_base(4,13,0)
  fail = ContextT . const . fail
#endif

instance MonadIO m => MonadIO (ContextT c m) where
  liftIO :: forall a. IO a -> ContextT c m a
liftIO = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

instance MonadTrans (ContextT c) where
  lift :: forall (m :: * -> *) a. Monad m => m a -> ContextT c m a
lift = forall (c :: [*]) (m :: * -> *) a.
(Record c -> m a) -> ContextT c m a
ContextT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const

instance MonadTransControl (ContextT c) where
  type StT (ContextT c) a = a
  liftWith :: forall (m :: * -> *) a.
Monad m =>
(Run (ContextT c) -> m a) -> ContextT c m a
liftWith Run (ContextT c) -> m a
f = forall (c :: [*]) (m :: * -> *) a.
(Record c -> m a) -> ContextT c m a
ContextT forall a b. (a -> b) -> a -> b
$ \ Record c
r -> Run (ContextT c) -> m a
f forall a b. (a -> b) -> a -> b
$ \ ContextT c n b
t -> forall (c :: [*]) (m :: * -> *) a.
ContextT c m a -> Record c -> m a
runContextT ContextT c n b
t Record c
r
  restoreT :: forall (m :: * -> *) a.
Monad m =>
m (StT (ContextT c) a) -> ContextT c m a
restoreT = forall (c :: [*]) (m :: * -> *) a.
(Record c -> m a) -> ContextT c m a
ContextT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const

instance MonadBase b m => MonadBase b (ContextT c m) where
  liftBase :: forall α. b α -> ContextT c m α
liftBase = forall (c :: [*]) (m :: * -> *) a.
(Record c -> m a) -> ContextT c m a
ContextT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase

instance MonadBaseControl b m => MonadBaseControl b (ContextT c m) where
  type StM (ContextT c m) a = StM m a
  restoreM :: forall a. StM (ContextT c m) a -> ContextT c m a
restoreM = forall (c :: [*]) (m :: * -> *) a.
(Record c -> m a) -> ContextT c m a
ContextT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM
  liftBaseWith :: forall a. (RunInBase (ContextT c m) b -> b a) -> ContextT c m a
liftBaseWith RunInBase (ContextT c m) b -> b a
f =
    forall (c :: [*]) (m :: * -> *) a.
(Record c -> m a) -> ContextT c m a
ContextT forall a b. (a -> b) -> a -> b
$ \ Record c
c ->
      forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
(RunInBase m b -> b a) -> m a
liftBaseWith forall a b. (a -> b) -> a -> b
$ \ RunInBase m b
runInBase ->
        RunInBase (ContextT c m) b -> b a
f (RunInBase m b
runInBase forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a -> b) -> a -> b
$ Record c
c) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (c :: [*]) (m :: * -> *) a.
ContextT c m a -> Record c -> m a
runContextT)

instance MonadUnliftIO m => MonadUnliftIO (ContextT c m) where
#if !MIN_VERSION_unliftio_core(0,2,0)
  {-# INLINE askUnliftIO #-}
  askUnliftIO = ContextT $ \c ->
                withUnliftIO $ \u ->
                return (UnliftIO (unliftIO u . flip runContextT c))
#endif
#if MIN_VERSION_unliftio_core(0,1,1)
  {-# INLINE withRunInIO #-}
  withRunInIO :: forall b.
((forall a. ContextT c m a -> IO a) -> IO b) -> ContextT c m b
withRunInIO (forall a. ContextT c m a -> IO a) -> IO b
inner =
    forall (c :: [*]) (m :: * -> *) a.
(Record c -> m a) -> ContextT c m a
ContextT forall a b. (a -> b) -> a -> b
$ \Record c
c ->
    forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run ->
    (forall a. ContextT c m a -> IO a) -> IO b
inner (forall a. m a -> IO a
run forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (c :: [*]) (m :: * -> *) a.
ContextT c m a -> Record c -> m a
runContextT Record c
c)
#endif

instance MonadReader r m => MonadReader r (ContextT c m) where
  ask :: ContextT c m r
ask    = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall r (m :: * -> *). MonadReader r m => m r
ask
  local :: forall a. (r -> r) -> ContextT c m a -> ContextT c m a
local  = forall (m :: * -> *) a (n :: * -> *) b (c :: [*]).
(m a -> n b) -> ContextT c m a -> ContextT c n b
mapContextT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local
  reader :: forall a. (r -> a) -> ContextT c m a
reader = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
reader

instance MonadWriter w m => MonadWriter w (ContextT c m) where
  writer :: forall a. (a, w) -> ContextT c m a
writer = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w (m :: * -> *) a. MonadWriter w m => (a, w) -> m a
writer
  tell :: w -> ContextT c m ()
tell   = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell
  listen :: forall a. ContextT c m a -> ContextT c m (a, w)
listen = forall (m :: * -> *) a (n :: * -> *) b (c :: [*]).
(m a -> n b) -> ContextT c m a -> ContextT c n b
mapContextT forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen
  pass :: forall a. ContextT c m (a, w -> w) -> ContextT c m a
pass   = forall (m :: * -> *) a (n :: * -> *) b (c :: [*]).
(m a -> n b) -> ContextT c m a -> ContextT c n b
mapContextT forall w (m :: * -> *) a. MonadWriter w m => m (a, w -> w) -> m a
pass

instance MonadState s m => MonadState s (ContextT c m) where
  get :: ContextT c m s
get   = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *). MonadState s m => m s
get
  put :: s -> ContextT c m ()
put   = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *). MonadState s m => s -> m ()
put
  state :: forall a. (s -> (a, s)) -> ContextT c m a
state = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state

instance MonadRWS r w s m => MonadRWS r w s (ContextT c m)

instance MonadFix m => MonadFix (ContextT c m) where
  mfix :: forall a. (a -> ContextT c m a) -> ContextT c m a
mfix a -> ContextT c m a
f = forall (c :: [*]) (m :: * -> *) a.
(Record c -> m a) -> ContextT c m a
ContextT forall a b. (a -> b) -> a -> b
$ \ Record c
r -> forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix forall a b. (a -> b) -> a -> b
$ \ a
a -> forall (c :: [*]) (m :: * -> *) a.
ContextT c m a -> Record c -> m a
runContextT (a -> ContextT c m a
f a
a) Record c
r

instance MonadFail m => MonadFail (ContextT c m) where
  fail :: forall a. String -> ContextT c m a
fail = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadFail m => String -> m a
MonadFail.fail

instance MonadError e m => MonadError e (ContextT c m) where
  throwError :: forall a. e -> ContextT c m a
throwError = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
  catchError :: forall a. ContextT c m a -> (e -> ContextT c m a) -> ContextT c m a
catchError ContextT c m a
m e -> ContextT c m a
h = forall (c :: [*]) (m :: * -> *) a.
(Record c -> m a) -> ContextT c m a
ContextT forall a b. (a -> b) -> a -> b
$ \ Record c
r -> forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError (forall (c :: [*]) (m :: * -> *) a.
ContextT c m a -> Record c -> m a
runContextT ContextT c m a
m Record c
r) (\ e
e -> forall (c :: [*]) (m :: * -> *) a.
ContextT c m a -> Record c -> m a
runContextT (e -> ContextT c m a
h e
e) Record c
r)

instance MonadPlus m => MonadPlus (ContextT c m) where
  mzero :: forall a. ContextT c m a
mzero = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *) a. MonadPlus m => m a
mzero
  ContextT c m a
m mplus :: forall a. ContextT c m a -> ContextT c m a -> ContextT c m a
`mplus` ContextT c m a
n = forall (c :: [*]) (m :: * -> *) a.
(Record c -> m a) -> ContextT c m a
ContextT forall a b. (a -> b) -> a -> b
$ \ Record c
r -> forall (c :: [*]) (m :: * -> *) a.
ContextT c m a -> Record c -> m a
runContextT ContextT c m a
m Record c
r forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` forall (c :: [*]) (m :: * -> *) a.
ContextT c m a -> Record c -> m a
runContextT ContextT c m a
n Record c
r

instance MonadCont m => MonadCont (ContextT c m) where
  callCC :: forall a b.
((a -> ContextT c m b) -> ContextT c m a) -> ContextT c m a
callCC (a -> ContextT c m b) -> ContextT c m a
f = forall (c :: [*]) (m :: * -> *) a.
(Record c -> m a) -> ContextT c m a
ContextT forall a b. (a -> b) -> a -> b
$ \ Record c
r -> forall (m :: * -> *) a b. MonadCont m => ((a -> m b) -> m a) -> m a
callCC forall a b. (a -> b) -> a -> b
$ \ a -> m b
c -> forall (c :: [*]) (m :: * -> *) a.
ContextT c m a -> Record c -> m a
runContextT ((a -> ContextT c m b) -> ContextT c m a
f (forall (c :: [*]) (m :: * -> *) a.
(Record c -> m a) -> ContextT c m a
ContextT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m b
c)) Record c
r

instance MonadThrow m => MonadThrow (ContextT c m) where
  throwM :: forall e a. Exception e => e -> ContextT c m a
throwM e
e = forall (c :: [*]) (m :: * -> *) a.
(Record c -> m a) -> ContextT c m a
ContextT forall a b. (a -> b) -> a -> b
$ \ Record c
_ -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM e
e

instance MonadCatch m => MonadCatch (ContextT c m) where
  catch :: forall e a.
Exception e =>
ContextT c m a -> (e -> ContextT c m a) -> ContextT c m a
catch ContextT c m a
m e -> ContextT c m a
h = forall (c :: [*]) (m :: * -> *) a.
(Record c -> m a) -> ContextT c m a
ContextT forall a b. (a -> b) -> a -> b
$ \ Record c
r -> forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch (forall (c :: [*]) (m :: * -> *) a.
ContextT c m a -> Record c -> m a
runContextT ContextT c m a
m Record c
r) (\ e
e -> forall (c :: [*]) (m :: * -> *) a.
ContextT c m a -> Record c -> m a
runContextT (e -> ContextT c m a
h e
e) Record c
r)

instance MonadMask m => MonadMask (ContextT c m) where
  mask :: forall b.
((forall a. ContextT c m a -> ContextT c m a) -> ContextT c m b)
-> ContextT c m b
mask (forall a. ContextT c m a -> ContextT c m a) -> ContextT c m b
a = forall (c :: [*]) (m :: * -> *) a.
(Record c -> m a) -> ContextT c m a
ContextT forall a b. (a -> b) -> a -> b
$ \Record c
e -> forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
mask forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
u -> forall (c :: [*]) (m :: * -> *) a.
ContextT c m a -> Record c -> m a
runContextT ((forall a. ContextT c m a -> ContextT c m a) -> ContextT c m b
a forall a b. (a -> b) -> a -> b
$ forall a (c' :: [*]).
(m a -> m a) -> ContextT c' m a -> ContextT c' m a
q forall a. m a -> m a
u) Record c
e
    where q :: (m a -> m a) -> ContextT c' m a -> ContextT c' m a
          q :: forall a (c' :: [*]).
(m a -> m a) -> ContextT c' m a -> ContextT c' m a
q m a -> m a
u (ContextT Record c' -> m a
b) = forall (c :: [*]) (m :: * -> *) a.
(Record c -> m a) -> ContextT c m a
ContextT (m a -> m a
u forall b c a. (b -> c) -> (a -> b) -> a -> c
. Record c' -> m a
b)
  uninterruptibleMask :: forall b.
((forall a. ContextT c m a -> ContextT c m a) -> ContextT c m b)
-> ContextT c m b
uninterruptibleMask (forall a. ContextT c m a -> ContextT c m a) -> ContextT c m b
a =
    forall (c :: [*]) (m :: * -> *) a.
(Record c -> m a) -> ContextT c m a
ContextT forall a b. (a -> b) -> a -> b
$ \Record c
e -> forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
uninterruptibleMask forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
u -> forall (c :: [*]) (m :: * -> *) a.
ContextT c m a -> Record c -> m a
runContextT ((forall a. ContextT c m a -> ContextT c m a) -> ContextT c m b
a forall a b. (a -> b) -> a -> b
$ forall a (c' :: [*]).
(m a -> m a) -> ContextT c' m a -> ContextT c' m a
q forall a. m a -> m a
u) Record c
e
      where q :: (m a -> m a) -> ContextT c' m a -> ContextT c' m a
            q :: forall a (c' :: [*]).
(m a -> m a) -> ContextT c' m a -> ContextT c' m a
q m a -> m a
u (ContextT Record c' -> m a
b) = forall (c :: [*]) (m :: * -> *) a.
(Record c -> m a) -> ContextT c m a
ContextT (m a -> m a
u forall b c a. (b -> c) -> (a -> b) -> a -> c
. Record c' -> m a
b)

#if MIN_VERSION_exceptions(0,9,0)
  generalBracket :: forall a b c.
ContextT c m a
-> (a -> ExitCase b -> ContextT c m c)
-> (a -> ContextT c m b)
-> ContextT c m (b, c)
generalBracket ContextT c m a
acquire a -> ExitCase b -> ContextT c m c
release a -> ContextT c m b
use =
    forall (c :: [*]) (m :: * -> *) a.
(Record c -> m a) -> ContextT c m a
ContextT forall a b. (a -> b) -> a -> b
$ \ Record c
r ->
      forall (m :: * -> *) a b c.
MonadMask m =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
generalBracket
        (forall (c :: [*]) (m :: * -> *) a.
ContextT c m a -> Record c -> m a
runContextT ContextT c m a
acquire Record c
r)
        (\ a
a ExitCase b
ec -> forall (c :: [*]) (m :: * -> *) a.
ContextT c m a -> Record c -> m a
runContextT (a -> ExitCase b -> ContextT c m c
release a
a ExitCase b
ec) Record c
r)
        (\ a
a -> forall (c :: [*]) (m :: * -> *) a.
ContextT c m a -> Record c -> m a
runContextT (a -> ContextT c m b
use a
a) Record c
r)
#endif