[Haskell-cafe] Re: How to combine Error and IO monads?
Cat Dancer
haskell-cafe at catdancer.ws
Thu Dec 7 13:53:25 EST 2006
On 12/7/06, apfelmus at quantentunnel.de <apfelmus at quantentunnel.de> wrote:
> Cat Dancer wrote:
> > I have a program that performs a series of IO operations, each which
> > can result in an error or a value. If a step returns a value I
> > usually want to pass that value on to the next step, if I get an error
> > I want to do some error handling but usually want to skip the
> > remaining steps.
>
> > Thus I have a lot of functions with return types like IO (Either
> > String x), where x might be (), Integer, or some other useful value
> > type, and a lot of case statements like
>
> You are on the right track. The point is that (IO (Either String a)) is
> a Monad, too. This allows you to write the ever repeating case
> statements once and forall:
>
> newtype ErrorIO a = ErrorIO (IO (Either String a))
>
> instance Monad ErrorIO where
> return x = return (Right x)
> f >>= g = do
> ex <- f
> case ex of
> e@(Left _) -> return e
> Right x -> g x
>
> It happens that you can parametrize this on IO:
>
> newtype ErrorT m a = ErrorT (m (Either String a))
> type ErrorIO a = ErrorT IO a
>
> instance Monad m => Monad (ErrorT m) where ... -- same as above
>
> And you just rediscovered monad transformers.
I think I need to explain how thoroughly clueless I am :)
I'm sure from a single example I could understand what was going on
and elaborate from there.
Let's say I want to get a line from the user, and either return an
integer or an error string using ErrorT.
import Control.Monad.Error
import Control.Monad.Trans
foo :: ??
foo = do -- something like this?
a <- getLine
if length a == 1
then return 123
else throwError "not a single character"
main = do
r <- ?? foo ??
print r -- prints Left "not a single character" or Right 123 ?
More information about the Haskell-Cafe
mailing list