There are too many error handling conventions used in library code!

[Robert Dockins]

On Sunday 11 March 2007 11:22, Robert Dockins wrote:
[snip]

> One option that strikes me as a possibility is to add an (Error Dynamic)
> instance and use (MonadError Dynamic).  This has the advantages of
> 'throwDyn' without tying it to the IO monad.  Together with a suite of
> lifting functions, you could (as a library consumer) integrate almost any
> error handling convention into a single monad, leaving the ugliness of
> handling various error representations to the error handling code, where it
> belongs.

[snip]

Here's a quick and dirty implementation for discussion. It compiles, but I 
haven't tested it.

Rob Dockins


----------------------------------------------------------

{-# OPTIONS -fglasgow-exts #-}

module ErrorDyn
( ErrorDyn
, ErrorDynT
, liftMaybe
, liftEither
, liftErrorT
, liftWriter
, liftWriterT
, handleDynErr
, catchDynErr
, runErrorDynT
, execErrorDynT
, runErrorDyn
, execErrorDyn
) where

import Data.Monoid
import Data.Typeable
import Data.Dynamic
import Control.Monad
import Control.Monad.Identity
import Control.Monad.Error
import Control.Monad.Writer

instance Error Dynamic where
  noMsg      = toDyn ()
  strMsg str = toDyn str

type ErrorDyn = ErrorDynT Identity

newtype ErrorDynT m a = EDT { unEDT :: ErrorT Dynamic m a }
  deriving (Monad, MonadTrans)

runErrorDynT :: Monad m => ErrorDynT m a -> m (Either Dynamic a)
runErrorDynT = runErrorT . unEDT

execErrorDynT :: Monad m => ErrorDynT m a -> m a
execErrorDynT m = runErrorDynT m >>= either unhdl return
  where unhdl dyn = fail $ "Unhandled dynamic error of type: "++(show dyn)

runErrorDyn :: ErrorDyn a -> Either Dynamic a
runErrorDyn = runIdentity . runErrorDynT

execErrorDyn :: ErrorDyn a -> a
execErrorDyn = runIdentity . execErrorDynT

instance Monad m => MonadError Dynamic (ErrorDynT m) where
  throwError e   = EDT (throwError e)
  catchError m f = EDT (catchError (unEDT m) (unEDT . f))

liftMaybe :: (Monad m) => Maybe a -> ErrorDynT m a
liftMaybe = maybe (throwError noMsg) return

liftEither :: (Monad m, Typeable e) => Either e a -> ErrorDynT m a
liftEither = either (throwError . toDyn) return

liftErrorT :: (Monad m, Typeable e) => ErrorT e m a -> ErrorDynT m a
liftErrorT m = lift (runErrorT m) >>= liftEither


liftWriter :: (Monad m, Eq e, Monoid e, Typeable e)
           => Writer e a
           -> ErrorDynT m a
liftWriter m = do
   let (a, w) = runWriter m
   when (w /= mempty) (throwError (toDyn w))
   return a


liftWriterT :: (Monad m, Eq e, Monoid e, Typeable e)
            => WriterT e m a
            -> ErrorDynT m a
liftWriterT m = do
   (a, w) <- lift (runWriterT m)
   when (w /= mempty) (throwError (toDyn w))
   return a


handleDynErr :: (Monad m, Typeable e)
             => (e -> ErrorDynT m a)
             -> ErrorDynT m a
             -> ErrorDynT m a
handleDynErr f m = catchError m hdl
 where
  hdl e = maybe (throwError e) f (fromDynamic e)


catchDynErr :: (Monad m, Typeable e)
            => ErrorDynT m a
            -> (e -> ErrorDynT m a)
            -> ErrorDynT m a
catchDynErr = flip handleDynErr