[Haskell-cafe] implementing try for RWST ?

Jeremy Shaw jeremy.shaw at linspireinc.com
Fri Apr 13 13:31:34 EDT 2007


Hello,

I defined a newtype like this (the ()s will be replace with
something more useful in the future):

> newtype DryRunIO a = DryRunIO { runDryRunIO :: RWST Bool () () IO a }
>    deriving (Monad, MonadIO, MonadError IOError, MonadFix, Functor, MonadReader Bool, MonadWriter (), MonadState ())
>
> run :: Bool -> DryRunIO a -> IO a
> run dryRun action = (runRWST (runDryRunIO action)) dryRun () >>= \ (a, _, _) -> return a

and I want to define a function similar to |try| like this:

> tryDR :: DryRunIO a -> DryRunIO (Either IOError a)
> tryDR m = catchError (m >>= return . Right) (return . Left)

unfortunately, when I use it, it does not work the way I want:

*Main> run False (tryDR (error "cheese"))
*** Exception: cheese

This is because 'error' raises an |Exception|, not a |IOError|.

I would like to instead define tryDR to deal with exceptions:

> newtype DryRunIO a = DryRunIO { runDryRunIO :: RWST Bool () () IO a }
>    deriving (Monad, MonadIO, MonadError Exception, MonadFix, Functor, MonadReader Bool, MonadWriter (), MonadState ())
>
> tryDR :: DryRunIO a -> DryRunIO (Either Exception a)
> tryDR m = catchError (m >>= return . Right) (return . Left)

But to do this, I need an different instance of MonadError for IO,
namely:

> instance MonadError Exception IO where
>	throwError = throwIO
>	catchError = catch -- (from Control.Exception)

However, if I add that to my module I get this error:

    Functional dependencies conflict between instance declarations:
      instance MonadError Exception IO -- Defined at /tmp/DR.hs:17:0
      instance MonadError IOError IO -- Defined in Control.Monad.Error

Where do I go from here? Also, what is the justificiation for the
current default of IOError instead of the more general Exception? 

thanks!
j.

ps. As a hack I have implemented tryDR as:

> tryDR' :: DryRunIO a -> DryRunIO (Either Exception a)
> tryDR' (DryRunIO m) = DryRunIO $ RWST $ \r s -> 
>            catch (runRWST m r s >>= \(a, s, w) -> return (Right a, s, w))  -- uses catch from Control.Exception
>                      (\e -> runRWST (return $ Left e) r s)

However, I think this is buggy, because changes to 's' and 'w' will be
lost if 'm' raises an exception. For example in:

> tryDR' (io $ putStr "hello" >> updatePosition (length "hello") >> error "goodbye")

The updatedPosition would reflect the position before the tryDR, but
the cursor on the screen would be somewhere else. It is my hope that
the earlier definition does not have this bug.


More information about the Haskell-Cafe mailing list