[Haskell-cafe] A monad using IO, Reader, Writer, State and Error

Chris Kuklewicz haskell at list.mightyreason.com
Fri Apr 13 05:39:10 EDT 2007


Martin Huschenbett wrote:
> Hi all,
> 
> for my current project I need a monad that is an instance of MonadIO,
> MonadReader, MonadWriter, MonadState, and MonadError. I see two ways for
> defining such a monad using the mtl.
> 
> 1) type MyMonad = ErrorT E (RWST R W S IO)
> 
> and
> 
> 2) type MyMonad = RWST R W S (ErrorT E IO)
> 
> I can't figure out what is the difference between these two definitions
> and therefore which one is more suitable for my problem. Or are the
> equivalent and it is unimportant which one I use?

It affects where and how you can catch and respond to errors.

The main difference is that in (1) the final result includes 's' and 'w' in the
event of an error and in (2) the final result does not include 's' and 'w' in
the event of an error.

Assume "op :: MyMonad a"

(1) runErrorT op :: RWST r w s IO (Either e a)
    runRWST r s (runErrorT op) :: IO (Either e a, s, w)

and
catchError :: (ErrorT e (RWST r w s IO a))
           -> (e -> (ErrorT e (RWST r w s IO a)))
           -> (ErrorT e (RWST r w s IO a))

(2) runRWST r s op :: ErrorT e IO a
    runErrorT (runRWST r s op) :: IO (Either e (a,s,w))

The useful outer instance is
catchError :: (RWST r w s (ErrorT e IO) a)
           -> (e -> (RWST r w s (ErrorT e IO) a))
           -> (RWST r w s (ErrorT e IO) a)

The not very useful inner instance
catchError :: (ErrorT e IO a)
           -> (e -> (ErrorT e IO a))
           -> (ErrorT e IO a)
you have the (somewhat silly) option to use this to form
lift (catchError io handler) :: (RWST r w s (ErrorT e IO) a)
but the outer instance is usually better.

So (1) gives (Left e,s,w) or (Right a,s,w)
and (2) gives (Left e) or (Right (a,s,w))

> 
> Or is it even better define a new type like
> 
> newtype MyMonad a = MyMonad { runMyMonad :: R -> S -> IO (Either E a,S,W) }
> 
> and declare instances for all 5 type classes?
> 
> Thanks for your help in advance,
> 
> Martin.
> 
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe



More information about the Haskell-Cafe mailing list