123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139 |
- {-# LANGUAGE TypeFamilies #-}
- module Control.Monad.Trans.Interruptible.Class (
- Interruptible(..),
- -- * Instance accessors
- inEitherTCtx, peelEitherTCtx,
- inStateTCtx, peelStateTCtx,
- inWriterTCtx, peelWriterTCtx,
- inReaderTCtx, peelReaderTCtx,
- inRWSTCtx, peelRWSTCtx,
- -- * Resumers for stacks of interruptibles
- resume2,
- resume3,
- resume4,
- resume5
- )where
- import Control.Monad.Trans.Class
- import Control.Monad.Trans.State
- import Control.Monad.Trans.Either
- import Control.Monad.Trans.Reader
- import Control.Monad.Trans.Writer
- import Control.Monad.Trans.RWS
- {- |
- Interruptible monad transformers.
- A monad transformer can be made interruptible if it returns its
- final context from its type creator, and if it is possible
- to hoist this context again into the monad at the begining
- of its execution.
- For example, @StateT@ can be interrupted because
- @runStateT@ returns its final state, and because its state
- can be set again at creation simply by passing it as an
- parameter to @runStateT@. An Error context can not be hoisted
- back at the transformer, thus Error can not be interrupted.
- When instantiating, do not forget to create the corresponding
- inCtx and peelCtx functions, for documenting the RSt format
- and keeping the class consistent.
- -}
- class MonadTrans t => Interruptible t where
- -- | Context data of the transformer
- type RSt t a :: *
- -- | Resumes the execution of an interruptible transformer
- resume :: Monad m => (a -> t m b) -> RSt t a -> m (RSt t b)
- instance Interruptible (EitherT e) where
- -- | The context of @EitherT e a@ is @Either e a@.
- type RSt (EitherT e) a = Either e a
- resume f st = runEitherT (hoistEither st >>= f)
- -- | Cretes an interrupted EitherT context
- inEitherTCtx :: a -> RSt (EitherT e) a
- inEitherTCtx = Right
- -- | Unwraps an interrupted EitherT context
- peelEitherTCtx :: RSt (EitherT e) a -> Either e a
- peelEitherTCtx = id
- instance Interruptible (StateT st) where
- -- | The context of @StateT st a@ is @(a, st)@
- type RSt (StateT st) a = (a, st)
- resume f (a, st) = runStateT (f a) st
- -- | Creates an interrupted StateT context
- inStateTCtx :: st -> a -> RSt (StateT st) a
- inStateTCtx st a = (a, st)
- -- | Unwraps an interrupted StateT context
- peelStateTCtx :: RSt (StateT st) a -> (a, st)
- peelStateTCtx = id
- instance Monoid w => Interruptible (WriterT w) where
- type RSt (WriterT w) a = (a, w)
- resume f (a, w) = do
- (a', w') <- runWriterT (f a)
- return (a', mappend w w')
- -- | Creates an interrupted WriterT context
- inWriterTCtx :: Monoid w => a -> RSt (WriterT w) a
- inWriterTCtx a = (a, mempty)
- -- | Unwraps an interrupted WriterT context
- peelWriterTCtx :: RSt (WriterT w) a -> (a, w)
- peelWriterTCtx = id
- instance Interruptible (ReaderT r) where
- type RSt (ReaderT r) a = (a, r)
- resume f (a, r) = do
- a' <- runReaderT (f a) r
- return (a', r)
-
- -- | Creates an interrupted ReaderT context
- inReaderTCtx :: r -> a -> RSt (ReaderT r) a
- inReaderTCtx r a = (a, r)
- -- | Unwraps an interrupted WriterT context
- peelReaderTCtx :: RSt (ReaderT r) a -> a
- peelReaderTCtx (a, _) = a
- instance Monoid w => Interruptible (RWST r w s) where
- type RSt (RWST r w s) a = (a, r, w, s)
- resume f (a, r, w, s) = do
- (a', s', w') <- runRWST (f a) r s
- return (a', r, w', s')
- -- | Creates an interrupted RWST context
- inRWSTCtx :: Monoid w => r -> s -> a -> RSt (RWST r w s) a
- inRWSTCtx r s a = (a, r, mempty, s)
- -- | Unwraps an interrupted RWST context
- peelRWSTCtx :: RSt (RWST r w s) a -> (a, w, s)
- peelRWSTCtx (a, r, w, s) = (a, w, s)
- resume2 :: (Monad m, Interruptible t, Monad (t m), Interruptible u) =>
- (a -> u (t m) b) -> RSt t (RSt u a) -> m (RSt t (RSt u b))
- resume2 = resume.resume
- resume3 :: (Monad m, Interruptible t0, Monad (t0 m), Interruptible t1,
- Monad (t1 (t0 m)), Interruptible t2) =>
- (a -> t2 (t1 (t0 m)) b) -> RSt t0 (RSt t1 (RSt t2 a)) ->
- m (RSt t0 (RSt t1 (RSt t2 b)))
- resume3 = resume2.resume
- resume4 :: (Monad m, Interruptible t0, Interruptible t1, Interruptible t2,
- Interruptible t3, Monad (t0 m), Monad (t1 (t0 m)), Monad (t2 (t1 (t0 m)))) =>
- (a -> t3 (t2 (t1 (t0 m))) b) -> RSt t0 (RSt t1 (RSt t2 (RSt t3 a))) ->
- m (RSt t0 (RSt t1 (RSt t2 (RSt t3 b))))
- resume4 = resume3.resume
- resume5 :: (Monad m, Interruptible t0, Interruptible t1, Interruptible t2,
- Interruptible t3, Interruptible t4, Monad (t0 m), Monad (t1 (t0 m)),
- Monad (t2 (t1 (t0 m))), Monad (t3 (t2 (t1 (t0 m))))) =>
- (a -> t4 (t3 (t2 (t1 (t0 m)))) b) -> RSt t0 (RSt t1 (RSt t2 (RSt t3 (RSt t4 a)))) ->
- m (RSt t0 (RSt t1 (RSt t2 (RSt t3 (RSt t4 b)))))
- resume5 = resume4.resume
|