{-# LANGUAGE CPP #-}
{-# LANGUAGE UndecidableInstances #-}
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 Monad m => MonadContext (c :: [*]) m | m -> c where
askContext :: m (Record c)
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)
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
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
newtype ContextT (c :: [*]) (m :: (* -> *)) a = ContextT { forall (c :: [*]) (m :: * -> *) a.
ContextT c m a -> Record c -> m a
runContextT :: Record c -> m a }
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
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')
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