module Effectful.Zoo.Core.Exception
  ( Exception,
    catchIO,
    throwIO,
    trapIO,
  ) where

import Effectful
import Effectful.Exception (Exception)
import Effectful.Exception qualified as E
import HaskellWorks.Prelude

catchIO :: ()
  => E.Exception e
  => Eff es a
  -> (e -> Eff es a)
  -> Eff es a
catchIO :: forall e (es :: [Effect]) a.
Exception e =>
Eff es a -> (e -> Eff es a) -> Eff es a
catchIO =
  Eff es a -> (e -> Eff es a) -> Eff es a
forall e (es :: [Effect]) a.
Exception e =>
Eff es a -> (e -> Eff es a) -> Eff es a
E.catch

throwIO :: ()
  => HasCallStack
  => E.Exception e
  => e
  -> Eff es a
throwIO :: forall e (es :: [Effect]) a.
(HasCallStack, Exception e) =>
e -> Eff es a
throwIO =
  e -> Eff es a
forall e (es :: [Effect]) a.
(HasCallStack, Exception e) =>
e -> Eff es a
E.throwIO

trapIO
  :: E.Exception e
  => (e -> Eff es a)
  -> Eff es a
  -> Eff es a
trapIO :: forall e (es :: [Effect]) a.
Exception e =>
(e -> Eff es a) -> Eff es a -> Eff es a
trapIO =
  (Eff es a -> (e -> Eff es a) -> Eff es a)
-> (e -> Eff es a) -> Eff es a -> Eff es a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Eff es a -> (e -> Eff es a) -> Eff es a
forall e (es :: [Effect]) a.
Exception e =>
Eff es a -> (e -> Eff es a) -> Eff es a
catchIO