module Control.Monad.Runnable where
import Interlude hiding (toList, throwError)
import ListT
import qualified Control.Monad.Trans.State.Strict as SS
import qualified Control.Monad.Trans.State.Lazy as LS
import qualified Control.Monad.Trans.Writer.Strict as SW
import qualified Control.Monad.Trans.Writer.Lazy as LW
import qualified Control.Monad.Trans.RWS.Strict as SR
import qualified Control.Monad.Trans.RWS.Lazy as LR
import Control.Monad.Trans.Identity
import Control.Monad.Trans.Error
import Control.Monad.Trans.Except
import Control.Monad.Trans.Maybe
class Monad m => Runnable m where
type MonadicState m :: *
type MonadicResult m a :: *
currentMonadicState :: m (MonadicState m)
restoreMonadicState :: MonadicResult m a -> m a
runMonad :: MonadicState m -> m a -> IO (MonadicResult m a)
class MonadTrans t => RunnableTrans t where
type TransformerState t (m :: * -> *) :: *
type TransformerResult t (m :: * -> *) a :: *
currentTransState :: Monad m => t m (TransformerState t m)
restoreTransState :: Monad m => TransformerResult t m a -> t m a
runTransformer :: Monad m => t m a -> TransformerState t m -> m (TransformerResult t m a)
instance Runnable Identity where
type MonadicState Identity = ()
type MonadicResult Identity a = a
currentMonadicState = return ()
restoreMonadicState = return
runMonad _ (Identity a) = return a
instance Runnable IO where
type MonadicState IO = ()
type MonadicResult IO a = a
currentMonadicState = return ()
restoreMonadicState = return
runMonad _ m = m
instance (Runnable m, RunnableTrans t, Monad (t m)) => Runnable (t m) where
type MonadicState (t m) = (TransformerState t m, MonadicState m)
type MonadicResult (t m) a = MonadicResult m (TransformerResult t m a)
currentMonadicState = (,) <$> currentTransState <*> lift currentMonadicState
restoreMonadicState s = lift (restoreMonadicState s) >>= restoreTransState
runMonad (s, s') t = runMonad s' (runTransformer t s)
instance RunnableTrans (SS.StateT s) where
type TransformerState (SS.StateT s) m = s
type TransformerResult (SS.StateT s) m a = (a, s)
currentTransState = get
restoreTransState (a, s) = put s >> return a
runTransformer = SS.runStateT
instance RunnableTrans (LS.StateT s) where
type TransformerState (LS.StateT s) m = s
type TransformerResult (LS.StateT s) m a = (a, s)
currentTransState = get
restoreTransState (a, s) = put s >> return a
runTransformer = LS.runStateT
instance Monoid s => RunnableTrans (SW.WriterT s) where
type TransformerState (SW.WriterT s) m = ()
type TransformerResult (SW.WriterT s) m a = (a, s)
currentTransState = return ()
restoreTransState (a, s) = SW.tell s >> return a
runTransformer m _ = SW.runWriterT m
instance Monoid s => RunnableTrans (LW.WriterT s) where
type TransformerState (LW.WriterT s) m = ()
type TransformerResult (LW.WriterT s) m a = (a, s)
currentTransState = return ()
restoreTransState (a, s) = LW.tell s >> return a
runTransformer m _ = LW.runWriterT m
instance RunnableTrans (ReaderT s) where
type TransformerState (ReaderT s) m = s
type TransformerResult (ReaderT s) m a = a
currentTransState = ask
restoreTransState = return
runTransformer = runReaderT
instance Monoid w => RunnableTrans (SR.RWST r w s) where
type TransformerState (SR.RWST r w s) m = (r, s)
type TransformerResult (SR.RWST r w s) m a = (a, s, w)
currentTransState = (,) <$> ask <*> get
restoreTransState (a, s, w) = SR.tell w >> put s >> return a
runTransformer m (r, s) = SR.runRWST m r s
instance Monoid w => RunnableTrans (LR.RWST r w s) where
type TransformerState (LR.RWST r w s) m = (r, s)
type TransformerResult (LR.RWST r w s) m a = (a, s, w)
currentTransState = (,) <$> ask <*> get
restoreTransState (a, s, w) = LR.tell w >> put s >> return a
runTransformer m (r, s) = LR.runRWST m r s
instance RunnableTrans IdentityT where
type TransformerState IdentityT m = ()
type TransformerResult IdentityT m a = a
currentTransState = return ()
restoreTransState = return
runTransformer m () = runIdentityT m
instance Error e => RunnableTrans (ErrorT e) where
type TransformerState (ErrorT e) m = ()
type TransformerResult (ErrorT e) m a = Either e a
currentTransState = return ()
restoreTransState (Left e) = throwError e
restoreTransState (Right a) = return a
runTransformer m () = runErrorT m
instance RunnableTrans (ExceptT e) where
type TransformerState (ExceptT e) m = ()
type TransformerResult (ExceptT e) m a = Either e a
currentTransState = return ()
restoreTransState (Left e) = throwE e
restoreTransState (Right a) = return a
runTransformer m () = runExceptT m
instance RunnableTrans MaybeT where
type TransformerState MaybeT m = ()
type TransformerResult MaybeT m a = Maybe a
currentTransState = return ()
restoreTransState Nothing = mzero
restoreTransState (Just a) = return a
runTransformer m () = runMaybeT m
instance RunnableTrans ListT where
type TransformerState ListT m = ()
type TransformerResult ListT m a = [a]
currentTransState = return ()
restoreTransState = fromFoldable
runTransformer m _ = toList m