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

import Control.Exception qualified 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 = Void -> Identity a
Exc Identity -> Identity a
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 = Void -> r -> a
Exc ((->) r) -> r -> a
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 = Void -> (p, a)
Exc ((,) p) -> (p, a)
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 () = Maybe a
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 = e -> Either e a
Exc (Either e) -> Either e a
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
_ = a -> 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
Exc (Either e)
e

instance MonadException (Result e) where
    type Exc (Result e) = e
    throwExc :: forall a. Exc (Result e) -> Result e a
throwExc = e -> Result e a
Exc (Result e) -> Result e a
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
_ = a -> 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
Exc (Result e)
e

instance MonadException IO where
    type Exc IO = CE.SomeException
    throwExc :: forall a. Exc IO -> IO a
throwExc = SomeException -> IO a
Exc IO -> IO a
forall e a. Exception e => e -> IO a
CE.throwIO
    catchExc :: forall a. IO a -> (Exc IO -> IO a) -> IO a
catchExc = IO a -> (SomeException -> IO a) -> IO a
IO a -> (Exc IO -> IO a) -> IO a
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 = m a -> (Exc m -> m a) -> m a
forall a. m a -> (Exc m -> m a) -> m a
forall (m :: Type -> Type) a.
MonadException m =>
m a -> (Exc m -> m a) -> m a
catchExc m a
ma ((Exc m -> m a) -> m a) -> (Exc m -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \Exc m
e -> Exc m -> m (Maybe a)
handler Exc m
e m (Maybe a) -> (Maybe a -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= m a -> (a -> m a) -> Maybe a -> m a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Exc m -> m a
forall a. Exc m -> m a
forall (m :: Type -> Type) a. MonadException m => Exc m -> m a
throwExc Exc m
e) a -> m a
forall a. a -> m a
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) = a -> m a
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return a
a
fromResultExc (FailureResult Exc m
e) = Exc m -> m a
forall a. Exc m -> m a
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 = m (Result (Exc m) a)
-> (Exc m -> m (Result (Exc m) a)) -> m (Result (Exc m) a)
forall a. m a -> (Exc m -> m a) -> m a
forall (m :: Type -> Type) a.
MonadException m =>
m a -> (Exc m -> m a) -> m a
catchExc ((a -> Result (Exc m) a) -> m a -> m (Result (Exc m) a)
forall a b. (a -> b) -> m a -> m b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Result (Exc m) a
forall e a. a -> Result e a
SuccessResult m a
ma) ((Exc m -> m (Result (Exc m) a)) -> m (Result (Exc m) a))
-> (Exc m -> m (Result (Exc m) a)) -> m (Result (Exc m) a)
forall a b. (a -> b) -> a -> b
$ \Exc m
e -> Result (Exc m) a -> m (Result (Exc m) a)
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Result (Exc m) a -> m (Result (Exc m) a))
-> Result (Exc m) a -> m (Result (Exc m) a)
forall a b. (a -> b) -> a -> b
$ Exc m -> Result (Exc m) a
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 = m a -> (Exc m -> m a) -> m a
forall a. m a -> (Exc m -> m a) -> m a
forall (m :: Type -> Type) a.
MonadException m =>
m a -> (Exc m -> m a) -> m a
catchExc m a
ma ((Exc m -> m a) -> m a) -> (Exc m -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \Exc m
ex -> m ()
handler m () -> m a -> m a
forall a b. m a -> m b -> m b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> Exc m -> m a
forall a. Exc m -> m a
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 = IO (Maybe SomeException)
-> (Exc IO -> IO (Maybe SomeException)) -> IO (Maybe SomeException)
forall a. IO a -> (Exc IO -> IO a) -> IO a
forall (m :: Type -> Type) a.
MonadException m =>
m a -> (Exc m -> m a) -> m a
catchExc (a -> IO a
forall a. a -> IO a
CE.evaluate a
a IO a -> IO (Maybe SomeException) -> IO (Maybe SomeException)
forall a b. IO a -> IO b -> IO b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> Maybe SomeException -> IO (Maybe SomeException)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe SomeException
forall a. Maybe a
Nothing) ((Exc IO -> IO (Maybe SomeException)) -> IO (Maybe SomeException))
-> (Exc IO -> IO (Maybe SomeException)) -> IO (Maybe SomeException)
forall a b. (a -> b) -> a -> b
$ \Exc IO
e -> Maybe SomeException -> IO (Maybe SomeException)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Maybe SomeException -> IO (Maybe SomeException))
-> Maybe SomeException -> IO (Maybe SomeException)
forall a b. (a -> b) -> a -> b
$ SomeException -> Maybe SomeException
forall a. a -> Maybe a
Just SomeException
Exc IO
e