module Control.Monad.Ology.General.Catch where

import qualified Control.Exception as CE
import Control.Monad.Ology.General.Exception
import Control.Monad.Ology.General.Throw
import Control.Monad.Ology.Specific.Result
import Import

-- | Monads that can catch this type of exception.
class MonadThrow e m => MonadCatch e m where
    catch :: forall a. m a -> (e -> m a) -> m a

try :: forall m e a. MonadCatch e m
    => m a
    -> m (Result e a)
try :: forall (m :: Type -> Type) e a.
MonadCatch e m =>
m a -> m (Result e a)
try m a
ma = forall e (m :: Type -> Type) a.
MonadCatch e m =>
m a -> (e -> m a) -> m a
catch (forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap forall e a. a -> Result e a
SuccessResult m a
ma) forall a b. (a -> b) -> a -> b
$ \e
e -> forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall e a. e -> Result e a
FailureResult e
e

handle ::
       forall m e a. MonadCatch e m
    => (e -> m a)
    -> m a
    -> m a
handle :: forall (m :: Type -> Type) e a.
MonadCatch e m =>
(e -> m a) -> m a -> m a
handle e -> m a
handler m a
ma = forall e (m :: Type -> Type) a.
MonadCatch e m =>
m a -> (e -> m a) -> m a
catch m a
ma e -> m a
handler

instance CE.Exception e => MonadCatch e IO where
    catch :: forall a. IO a -> (e -> IO a) -> IO a
catch IO a
ma e -> IO a
handler = forall (m :: Type -> Type) a.
MonadException m =>
m a -> (Exc m -> m (Maybe a)) -> m a
catchSomeExc IO a
ma forall a b. (a -> b) -> a -> b
$ \Exc IO
e -> forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (forall e. Exception e => SomeException -> Maybe e
CE.fromException Exc IO
e) e -> IO a
handler