[Haskell-cafe] Alternative IO
Henning Thielemann
lemming at henning-thielemann.de
Thu Jul 9 10:01:59 EDT 2009
On Thu, 9 Jul 2009, Cristiano Paris wrote:
> As a joke, I wrote an instance of Alternative for IO actions:
> {-# LANGUAGE ScopedTypeVariables #-}
> module Main where
>
> import Control.Applicative
> import Control.Exception
>
> instance Alternative IO where
> empty = undefined
> x <|> y = handle (\ (_ :: SomeException) -> y) x
>
> This would allow to write IO code which failsafes to a value if the previous
> computation failed, i.e.:
>
> *Main Control.Applicative> undefined <|> print "Hello"
> "Hello"
> *Main Control.Applicative> print "Hello" <|> undefined
> "Hello"
>
> It seems a neat way to catch exception in some scenarios. What do you think?
> Why is not Alternative IO defined in Control.Applicative?
I just say, what I always say. :-) 'error' denotes a programming error and
"catching" it is a hack, sometimes needed but less often than you think.
For exceptions one must use 'throw'. Thus, you may e.g. define
empty = throw ...
More information about the Haskell-Cafe
mailing list