module Control.Monad.Ology.General.Exception.Class where

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

-- | Pretty much every monad can be made an instance of this class.
class Monad m => MonadException m where
    -- | The type of /all/ exceptions of this monad.
    type Exc m :: Type
    throwExc :: Exc m -> m a
    catchExc :: m a -> (Exc m -> m a) -> m a

instance MonadException Identity where
    type Exc Identity = Void
    throwExc :: forall a. Exc Identity -> Identity a
throwExc = forall a. Void -> a
absurd
    catchExc :: forall a. Identity a -> (Exc Identity -> Identity a) -> Identity a
catchExc Identity a
ma Exc Identity -> Identity a
_ = Identity a
ma

instance MonadException ((->) r) where
    type Exc ((->) r) = Void
    throwExc :: forall a. Exc ((->) r) -> r -> a
throwExc = forall a. Void -> a
absurd
    catchExc :: forall a. (r -> a) -> (Exc ((->) r) -> r -> a) -> r -> a
catchExc r -> a
ma Exc ((->) r) -> r -> a
_ = r -> a
ma

instance Monoid p => MonadException ((,) p) where
    type Exc ((,) p) = Void
    throwExc :: forall a. Exc ((,) p) -> (p, a)
throwExc = forall a. Void -> a
absurd
    catchExc :: forall a. (p, a) -> (Exc ((,) p) -> (p, a)) -> (p, a)
catchExc (p, a)
ma Exc ((,) p) -> (p, a)
_ = (p, a)
ma

instance MonadException Maybe where
    type Exc Maybe = ()
    throwExc :: forall a. Exc Maybe -> Maybe a
throwExc () = forall a. Maybe a
Nothing
    catchExc :: forall a. Maybe a -> (Exc Maybe -> Maybe a) -> Maybe a
catchExc Maybe a
Nothing Exc Maybe -> Maybe a
handler = Exc Maybe -> Maybe a
handler ()
    catchExc Maybe a
ma Exc Maybe -> Maybe a
_ = Maybe a
ma

instance MonadException [] where
    type Exc [] = ()
    throwExc :: forall a. Exc [] -> [a]
throwExc Exc []
_ = []
    catchExc :: forall a. [a] -> (Exc [] -> [a]) -> [a]
catchExc [] Exc [] -> [a]
handler = Exc [] -> [a]
handler ()
    catchExc [a]
ma Exc [] -> [a]
_ = [a]
ma

instance MonadException (Either e) where
    type Exc (Either e) = e
    throwExc :: forall a. Exc (Either e) -> Either e a
throwExc = forall a b. a -> Either a b
Left
    catchExc :: forall a.
Either e a -> (Exc (Either e) -> Either e a) -> Either e a
catchExc (Right a
a) Exc (Either e) -> Either e a
_ = forall a b. b -> Either a b
Right a
a
    catchExc (Left e
e) Exc (Either e) -> Either e a
handler = Exc (Either e) -> Either e a
handler e
e

instance MonadException (Result e) where
    type Exc (Result e) = e
    throwExc :: forall a. Exc (Result e) -> Result e a
throwExc = forall e a. e -> Result e a
FailureResult
    catchExc :: forall a.
Result e a -> (Exc (Result e) -> Result e a) -> Result e a
catchExc (SuccessResult a
a) Exc (Result e) -> Result e a
_ = forall e a. a -> Result e a
SuccessResult a
a
    catchExc (FailureResult e
e) Exc (Result e) -> Result e a
handler = Exc (Result e) -> Result e a
handler e
e

instance MonadException IO where
    type Exc IO = CE.SomeException
    throwExc :: forall a. Exc IO -> IO a
throwExc = forall e a. Exception e => e -> IO a
CE.throwIO
    catchExc :: forall a. IO a -> (Exc IO -> IO a) -> IO a
catchExc = forall e a. Exception e => IO a -> (e -> IO a) -> IO a
CE.catch

-- | Catch all exceptions, optionally returning or re-throwing.
catchSomeExc ::
       forall m a. MonadException m
    => m a
    -> (Exc m -> m (Maybe a))
    -> m a
catchSomeExc :: forall (m :: Type -> Type) a.
MonadException m =>
m a -> (Exc m -> m (Maybe a)) -> m a
catchSomeExc m a
ma Exc m -> m (Maybe a)
handler = forall (m :: Type -> Type) a.
MonadException m =>
m a -> (Exc m -> m a) -> m a
catchExc m a
ma forall a b. (a -> b) -> a -> b
$ \Exc m
e -> Exc m -> m (Maybe a)
handler Exc m
e forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: Type -> Type) a. MonadException m => Exc m -> m a
throwExc Exc m
e) forall (m :: Type -> Type) a. Monad m => a -> m a
return

fromResultExc ::
       forall m a. MonadException m
    => Result (Exc m) a
    -> m a
fromResultExc :: forall (m :: Type -> Type) a.
MonadException m =>
Result (Exc m) a -> m a
fromResultExc (SuccessResult a
a) = forall (m :: Type -> Type) a. Monad m => a -> m a
return a
a
fromResultExc (FailureResult Exc m
e) = forall (m :: Type -> Type) a. MonadException m => Exc m -> m a
throwExc Exc m
e

-- | Catch all exceptions as a 'Result'.
tryExc ::
       forall m a. MonadException m
    => m a
    -> m (Result (Exc m) a)
tryExc :: forall (m :: Type -> Type) a.
MonadException m =>
m a -> m (Result (Exc m) a)
tryExc m a
ma = forall (m :: Type -> Type) a.
MonadException m =>
m a -> (Exc m -> m a) -> m a
catchExc (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
$ \Exc m
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 Exc m
e

-- | Run the handler on exception.
-- Does not mask asynchronous exceptions on the handler.
onException ::
       forall m a. MonadException m
    => m a
    -> m ()
    -> m a
onException :: forall (m :: Type -> Type) a.
MonadException m =>
m a -> m () -> m a
onException m a
ma m ()
handler = forall (m :: Type -> Type) a.
MonadException m =>
m a -> (Exc m -> m a) -> m a
catchExc m a
ma forall a b. (a -> b) -> a -> b
$ \Exc m
ex -> m ()
handler forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> forall (m :: Type -> Type) a. MonadException m => Exc m -> m a
throwExc Exc m
ex

-- | This catches certain "bottom values".
-- Of course, since non-termination is bottom, this cannot catch all bottoms.
catchPureError :: a -> IO (Maybe CE.SomeException)
catchPureError :: forall a. a -> IO (Maybe SomeException)
catchPureError a
a = forall (m :: Type -> Type) a.
MonadException m =>
m a -> (Exc m -> m a) -> m a
catchExc (forall a. a -> IO a
CE.evaluate a
a forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a. Maybe a
Nothing) forall a b. (a -> b) -> a -> b
$ \Exc IO
e -> forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Exc IO
e