module Control.Monad.CatchIO.Old ( MonadCatchIO(..),
                                   E.Exception(..),
                                   throw,
                                   throwDyn, catchDyn,
                                   try, tryJust )

where

#if __BASE_VERSION__ == 3
import qualified Control.Exception as E
#else
import qualified Control.OldException as E
#endif

import Prelude hiding ( catch )

import Data.Dynamic

import Control.Monad.Reader
import Control.Monad.State
import Control.Monad.Error
import Control.Monad.Writer
import Control.Monad.RWS

class MonadIO m => MonadCatchIO m where
    -- | Generalized version of 'E.catch'
    catch :: m a -> (E.Exception -> m a) -> m a

    -- | Generalized version of 'E.block'
    block   :: m a -> m a

    -- | Generalized version of 'E.unblock'
    unblock :: m a -> m a

-- | Generalized version of 'E.throwIO'
throw :: MonadCatchIO m => E.Exception -> m a

-- | Generalized version of 'E.try'
try :: MonadCatchIO m => m a -> m (Either E.Exception a)

-- | Generalized version of 'E.tryJust'
tryJust :: MonadCatchIO m => (E.Exception -> Maybe b) -> m a -> m (Either b a)



#include "../generic-code.inc"

throwDyn :: Typeable e => e -> b
throwDyn = E.throw . E.DynException . toDyn

catchDyn :: (Typeable e, MonadCatchIO m) => m a -> (e -> m a) -> m a
catchDyn a f = a `catch` handler
    where handler e = case e of
                        E.DynException dyn -> case fromDynamic dyn of
                                                Just exception  -> f exception
                                                Nothing         -> E.throw e
                        _                  -> E.throw e