# New monads/MonadExit

### From HaskellWiki

< New monads(Difference between revisions)

(Get rid of old comment about Either monad) |
(Put exitWith explicitly in export list) |
||

Line 11: | Line 11: | ||

module Control.Monad.Exit ( | module Control.Monad.Exit ( | ||

− | MonadExit( | + | MonadExit(exitWith), |

Exit, | Exit, | ||

runExit, | runExit, |

## Revision as of 14:46, 6 February 2007

TheExit

MonadCont

Exit

## The code

{-# OPTIONS_GHC -fglasgow-exts #-} -- A monad that provides short-circuiting for complex program flow logic. module Control.Monad.Exit ( MonadExit(exitWith), Exit, runExit, runExitMaybe, ExitT, runExitT, runExitTMaybe, module Control.Monad, module Control.Monad.Trans ) where import Control.Monad import Control.Monad.Trans import Control.Monad.Reader import Control.Monad.Writer import Control.Monad.Error import Control.Monad.State import Control.Monad.List import qualified System.Exit as Sys (exitWith, ExitCode) -- The MonadExit class class Monad m => MonadExit e m | m -> e where exitWith :: e -> m a instance MonadExit Sys.ExitCode IO where exitWith = Sys.exitWith -- The Exit monad data Exit e a = Continue a | Exit e runExit :: Exit e a -> e runExit (Exit x) = x runExit _ = error "Exit monad did not exit." runExitMaybe :: Exit e b -> Maybe e runExitMaybe (Exit x) = Just x runExitMaybe _ = Nothing instance Functor (Exit e) where fmap f (Continue x) = Continue $ f x fmap _ (Exit x) = Exit x instance Monad (Exit e) where return = Continue (Continue x) >>= f = f x (Exit x) >>= _ = Exit x instance MonadExit e (Exit e) where exitWith = Exit -- The ExitT monad newtype ExitT e m a = ExitT (m (Exit e a)) runExitT :: Monad m => ExitT e m a -> m e runExitT (ExitT x) = do y <- x case y of Exit z -> return z _ -> error "ExitT monad did not exit." runExitTMaybe :: Monad m => ExitT e m a -> m (Maybe e) runExitTMaybe (ExitT x) = liftM runExitMaybe x instance Monad m => Functor (ExitT e m) where fmap f (ExitT x) = ExitT $ do y <- x case y of Continue z -> return $ Continue $ f z Exit z -> return $ Exit z instance Monad m => Monad (ExitT e m) where return = ExitT . return . Continue (ExitT x) >>= f = ExitT $ do y <- x case y of Continue z -> let ExitT w = f z in w Exit z -> return $ Exit z instance Monad m => MonadExit e (ExitT e m) where exitWith = ExitT . return . Exit instance MonadTrans (ExitT e) where lift = ExitT . liftM Continue -- Lifted instances of other monad classes from inside ExitT -- TODO: Put a MonadFix instance here. instance MonadIO m => MonadIO (ExitT e m) where liftIO = lift . liftIO instance MonadPlus m => MonadPlus (ExitT e m) where mzero = lift mzero (ExitT x) `mplus` (ExitT y) = ExitT (x `mplus` y) instance MonadState s (ExitT e (State s)) where get = lift get put = lift . put instance Monad m => MonadState s (ExitT e (StateT s m)) where get = lift get put = lift . put instance Error err => MonadError err (ExitT e (Either err)) where throwError = lift . throwError catchError (ExitT x) f = ExitT $ catchError x (\e -> let ExitT y = f e in y) instance (Error err, Monad m) => MonadError err (ExitT e (ErrorT err m)) where throwError = lift . throwError catchError (ExitT x) f = ExitT $ catchError x (\e -> let ExitT y = f e in y) -- MonadExit instances for other monad transformers instance MonadExit e (StateT s (Exit e)) where exitWith = lift . exitWith instance Monad m => MonadExit e (StateT s (ExitT e m)) where exitWith = lift . exitWith instance MonadExit e (ListT (Exit e)) where exitWith = lift . exitWith instance Monad m => MonadExit e (ListT (ExitT e m)) where exitWith = lift . exitWith instance MonadExit e (ReaderT r (Exit e)) where exitWith = lift . exitWith instance Monad m => MonadExit e (ReaderT r (ExitT e m)) where exitWith = lift . exitWith instance Monoid w => MonadExit e (WriterT w (Exit e)) where exitWith = lift . exitWith instance (Monoid w, Monad m) => MonadExit e (WriterT w (ExitT e m)) where exitWith = lift . exitWith instance Error err => MonadExit e (ErrorT err (Exit e)) where exitWith = lift . exitWith instance (Error err, Monad m) => MonadExit e (ErrorT err (ExitT e m)) where exitWith = lift . exitWith