Personal tools

New monads/MonadExit

From HaskellWiki

< New monads(Difference between revisions)
Jump to: navigation, search
(Intro)
 
(Add LogicT as something that MonadExit replaces)
(4 intermediate revisions by 2 users not shown)
Line 1: Line 1:
The <hask>Exit</hask> monad provides short-circuiting for complex program flow logic.
+
The <hask>Exit</hask> monad provides [[short-circuiting]] for complex program flow logic.
   
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, <hask>MonadCont</hask>, or <hask>LogicT</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(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
  +
</haskell>
  +
  +
[[Category:Code]]

Revision as of 22:11, 29 May 2010

The
Exit
monad provides short-circuiting for complex program flow logic. If you are using CPS,
MonadCont
, or
LogicT
only for this purpose, the
Exit
monad will likely simplify

your program considerably.

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