# New monads/MonadExit

### From HaskellWiki

< New monads(Difference between revisions)

(Intro) |
(The code) |
||

Line 2: | Line 2: | ||

If you are using CPS or <hask>MonadCont</hask> only for this purpose, the <hask>Exit</hask> monad will likely simplify your program considerably. | If you are using CPS or <hask>MonadCont</hask> only for this purpose, the <hask>Exit</hask> monad will likely simplify your program considerably. | ||

+ | |||

+ | == The code == | ||

+ | |||

+ | <haskell> | ||

+ | {-# OPTIONS_GHC -fglasgow-exts #-} | ||

+ | |||

+ | -- A monad that provides short-circuiting for complex program flow logic. | ||

+ | |||

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

+ | MonadExit(..), | ||

+ | 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 | ||

+ | |||

+ | -- This really should be Either, but unfortunately that was | ||

+ | -- already given a slightly different Monad instance for the Error 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 | ||

+ | </haskell> | ||

+ | |||

+ | [[Category:Code]] |

## Revision as of 14:40, 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(..), 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 -- This really should be Either, but unfortunately that was -- already given a slightly different Monad instance for the Error 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