{-# 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 = Record c -> Record c
forall a. a -> a
id
  localContext :: (Record c -> Record c) -> (Record c -> a) -> Record c -> a
localContext Record c -> Record c
f = ((Record c -> a) -> (Record c -> Record c) -> Record c -> a
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 = m (Record c) -> ReaderT r m (Record c)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Record c)
forall (c :: [*]) (m :: * -> *). MonadContext c m => m (Record c)
askContext
  localContext :: (Record c -> Record c) -> ReaderT r m a -> ReaderT r m a
localContext Record c -> Record c
f ReaderT r m a
m = (r -> m a) -> ReaderT r m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((r -> m a) -> ReaderT r m a) -> (r -> m a) -> ReaderT r m a
forall a b. (a -> b) -> a -> b
$ \ r
r -> (Record c -> Record c) -> m a -> m a
forall (c :: [*]) (m :: * -> *) a.
MonadContext c m =>
(Record c -> Record c) -> m a -> m a
localContext Record c -> Record c
f (ReaderT r m a -> r -> m a
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 = m (Record c) -> MaybeT m (Record c)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Record c)
forall (c :: [*]) (m :: * -> *). MonadContext c m => m (Record c)
askContext
  localContext :: (Record c -> Record c) -> MaybeT m a -> MaybeT m a
localContext Record c -> Record c
f MaybeT m a
m = m (Maybe a) -> MaybeT m a
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe a) -> MaybeT m a) -> m (Maybe a) -> MaybeT m a
forall a b. (a -> b) -> a -> b
$ (Record c -> Record c) -> m (Maybe a) -> m (Maybe a)
forall (c :: [*]) (m :: * -> *) a.
MonadContext c m =>
(Record c -> Record c) -> m a -> m a
localContext Record c -> Record c
f (MaybeT m a -> m (Maybe a)
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 = m (Record c) -> WriterT w m (Record c)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Record c)
forall (c :: [*]) (m :: * -> *). MonadContext c m => m (Record c)
askContext
  localContext :: (Record c -> Record c) -> WriterT w m a -> WriterT w m a
localContext Record c -> Record c
f WriterT w m a
m = m (a, w) -> WriterT w m a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Strict.WriterT (m (a, w) -> WriterT w m a) -> m (a, w) -> WriterT w m a
forall a b. (a -> b) -> a -> b
$ (Record c -> Record c) -> m (a, w) -> m (a, w)
forall (c :: [*]) (m :: * -> *) a.
MonadContext c m =>
(Record c -> Record c) -> m a -> m a
localContext Record c -> Record c
f (WriterT w m a -> m (a, w)
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 = m (Record c) -> WriterT w m (Record c)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Record c)
forall (c :: [*]) (m :: * -> *). MonadContext c m => m (Record c)
askContext
  localContext :: (Record c -> Record c) -> WriterT w m a -> WriterT w m a
localContext Record c -> Record c
f WriterT w m a
m = m (a, w) -> WriterT w m a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Lazy.WriterT (m (a, w) -> WriterT w m a) -> m (a, w) -> WriterT w m a
forall a b. (a -> b) -> a -> b
$ (Record c -> Record c) -> m (a, w) -> m (a, w)
forall (c :: [*]) (m :: * -> *) a.
MonadContext c m =>
(Record c -> Record c) -> m a -> m a
localContext Record c -> Record c
f (WriterT w m a -> m (a, w)
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 = m (Record c) -> StateT s m (Record c)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Record c)
forall (c :: [*]) (m :: * -> *). MonadContext c m => m (Record c)
askContext
  localContext :: (Record c -> Record c) -> StateT s m a -> StateT s m a
localContext Record c -> Record c
f StateT s m a
m = (s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Strict.StateT ((s -> m (a, s)) -> StateT s m a)
-> (s -> m (a, s)) -> StateT s m a
forall a b. (a -> b) -> a -> b
$ \ s
s -> (Record c -> Record c) -> m (a, s) -> m (a, s)
forall (c :: [*]) (m :: * -> *) a.
MonadContext c m =>
(Record c -> Record c) -> m a -> m a
localContext Record c -> Record c
f (StateT s m a -> s -> m (a, s)
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 = m (Record c) -> StateT s m (Record c)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Record c)
forall (c :: [*]) (m :: * -> *). MonadContext c m => m (Record c)
askContext
  localContext :: (Record c -> Record c) -> StateT s m a -> StateT s m a
localContext Record c -> Record c
f StateT s m a
m = (s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Lazy.StateT ((s -> m (a, s)) -> StateT s m a)
-> (s -> m (a, s)) -> StateT s m a
forall a b. (a -> b) -> a -> b
$ \ s
s -> (Record c -> Record c) -> m (a, s) -> m (a, s)
forall (c :: [*]) (m :: * -> *) a.
MonadContext c m =>
(Record c -> Record c) -> m a -> m a
localContext Record c -> Record c
f (StateT s m a -> s -> m (a, s)
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 = m (Record c) -> IdentityT m (Record c)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Record c)
forall (c :: [*]) (m :: * -> *). MonadContext c m => m (Record c)
askContext
  localContext :: (Record c -> Record c) -> IdentityT m a -> IdentityT m a
localContext Record c -> Record c
f IdentityT m a
m = m a -> IdentityT m a
forall k (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT (m a -> IdentityT m a) -> m a -> IdentityT m a
forall a b. (a -> b) -> a -> b
$ (Record c -> Record c) -> m a -> m a
forall (c :: [*]) (m :: * -> *) a.
MonadContext c m =>
(Record c -> Record c) -> m a -> m a
localContext Record c -> Record c
f (IdentityT m a -> m a
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 = m (Record c) -> ExceptT e m (Record c)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Record c)
forall (c :: [*]) (m :: * -> *). MonadContext c m => m (Record c)
askContext
  localContext :: (Record c -> Record c) -> ExceptT e m a -> ExceptT e m a
localContext Record c -> Record c
f ExceptT e m a
m = m (Either e a) -> ExceptT e m a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either e a) -> ExceptT e m a)
-> m (Either e a) -> ExceptT e m a
forall a b. (a -> b) -> a -> b
$ (Record c -> Record c) -> m (Either e a) -> m (Either e a)
forall (c :: [*]) (m :: * -> *) a.
MonadContext c m =>
(Record c -> Record c) -> m a -> m a
localContext Record c -> Record c
f (ExceptT e m a -> m (Either e a)
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 = m (Record c) -> ContT r m (Record c)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Record c)
forall (c :: [*]) (m :: * -> *). MonadContext c m => m (Record c)
askContext
  localContext :: (Record c -> Record c) -> ContT r m a -> ContT r m a
localContext Record c -> Record c
f ContT r m a
m = ((a -> m r) -> m r) -> ContT r m a
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((a -> m r) -> m r) -> ContT r m a)
-> ((a -> m r) -> m r) -> ContT r m a
forall a b. (a -> b) -> a -> b
$ \ a -> m r
k -> (Record c -> Record c) -> m r -> m r
forall (c :: [*]) (m :: * -> *) a.
MonadContext c m =>
(Record c -> Record c) -> m a -> m a
localContext Record c -> Record c
f (ContT r m a -> (a -> m r) -> m r
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 = m (Record c) -> RWST r w s m (Record c)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Record c)
forall (c :: [*]) (m :: * -> *). MonadContext c m => m (Record c)
askContext
  localContext :: (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 = (r -> s -> m (a, s, w)) -> RWST r w s m a
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Strict.RWST ((r -> s -> m (a, s, w)) -> RWST r w s m a)
-> (r -> s -> m (a, s, w)) -> RWST r w s m a
forall a b. (a -> b) -> a -> b
$ \ r
r s
s -> (Record c -> Record c) -> m (a, s, w) -> m (a, s, w)
forall (c :: [*]) (m :: * -> *) a.
MonadContext c m =>
(Record c -> Record c) -> m a -> m a
localContext Record c -> Record c
f (RWST r w s m a -> r -> s -> m (a, s, w)
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 = m (Record c) -> RWST r w s m (Record c)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Record c)
forall (c :: [*]) (m :: * -> *). MonadContext c m => m (Record c)
askContext
  localContext :: (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 = (r -> s -> m (a, s, w)) -> RWST r w s m a
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Lazy.RWST ((r -> s -> m (a, s, w)) -> RWST r w s m a)
-> (r -> s -> m (a, s, w)) -> RWST r w s m a
forall a b. (a -> b) -> a -> b
$ \ r
r s
s -> (Record c -> Record c) -> m (a, s, w) -> m (a, s, w)
forall (c :: [*]) (m :: * -> *) a.
MonadContext c m =>
(Record c -> Record c) -> m a -> m a
localContext Record c -> Record c
f (RWST r w s m a -> r -> s -> m (a, s, w)
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 :: (Record c -> a) -> m a
asksContext Record c -> a
f = Record c -> a
f (Record c -> a) -> m (Record c) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Record c)
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 :: Getter (Record c) a -> m a
askField Getter (Record c) a
l = (Record c -> a) -> m a
forall (c :: [*]) (m :: * -> *) a.
MonadContext c m =>
(Record c -> a) -> m a
asksContext ((Record c -> a) -> m a) -> (Record c -> a) -> m a
forall a b. (a -> b) -> a -> b
$ Getting a (Record c) a -> Record c -> a
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting a (Record c) a
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 { 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 :: Record c -> ContextT c m a -> m a
runInContext = (ContextT c m a -> Record c -> m a)
-> Record c -> ContextT c m a -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ContextT c m a -> Record c -> m a
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 :: (Record c' -> Record c) -> ContextT c m a -> ContextT c' m a
withContext Record c' -> Record c
f ContextT c m a
action = (Record c' -> m a) -> ContextT c' m a
forall (c :: [*]) (m :: * -> *) a.
(Record c -> m a) -> ContextT c m a
ContextT ((Record c' -> m a) -> ContextT c' m a)
-> (Record c' -> m a) -> ContextT c' m a
forall a b. (a -> b) -> a -> b
$ \ Record c'
c' -> ContextT c m a -> Record c -> m a
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 :: (m a -> n b) -> ContextT c m a -> ContextT c n b
mapContextT m a -> n b
f ContextT c m a
m = (Record c -> n b) -> ContextT c n b
forall (c :: [*]) (m :: * -> *) a.
(Record c -> m a) -> ContextT c m a
ContextT ((Record c -> n b) -> ContextT c n b)
-> (Record c -> n b) -> ContextT c n b
forall a b. (a -> b) -> a -> b
$ m a -> n b
f (m a -> n b) -> (Record c -> m a) -> Record c -> n b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContextT c m a -> Record c -> m a
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 = (Record c -> m (Record c)) -> ContextT c m (Record c)
forall (c :: [*]) (m :: * -> *) a.
(Record c -> m a) -> ContextT c m a
ContextT Record c -> m (Record c)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  localContext :: (Record c -> Record c) -> ContextT c m a -> ContextT c m a
localContext Record c -> Record c
f ContextT c m a
action = (Record c -> m a) -> ContextT c m a
forall (c :: [*]) (m :: * -> *) a.
(Record c -> m a) -> ContextT c m a
ContextT ((Record c -> m a) -> ContextT c m a)
-> (Record c -> m a) -> ContextT c m a
forall a b. (a -> b) -> a -> b
$ ContextT c m a -> Record c -> m a
forall (c :: [*]) (m :: * -> *) a.
ContextT c m a -> Record c -> m a
runContextT ContextT c m a
action (Record c -> m a) -> (Record c -> Record c) -> Record c -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Record c -> Record c
f

instance Functor m => Functor (ContextT c m) where
  fmap :: (a -> b) -> ContextT c m a -> ContextT c m b
fmap a -> b
f ContextT c m a
clt = (Record c -> m b) -> ContextT c m b
forall (c :: [*]) (m :: * -> *) a.
(Record c -> m a) -> ContextT c m a
ContextT ((Record c -> m b) -> ContextT c m b)
-> (Record c -> m b) -> ContextT c m b
forall a b. (a -> b) -> a -> b
$ (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (m a -> m b) -> (Record c -> m a) -> Record c -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContextT c m a -> Record c -> m a
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 :: a -> ContextT c m a
pure = (Record c -> m a) -> ContextT c m a
forall (c :: [*]) (m :: * -> *) a.
(Record c -> m a) -> ContextT c m a
ContextT ((Record c -> m a) -> ContextT c m a)
-> (a -> Record c -> m a) -> a -> ContextT c m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> Record c -> m a
forall a b. a -> b -> a
const (m a -> Record c -> m a) -> (a -> m a) -> a -> Record c -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  ContextT c m (a -> b)
cltab <*> :: ContextT c m (a -> b) -> ContextT c m a -> ContextT c m b
<*> ContextT c m a
clta = (Record c -> m b) -> ContextT c m b
forall (c :: [*]) (m :: * -> *) a.
(Record c -> m a) -> ContextT c m a
ContextT ((Record c -> m b) -> ContextT c m b)
-> (Record c -> m b) -> ContextT c m b
forall a b. (a -> b) -> a -> b
$ \ Record c
r -> ContextT c m (a -> b) -> Record c -> m (a -> b)
forall (c :: [*]) (m :: * -> *) a.
ContextT c m a -> Record c -> m a
runContextT ContextT c m (a -> b)
cltab Record c
r m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ContextT c m a -> Record c -> m a
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 :: ContextT c m a
empty = (Record c -> m a) -> ContextT c m a
forall (c :: [*]) (m :: * -> *) a.
(Record c -> m a) -> ContextT c m a
ContextT ((Record c -> m a) -> ContextT c m a)
-> (m a -> Record c -> m a) -> m a -> ContextT c m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> Record c -> m a
forall a b. a -> b -> a
const (m a -> ContextT c m a) -> m a -> ContextT c m a
forall a b. (a -> b) -> a -> b
$ m a
forall (f :: * -> *) a. Alternative f => f a
empty
  ContextT c m a
m <|> :: ContextT c m a -> ContextT c m a -> ContextT c m a
<|> ContextT c m a
n = (Record c -> m a) -> ContextT c m a
forall (c :: [*]) (m :: * -> *) a.
(Record c -> m a) -> ContextT c m a
ContextT ((Record c -> m a) -> ContextT c m a)
-> (Record c -> m a) -> ContextT c m a
forall a b. (a -> b) -> a -> b
$ \ Record c
r -> ContextT c m a -> Record c -> m a
forall (c :: [*]) (m :: * -> *) a.
ContextT c m a -> Record c -> m a
runContextT ContextT c m a
m Record c
r m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ContextT c m a -> Record c -> m 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 >>= :: ContextT c m a -> (a -> ContextT c m b) -> ContextT c m b
>>= a -> ContextT c m b
k = (Record c -> m b) -> ContextT c m b
forall (c :: [*]) (m :: * -> *) a.
(Record c -> m a) -> ContextT c m a
ContextT ((Record c -> m b) -> ContextT c m b)
-> (Record c -> m b) -> ContextT c m b
forall a b. (a -> b) -> a -> b
$ \ Record c
ctx -> do
    a
a <- ContextT c m a -> Record c -> m a
forall (c :: [*]) (m :: * -> *) a.
ContextT c m a -> Record c -> m a
runContextT ContextT c m a
clt Record c
ctx
    ContextT c m b -> Record c -> m b
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 :: IO a -> ContextT c m a
liftIO = m a -> ContextT c m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ContextT c m a) -> (IO a -> m a) -> IO a -> ContextT c m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

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

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

instance MonadBase b m => MonadBase b (ContextT c m) where
  liftBase :: b α -> ContextT c m α
liftBase = (Record c -> m α) -> ContextT c m α
forall (c :: [*]) (m :: * -> *) a.
(Record c -> m a) -> ContextT c m a
ContextT ((Record c -> m α) -> ContextT c m α)
-> (b α -> Record c -> m α) -> b α -> ContextT c m α
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m α -> Record c -> m α
forall a b. a -> b -> a
const (m α -> Record c -> m α) -> (b α -> m α) -> b α -> Record c -> m α
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b α -> m α
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 :: StM (ContextT c m) a -> ContextT c m a
restoreM = (Record c -> m a) -> ContextT c m a
forall (c :: [*]) (m :: * -> *) a.
(Record c -> m a) -> ContextT c m a
ContextT ((Record c -> m a) -> ContextT c m a)
-> (StM m a -> Record c -> m a) -> StM m a -> ContextT c m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> Record c -> m a
forall a b. a -> b -> a
const (m a -> Record c -> m a)
-> (StM m a -> m a) -> StM m a -> Record c -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StM m a -> m a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM
  liftBaseWith :: (RunInBase (ContextT c m) b -> b a) -> ContextT c m a
liftBaseWith RunInBase (ContextT c m) b -> b a
f =
    (Record c -> m a) -> ContextT c m a
forall (c :: [*]) (m :: * -> *) a.
(Record c -> m a) -> ContextT c m a
ContextT ((Record c -> m a) -> ContextT c m a)
-> (Record c -> m a) -> ContextT c m a
forall a b. (a -> b) -> a -> b
$ \ Record c
c ->
      (RunInBase m b -> b a) -> m a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
(RunInBase m b -> b a) -> m a
liftBaseWith ((RunInBase m b -> b a) -> m a) -> (RunInBase m b -> b a) -> m a
forall a b. (a -> b) -> a -> b
$ \ RunInBase m b
runInBase ->
        RunInBase (ContextT c m) b -> b a
f (m a -> b (StM m a)
RunInBase m b
runInBase (m a -> b (StM m a))
-> (ContextT c m a -> m a) -> ContextT c m a -> b (StM m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Record c -> m a) -> Record c -> m a
forall a b. (a -> b) -> a -> b
$ Record c
c) ((Record c -> m a) -> m a)
-> (ContextT c m a -> Record c -> m a) -> ContextT c m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContextT c m a -> Record c -> m a
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 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 =
    (Record c -> m b) -> ContextT c m b
forall (c :: [*]) (m :: * -> *) a.
(Record c -> m a) -> ContextT c m a
ContextT ((Record c -> m b) -> ContextT c m b)
-> (Record c -> m b) -> ContextT c m b
forall a b. (a -> b) -> a -> b
$ \Record c
c ->
    ((forall a. m a -> IO a) -> IO b) -> m b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO b) -> m b)
-> ((forall a. m a -> IO a) -> IO b) -> m b
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 (m a -> IO a
forall a. m a -> IO a
run (m a -> IO a) -> (ContextT c m a -> m a) -> ContextT c m a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ContextT c m a -> Record c -> m a)
-> Record c -> ContextT c m a -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ContextT c m a -> Record c -> m a
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    = m r -> ContextT c m r
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m r
forall r (m :: * -> *). MonadReader r m => m r
ask
  local :: (r -> r) -> ContextT c m a -> ContextT c m a
local  = (m a -> m a) -> ContextT c m a -> ContextT c m a
forall (m :: * -> *) a (n :: * -> *) b (c :: [*]).
(m a -> n b) -> ContextT c m a -> ContextT c n b
mapContextT ((m a -> m a) -> ContextT c m a -> ContextT c m a)
-> ((r -> r) -> m a -> m a)
-> (r -> r)
-> ContextT c m a
-> ContextT c m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (r -> r) -> m a -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local
  reader :: (r -> a) -> ContextT c m a
reader = m a -> ContextT c m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ContextT c m a)
-> ((r -> a) -> m a) -> (r -> a) -> ContextT c m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (r -> a) -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
reader

instance MonadWriter w m => MonadWriter w (ContextT c m) where
  writer :: (a, w) -> ContextT c m a
writer = m a -> ContextT c m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ContextT c m a)
-> ((a, w) -> m a) -> (a, w) -> ContextT c m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, w) -> m a
forall w (m :: * -> *) a. MonadWriter w m => (a, w) -> m a
writer
  tell :: w -> ContextT c m ()
tell   = m () -> ContextT c m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ContextT c m ()) -> (w -> m ()) -> w -> ContextT c m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell
  listen :: ContextT c m a -> ContextT c m (a, w)
listen = (m a -> m (a, w)) -> ContextT c m a -> ContextT c m (a, w)
forall (m :: * -> *) a (n :: * -> *) b (c :: [*]).
(m a -> n b) -> ContextT c m a -> ContextT c n b
mapContextT m a -> m (a, w)
forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen
  pass :: ContextT c m (a, w -> w) -> ContextT c m a
pass   = (m (a, w -> w) -> m a)
-> ContextT c m (a, w -> w) -> ContextT c m a
forall (m :: * -> *) a (n :: * -> *) b (c :: [*]).
(m a -> n b) -> ContextT c m a -> ContextT c n b
mapContextT m (a, w -> w) -> m a
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   = m s -> ContextT c m s
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m s
forall s (m :: * -> *). MonadState s m => m s
get
  put :: s -> ContextT c m ()
put   = m () -> ContextT c m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ContextT c m ()) -> (s -> m ()) -> s -> ContextT c m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put
  state :: (s -> (a, s)) -> ContextT c m a
state = m a -> ContextT c m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ContextT c m a)
-> ((s -> (a, s)) -> m a) -> (s -> (a, s)) -> ContextT c m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s -> (a, s)) -> m a
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 :: (a -> ContextT c m a) -> ContextT c m a
mfix a -> ContextT c m a
f = (Record c -> m a) -> ContextT c m a
forall (c :: [*]) (m :: * -> *) a.
(Record c -> m a) -> ContextT c m a
ContextT ((Record c -> m a) -> ContextT c m a)
-> (Record c -> m a) -> ContextT c m a
forall a b. (a -> b) -> a -> b
$ \ Record c
r -> (a -> m a) -> m a
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix ((a -> m a) -> m a) -> (a -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \ a
a -> ContextT c m a -> Record c -> m 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 :: String -> ContextT c m a
fail = m a -> ContextT c m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ContextT c m a)
-> (String -> m a) -> String -> ContextT c m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
MonadFail.fail

instance MonadError e m => MonadError e (ContextT c m) where
  throwError :: e -> ContextT c m a
throwError = m a -> ContextT c m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ContextT c m a) -> (e -> m a) -> e -> ContextT c m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
  catchError :: 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 = (Record c -> m a) -> ContextT c m a
forall (c :: [*]) (m :: * -> *) a.
(Record c -> m a) -> ContextT c m a
ContextT ((Record c -> m a) -> ContextT c m a)
-> (Record c -> m a) -> ContextT c m a
forall a b. (a -> b) -> a -> b
$ \ Record c
r -> m a -> (e -> m a) -> m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError (ContextT c m a -> Record c -> m a
forall (c :: [*]) (m :: * -> *) a.
ContextT c m a -> Record c -> m a
runContextT ContextT c m a
m Record c
r) (\ e
e -> ContextT c m a -> Record c -> m a
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 :: ContextT c m a
mzero = m a -> ContextT c m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
  ContextT c m a
m mplus :: ContextT c m a -> ContextT c m a -> ContextT c m a
`mplus` ContextT c m a
n = (Record c -> m a) -> ContextT c m a
forall (c :: [*]) (m :: * -> *) a.
(Record c -> m a) -> ContextT c m a
ContextT ((Record c -> m a) -> ContextT c m a)
-> (Record c -> m a) -> ContextT c m a
forall a b. (a -> b) -> a -> b
$ \ Record c
r -> ContextT c m a -> Record c -> m a
forall (c :: [*]) (m :: * -> *) a.
ContextT c m a -> Record c -> m a
runContextT ContextT c m a
m Record c
r m a -> m a -> m a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` ContextT c m a -> Record c -> m a
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 :: ((a -> ContextT c m b) -> ContextT c m a) -> ContextT c m a
callCC (a -> ContextT c m b) -> ContextT c m a
f = (Record c -> m a) -> ContextT c m a
forall (c :: [*]) (m :: * -> *) a.
(Record c -> m a) -> ContextT c m a
ContextT ((Record c -> m a) -> ContextT c m a)
-> (Record c -> m a) -> ContextT c m a
forall a b. (a -> b) -> a -> b
$ \ Record c
r -> ((a -> m b) -> m a) -> m a
forall (m :: * -> *) a b. MonadCont m => ((a -> m b) -> m a) -> m a
callCC (((a -> m b) -> m a) -> m a) -> ((a -> m b) -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \ a -> m b
c -> ContextT c m a -> Record c -> m a
forall (c :: [*]) (m :: * -> *) a.
ContextT c m a -> Record c -> m a
runContextT ((a -> ContextT c m b) -> ContextT c m a
f ((Record c -> m b) -> ContextT c m b
forall (c :: [*]) (m :: * -> *) a.
(Record c -> m a) -> ContextT c m a
ContextT ((Record c -> m b) -> ContextT c m b)
-> (a -> Record c -> m b) -> a -> ContextT c m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m b -> Record c -> m b
forall a b. a -> b -> a
const (m b -> Record c -> m b) -> (a -> m b) -> a -> Record c -> m b
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 :: e -> ContextT c m a
throwM e
e = (Record c -> m a) -> ContextT c m a
forall (c :: [*]) (m :: * -> *) a.
(Record c -> m a) -> ContextT c m a
ContextT ((Record c -> m a) -> ContextT c m a)
-> (Record c -> m a) -> ContextT c m a
forall a b. (a -> b) -> a -> b
$ \ Record c
_ -> e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM e
e

instance MonadCatch m => MonadCatch (ContextT c m) where
  catch :: 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 = (Record c -> m a) -> ContextT c m a
forall (c :: [*]) (m :: * -> *) a.
(Record c -> m a) -> ContextT c m a
ContextT ((Record c -> m a) -> ContextT c m a)
-> (Record c -> m a) -> ContextT c m a
forall a b. (a -> b) -> a -> b
$ \ Record c
r -> m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch (ContextT c m a -> Record c -> m a
forall (c :: [*]) (m :: * -> *) a.
ContextT c m a -> Record c -> m a
runContextT ContextT c m a
m Record c
r) (\ e
e -> ContextT c m a -> Record c -> m a
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 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 = (Record c -> m b) -> ContextT c m b
forall (c :: [*]) (m :: * -> *) a.
(Record c -> m a) -> ContextT c m a
ContextT ((Record c -> m b) -> ContextT c m b)
-> (Record c -> m b) -> ContextT c m b
forall a b. (a -> b) -> a -> b
$ \Record c
e -> ((forall a. m a -> m a) -> m b) -> m b
forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
mask (((forall a. m a -> m a) -> m b) -> m b)
-> ((forall a. m a -> m a) -> m b) -> m b
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
u -> ContextT c m b -> Record c -> m b
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. ContextT c m a -> ContextT c m a) -> ContextT c m b)
-> (forall a. ContextT c m a -> ContextT c m a) -> ContextT c m b
forall a b. (a -> b) -> a -> b
$ (m a -> m a) -> ContextT c m a -> ContextT c m a
forall a (c' :: [*]).
(m a -> m a) -> ContextT c' m a -> ContextT c' m a
q m a -> m a
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 :: (m a -> m a) -> ContextT c' m a -> ContextT c' m a
q m a -> m a
u (ContextT Record c' -> m a
b) = (Record c' -> m a) -> ContextT c' m a
forall (c :: [*]) (m :: * -> *) a.
(Record c -> m a) -> ContextT c m a
ContextT (m a -> m a
u (m a -> m a) -> (Record c' -> m a) -> Record c' -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Record c' -> m a
b)
  uninterruptibleMask :: ((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 =
    (Record c -> m b) -> ContextT c m b
forall (c :: [*]) (m :: * -> *) a.
(Record c -> m a) -> ContextT c m a
ContextT ((Record c -> m b) -> ContextT c m b)
-> (Record c -> m b) -> ContextT c m b
forall a b. (a -> b) -> a -> b
$ \Record c
e -> ((forall a. m a -> m a) -> m b) -> m b
forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
uninterruptibleMask (((forall a. m a -> m a) -> m b) -> m b)
-> ((forall a. m a -> m a) -> m b) -> m b
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
u -> ContextT c m b -> Record c -> m b
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. ContextT c m a -> ContextT c m a) -> ContextT c m b)
-> (forall a. ContextT c m a -> ContextT c m a) -> ContextT c m b
forall a b. (a -> b) -> a -> b
$ (m a -> m a) -> ContextT c m a -> ContextT c m a
forall a (c' :: [*]).
(m a -> m a) -> ContextT c' m a -> ContextT c' m a
q m a -> m a
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 :: (m a -> m a) -> ContextT c' m a -> ContextT c' m a
q m a -> m a
u (ContextT Record c' -> m a
b) = (Record c' -> m a) -> ContextT c' m a
forall (c :: [*]) (m :: * -> *) a.
(Record c -> m a) -> ContextT c m a
ContextT (m a -> m a
u (m a -> m a) -> (Record c' -> m a) -> Record c' -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Record c' -> m a
b)

#if MIN_VERSION_exceptions(0,9,0)
  generalBracket :: 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 =
    (Record c -> m (b, c)) -> ContextT c m (b, c)
forall (c :: [*]) (m :: * -> *) a.
(Record c -> m a) -> ContextT c m a
ContextT ((Record c -> m (b, c)) -> ContextT c m (b, c))
-> (Record c -> m (b, c)) -> ContextT c m (b, c)
forall a b. (a -> b) -> a -> b
$ \ Record c
r ->
      m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
forall (m :: * -> *) a b c.
MonadMask m =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
generalBracket
        (ContextT c m a -> Record c -> m a
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 -> ContextT c m c -> Record c -> m c
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 -> ContextT c m b -> Record c -> m b
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