#if MTL
#endif
module Control.Effect.Exception (
EffectException, Exception, runException,
raise, except
) where
import Control.Effect.Bracket
import Control.Monad.Effect
#ifdef MTL
import Data.Type.Row
import qualified Control.Monad.Error.Class as E
instance (Member (Exception e) l, Exception e ~ InstanceOf Exception l) => E.MonadError e (Effect l) where
throwError = raise
catchError = except
#endif
data Exception e a = Raise e | Catch a (e -> a)
deriving Functor
type instance Is Exception f = IsException f
type family IsException f where
IsException (Exception e) = True
IsException f = False
class MemberEffect Exception (Exception e) l => EffectException e l
instance MemberEffect Exception (Exception e) l => EffectException e l
raise :: EffectException e l => e -> Effect l a
raise = send . Raise
except :: EffectException e l => Effect l a -> (e -> Effect l a) -> Effect l a
except x f = sendEffect (Catch x f)
runException :: (EffectBracket s l, Show e) => Effect (Exception e :+ l) a -> Effect l (Either e a)
runException effect = do
tag <- newTag show
exceptWith tag
(eliminate (return . Right) (bind tag) effect)
(return . Left)
where
bind tag (Raise e) = raiseWith tag e
bind tag (Catch x f) = exceptWith tag x f