|
@@ -2,6 +2,12 @@
|
|
|
|
|
|
module Control.Monad.Trans.Interruptible.Class (
|
|
module Control.Monad.Trans.Interruptible.Class (
|
|
Interruptible(..),
|
|
Interruptible(..),
|
|
|
|
+ -- * Instance accessors
|
|
|
|
+ inEitherTCtx, peelEitherTCtx,
|
|
|
|
+ inStateTCtx, peelStateTCtx,
|
|
|
|
+ inWriterTCtx, peelWriterTCtx,
|
|
|
|
+ inReaderTCtx, peelReaderTCtx,
|
|
|
|
+ inRWSTCtx, peelRWSTCtx,
|
|
-- * Resumers for stacks of interruptibles
|
|
-- * Resumers for stacks of interruptibles
|
|
resume2,
|
|
resume2,
|
|
resume3,
|
|
resume3,
|
|
@@ -12,6 +18,9 @@ module Control.Monad.Trans.Interruptible.Class (
|
|
import Control.Monad.Trans.Class
|
|
import Control.Monad.Trans.Class
|
|
import Control.Monad.Trans.State
|
|
import Control.Monad.Trans.State
|
|
import Control.Monad.Trans.Either
|
|
import Control.Monad.Trans.Either
|
|
|
|
+import Control.Monad.Trans.Reader
|
|
|
|
+import Control.Monad.Trans.Writer
|
|
|
|
+import Control.Monad.Trans.RWS
|
|
|
|
|
|
{- |
|
|
{- |
|
|
Interruptible monad transformers.
|
|
Interruptible monad transformers.
|
|
@@ -51,11 +60,70 @@ instance Interruptible (EitherT e) where
|
|
type RSt (EitherT e) a = Either e a
|
|
type RSt (EitherT e) a = Either e a
|
|
resume f st = runEitherT (hoistEither st >>= f)
|
|
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
|
|
instance Interruptible (StateT st) where
|
|
-- | The context of @StateT st a@ is @(a, st)@
|
|
-- | The context of @StateT st a@ is @(a, st)@
|
|
type RSt (StateT st) a = (a, st)
|
|
type RSt (StateT st) a = (a, st)
|
|
resume f (a, st) = runStateT (f 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) =>
|
|
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))
|
|
(a -> u (t m) b) -> RSt t (RSt u a) -> m (RSt t (RSt u b))
|
|
resume2 = resume.resume
|
|
resume2 = resume.resume
|