{-# LANGUAGE LambdaCase #-}

-- |
-- Copyright: © 2022 IOHK
-- License: Apache-2.0
--
-- 'Unchecked' helps convert a checked exception ('ExceptT')
-- into an unchecked exception (instance of the 'Exception' class).
module Control.Monad.Exception.Unchecked
    ( throwUnchecked
    , catchUnchecked
    , throwSomeException
    ) where

import Prelude

import Control.Exception
    ( throw )
import Control.Monad.Catch
    ( Exception, MonadCatch (catch), SomeException (SomeException) )
import Control.Monad.Except
    ( ExceptT (..), runExceptT )
import Data.Typeable
    ( Typeable )

-- | The type @Unchecked e@ any 'Typeable' type @e@ into
-- an instance of the 'Exception' class.
newtype Unchecked e = Unchecked e
    deriving (Unchecked e -> Unchecked e -> Bool
(Unchecked e -> Unchecked e -> Bool)
-> (Unchecked e -> Unchecked e -> Bool) -> Eq (Unchecked e)
forall e. Eq e => Unchecked e -> Unchecked e -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Unchecked e -> Unchecked e -> Bool
$c/= :: forall e. Eq e => Unchecked e -> Unchecked e -> Bool
== :: Unchecked e -> Unchecked e -> Bool
$c== :: forall e. Eq e => Unchecked e -> Unchecked e -> Bool
Eq, Int -> Unchecked e -> ShowS
[Unchecked e] -> ShowS
Unchecked e -> String
(Int -> Unchecked e -> ShowS)
-> (Unchecked e -> String)
-> ([Unchecked e] -> ShowS)
-> Show (Unchecked e)
forall e. Show e => Int -> Unchecked e -> ShowS
forall e. Show e => [Unchecked e] -> ShowS
forall e. Show e => Unchecked e -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Unchecked e] -> ShowS
$cshowList :: forall e. Show e => [Unchecked e] -> ShowS
show :: Unchecked e -> String
$cshow :: forall e. Show e => Unchecked e -> String
showsPrec :: Int -> Unchecked e -> ShowS
$cshowsPrec :: forall e. Show e => Int -> Unchecked e -> ShowS
Show)

instance (Typeable e, Show e) => Exception (Unchecked e)

throwUnchecked :: (Monad m, Typeable e, Show e) => ExceptT e m b -> m b
throwUnchecked :: ExceptT e m b -> m b
throwUnchecked ExceptT e m b
x =
    ExceptT e m b -> m (Either e b)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT e m b
x m (Either e b) -> (Either e b -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Right b
a -> b -> m b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
a
        Left e
e -> Unchecked e -> m b
forall a e. Exception e => e -> a
throw (Unchecked e -> m b) -> Unchecked e -> m b
forall a b. (a -> b) -> a -> b
$ e -> Unchecked e
forall e. e -> Unchecked e
Unchecked e
e

catchUnchecked :: (MonadCatch m, Typeable e, Show e) => m a -> ExceptT e m a
catchUnchecked :: m a -> ExceptT e m a
catchUnchecked m a
m =
    m (Either e a) -> ExceptT e m a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either e a) -> ExceptT e m a)
-> m (Either e a) -> ExceptT e m a
forall a b. (a -> b) -> a -> b
$
        (a -> Either e a
forall a b. b -> Either a b
Right (a -> Either e a) -> m a -> m (Either e a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
m) m (Either e a) -> (Unchecked e -> m (Either e a)) -> m (Either e a)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` (\(Unchecked e
e) -> Either e a -> m (Either e a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either e a -> m (Either e a)) -> Either e a -> m (Either e a)
forall a b. (a -> b) -> a -> b
$ e -> Either e a
forall a b. a -> Either a b
Left e
e)

throwSomeException :: Either SomeException t -> (t -> p) -> p
throwSomeException :: Either SomeException t -> (t -> p) -> p
throwSomeException (Left (SomeException e
e)) t -> p
_ = e -> p
forall a e. Exception e => e -> a
throw e
e
throwSomeException (Right t
x) t -> p
f = t -> p
f t
x