module Control.Monad.CatchIO ( MonadCatchIO(..),
                               E.Exception(..),
                               throw,
                               try, tryJust,
                               Handler(..), catches )

where

import Prelude hiding ( catch )

import qualified Control.Exception as E

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   :: E.Exception e => m a -> (e -> 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 e) => e -> m a

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

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

-- | Generalized version of 'E.Handler'
data Handler m a = forall e . E.Exception e => Handler (e -> m a)

-- | Generalized version of 'E.catches'
catches :: MonadCatchIO m => m a -> [Handler m a] -> m a
catches a handlers = a `catch` handler
    where handler e = foldr tryH (throw e) handlers
            where tryH (Handler h) res = case E.fromException e of
                                             Just e' -> h e'
                                             Nothing -> res


#include "generic-code.inc"