module Control.Effect.ErrorIO
  ( -- * Effects
    ErrorIO(..)
  , X.Exception(..)
  , SomeException

    -- * Actions
  , throwIO
  , catchIO

    -- * Interpretations
  , errorIOToIO

  , errorIOToError

    -- * MonadCatch
  , C.MonadCatch

    -- * Carriers
  , ErrorIOToIOC
  , ErrorIOToErrorC
  ) where

import Control.Monad

import Control.Effect
import Control.Effect.Optional
import Control.Effect.Type.ErrorIO
import Control.Effect.Type.Throw
import Control.Effect.Type.Catch

import Control.Exception (SomeException)
import qualified Control.Exception as X
import qualified Control.Monad.Catch as C

-- For coercion purposes
import Control.Monad.Trans.Identity
import Control.Effect.Carrier.Internal.Intro
import Control.Effect.Carrier.Internal.Compose
import Control.Effect.Carrier.Internal.Interpret
import Control.Effect.Internal.Utils

throwIO :: (X.Exception e, Eff ErrorIO m) => e -> m a
throwIO :: e -> m a
throwIO = ErrorIO m a -> m a
forall (e :: Effect) (m :: * -> *) a.
(Member e (Derivs m), Carrier m) =>
e m a -> m a
send (ErrorIO m a -> m a) -> (e -> ErrorIO m a) -> e -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> ErrorIO m a
forall e (m :: * -> *) a. Exception e => e -> ErrorIO m a
ThrowIO

catchIO :: (X.Exception e, Eff ErrorIO m) => m a -> (e -> m a) -> m a
catchIO :: m a -> (e -> m a) -> m a
catchIO m a
m e -> m a
h = ErrorIO m a -> m a
forall (e :: Effect) (m :: * -> *) a.
(Member e (Derivs m), Carrier m) =>
e m a -> m a
send (m a -> (e -> m a) -> ErrorIO m a
forall e (m :: * -> *) a.
Exception e =>
m a -> (e -> m a) -> ErrorIO m a
CatchIO m a
m e -> m a
h)

data ErrorIOFinalH

data ErrorIOToErrorH

instance ( C.MonadThrow m
         , Eff (Optional ((->) SomeException)) m
         )
      => Handler ErrorIOFinalH ErrorIO m where
  effHandler :: ErrorIO (Effly z) x -> Effly z x
effHandler = \case
    ThrowIO e
x   -> m x -> Effly z x
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (m x -> Effly z x) -> m x -> Effly z x
forall a b. (a -> b) -> a -> b
$ e -> m x
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
C.throwM e
x
    CatchIO Effly z x
m e -> Effly z x
h -> Effly z (Effly z x) -> Effly z x
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Effly z (Effly z x) -> Effly z x)
-> Effly z (Effly z x) -> Effly z x
forall a b. (a -> b) -> a -> b
$
      (SomeException -> Effly z x)
-> Effly z (Effly z x) -> Effly z (Effly z x)
forall (s :: * -> *) (m :: * -> *) a.
Eff (Optional s) m =>
s a -> m a -> m a
optionally
        (\SomeException
x -> case SomeException -> Maybe e
forall e. Exception e => SomeException -> Maybe e
X.fromException SomeException
x of
            Just e
e -> e -> Effly z x
h e
e
            Maybe e
Nothing -> m x -> Effly z x
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (m x -> Effly z x) -> m x -> Effly z x
forall a b. (a -> b) -> a -> b
$ SomeException -> m x
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
C.throwM SomeException
x
        )
        ((x -> Effly z x) -> Effly z x -> Effly z (Effly z x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> Effly z x
forall (f :: * -> *) a. Applicative f => a -> f a
pure Effly z x
m)
  {-# INLINEABLE effHandler #-}

instance ( C.MonadCatch m
         , Carrier m
         )
      => PrimHandler ErrorIOFinalH (Optional ((->) SomeException)) m where
  effPrimHandler :: Optional ((->) SomeException) m x -> m x
effPrimHandler = \case
    Optionally SomeException -> x
h m x
m -> m x
m m x -> (SomeException -> m x) -> m x
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`C.catch` (x -> m x
forall (m :: * -> *) a. Monad m => a -> m a
return (x -> m x) -> (SomeException -> x) -> SomeException -> m x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> x
h)
  {-# INLINEABLE effPrimHandler #-}


instance ( Eff (Error SomeException) m
         , Carrier m
         )
      => Handler ErrorIOToErrorH ErrorIO m where
  effHandler :: ErrorIO (Effly z) x -> Effly z x
effHandler = \case
    ThrowIO e
e -> Throw SomeException (Effly z) x -> Effly z x
forall (e :: Effect) (m :: * -> *) a.
(Member e (Derivs m), Carrier m) =>
e m a -> m a
send (Throw SomeException (Effly z) x -> Effly z x)
-> Throw SomeException (Effly z) x -> Effly z x
forall a b. (a -> b) -> a -> b
$ SomeException -> Throw SomeException (Effly z) x
forall e (m :: * -> *) a. e -> Throw e m a
Throw (e -> SomeException
forall e. Exception e => e -> SomeException
X.toException e
e)
    CatchIO Effly z x
m e -> Effly z x
h -> Catch SomeException (Effly z) x -> Effly z x
forall (e :: Effect) (m :: * -> *) a.
(Member e (Derivs m), Carrier m) =>
e m a -> m a
send (Catch SomeException (Effly z) x -> Effly z x)
-> Catch SomeException (Effly z) x -> Effly z x
forall a b. (a -> b) -> a -> b
$ Effly z x
-> (SomeException -> Effly z x) -> Catch SomeException (Effly z) x
forall (m :: * -> *) a e. m a -> (e -> m a) -> Catch e m a
Catch Effly z x
m ((SomeException -> Effly z x) -> Catch SomeException (Effly z) x)
-> (SomeException -> Effly z x) -> Catch SomeException (Effly z) x
forall a b. (a -> b) -> a -> b
$ \SomeException
e -> case SomeException -> Maybe e
forall e. Exception e => SomeException -> Maybe e
X.fromException SomeException
e of
      Just e
e' -> e -> Effly z x
h e
e'
      Maybe e
_       -> Throw SomeException (Effly z) x -> Effly z x
forall (e :: Effect) (m :: * -> *) a.
(Member e (Derivs m), Carrier m) =>
e m a -> m a
send (Throw SomeException (Effly z) x -> Effly z x)
-> Throw SomeException (Effly z) x -> Effly z x
forall a b. (a -> b) -> a -> b
$ SomeException -> Throw SomeException (Effly z) x
forall e (m :: * -> *) a. e -> Throw e m a
Throw SomeException
e
  {-# INLINEABLE effHandler #-}


type ErrorIOToIOC = CompositionC
 '[ ReinterpretC ErrorIOFinalH ErrorIO
     '[Optional ((->) SomeException)]
  , InterpretPrimC ErrorIOFinalH (Optional ((->) SomeException))
  ]

type ErrorIOToErrorC = InterpretC ErrorIOToErrorH ErrorIO

-- | Transform an @'ErrorIO'@ effect into an @'Error' 'SomeException'@
-- effect.
errorIOToError :: Eff (Error SomeException) m
               => ErrorIOToErrorC m a
               -> m a
errorIOToError :: ErrorIOToErrorC m a -> m a
errorIOToError = ErrorIOToErrorC m a -> m a
forall h (e :: Effect) (m :: * -> *) a.
Handler h e m =>
InterpretC h e m a -> m a
interpretViaHandler
{-# INLINE errorIOToError #-}

-- | Run an @'ErrorIO'@ effect by making use of 'IO' exceptions.
--
-- @'Derivs' (ErrorIOToIOC e m) = 'ErrorIO' ': 'Derivs' m@
--
-- @'Control.Effect.Carrier.Prims' (ErrorIOToIOC e m) = 'Control.Effect.Optional.Optional' ((->) 'SomeException') ': 'Control.Effect.Carrier.Prims' m@
errorIOToIO :: (Carrier m, C.MonadCatch m)
            => ErrorIOToIOC m a
            -> m a
errorIOToIO :: ErrorIOToIOC m a -> m a
errorIOToIO =
     InterpretPrimC ErrorIOFinalH (Optional ((->) SomeException)) m a
-> m a
forall h (e :: Effect) (m :: * -> *) a.
PrimHandler h e m =>
InterpretPrimC h e m a -> m a
interpretPrimViaHandler
  (InterpretPrimC ErrorIOFinalH (Optional ((->) SomeException)) m a
 -> m a)
-> (ReinterpretC
      ErrorIOFinalH
      ErrorIO
      '[Optional ((->) SomeException)]
      (InterpretPrimC ErrorIOFinalH (Optional ((->) SomeException)) m)
      a
    -> InterpretPrimC
         ErrorIOFinalH (Optional ((->) SomeException)) m a)
-> ReinterpretC
     ErrorIOFinalH
     ErrorIO
     '[Optional ((->) SomeException)]
     (InterpretPrimC ErrorIOFinalH (Optional ((->) SomeException)) m)
     a
-> m a
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# ReinterpretC
  ErrorIOFinalH
  ErrorIO
  '[Optional ((->) SomeException)]
  (InterpretPrimC ErrorIOFinalH (Optional ((->) SomeException)) m)
  a
-> InterpretPrimC ErrorIOFinalH (Optional ((->) SomeException)) m a
forall h (e :: Effect) (new :: [Effect]) (m :: * -> *) a.
(Handler h e m, KnownList new, HeadEffs new m) =>
ReinterpretC h e new m a -> m a
reinterpretViaHandler
  (ReinterpretC
   ErrorIOFinalH
   ErrorIO
   '[Optional ((->) SomeException)]
   (InterpretPrimC ErrorIOFinalH (Optional ((->) SomeException)) m)
   a
 -> m a)
-> (ErrorIOToIOC m a
    -> ReinterpretC
         ErrorIOFinalH
         ErrorIO
         '[Optional ((->) SomeException)]
         (InterpretPrimC ErrorIOFinalH (Optional ((->) SomeException)) m)
         a)
-> ErrorIOToIOC m a
-> m a
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# ErrorIOToIOC m a
-> ReinterpretC
     ErrorIOFinalH
     ErrorIO
     '[Optional ((->) SomeException)]
     (InterpretPrimC ErrorIOFinalH (Optional ((->) SomeException)) m)
     a
forall (ts :: [Effect]) (m :: * -> *) a.
CompositionC ts m a -> CompositionBaseM ts m a
runComposition
{-# INLINE errorIOToIO #-}