Instance declarations and accessor methods for the most relevant transformers

src/Control/Monad/Trans/Interruptible/Class.hs

@@ -2,6 +2,12 @@
 
 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,
@@ -12,6 +18,9 @@ module Control.Monad.Trans.Interruptible.Class (
 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.
@@ -51,11 +60,70 @@ instance Interruptible (EitherT e) where
   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