{-# LANGUAGE DerivingVia #-}
{-# OPTIONS_HADDOCK not-home #-}
module Control.Effect.Internal.Exceptional where

import Control.Effect
import Control.Effect.Error
import Control.Effect.ErrorIO
import Control.Effect.Union

import Control.Effect.Carrier

import Control.Effect.Internal.Utils

-- For coercion purposes

import Control.Monad.Trans.Except
import Control.Effect.Internal.Error
import Control.Effect.Carrier.Internal.Interpret
import Control.Effect.Carrier.Internal.Intro
import Control.Effect.Carrier.Internal.Compose


-- | An effect that allows for the safe use of an effect @eff@ that may

-- throw exceptions of the type @exc@ by forcing the user to eventually

-- catch those exceptions at some point of the program.

--

-- The main combinator of 'Exceptional' is 'Control.Effect.Exceptional.catching'.

--

-- __This could be unsafe in the presence of 'Control.Effect.Conc.Conc'__.

-- If you use 'Control.Effect.Exceptional.catching' on a computation that:

--

-- * Spawns an asynchronous computation

-- * Throws an exception inside the asynchronous computation from a use of @eff@

-- * Returns the 'Control.Effect.Conc.Async' of that asynchronous computation

--

-- Then 'Control.Effect.Conc.wait'ing on that 'Control.Effect.Conc.Async'

-- outside of the 'Control.Effect.Exceptional.catching' will throw that exception

-- without it being caught.

newtype Exceptional eff exc m a = Exceptional (Union '[eff, Catch exc] m a)

-- | A particularly useful specialization of 'Exceptional', for gaining

-- restricted access to an @'Error' exc@ effect.

-- Main combinators are 'Control.Effect.Exceptional.catchSafe' and

-- 'Control.Effect.Exceptional.trySafe'.

type SafeError exc = Exceptional (Throw exc) exc

{-
"ExceptionallyC" can easily be implemented using Handler:

data ExceptionallyH exc

instance ( Eff (Exceptional eff exc) m
         , RepresentationalEff eff
         )
      => Handler (ExceptionallH exc) eff m where where
  effHandler e = send $ Exceptionally $ inj e

type ExceptionallyC eff exc = InterpretC (ExceptionallH exc) eff

catching :: forall eff exc m a
          . ( Eff (Exceptional eff exc) m
            , RepresentationalEff eff
            )
         => ExceptionallyC exc eff m a
         -> (exc -> m a)
         -> m a
catching m h =
  send $ Exceptional @eff @exc $
    inj (Catch @exc (interpretViaHandler m) h)

We use a standalone carrier to hide the RepresentationalEff constraint,
which is just noise in this case.
-}

newtype ExceptionallyC (eff :: Effect) (exc :: Type) m a = ExceptionallyC {
    ExceptionallyC eff exc m a -> m a
unExceptionallyC :: m a
  }
  deriving ( a -> ExceptionallyC eff exc m b -> ExceptionallyC eff exc m a
(a -> b)
-> ExceptionallyC eff exc m a -> ExceptionallyC eff exc m b
(forall a b.
 (a -> b)
 -> ExceptionallyC eff exc m a -> ExceptionallyC eff exc m b)
-> (forall a b.
    a -> ExceptionallyC eff exc m b -> ExceptionallyC eff exc m a)
-> Functor (ExceptionallyC eff exc m)
forall a b.
a -> ExceptionallyC eff exc m b -> ExceptionallyC eff exc m a
forall a b.
(a -> b)
-> ExceptionallyC eff exc m a -> ExceptionallyC eff exc m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (eff :: Effect) exc (m :: * -> *) a b.
Functor m =>
a -> ExceptionallyC eff exc m b -> ExceptionallyC eff exc m a
forall (eff :: Effect) exc (m :: * -> *) a b.
Functor m =>
(a -> b)
-> ExceptionallyC eff exc m a -> ExceptionallyC eff exc m b
<$ :: a -> ExceptionallyC eff exc m b -> ExceptionallyC eff exc m a
$c<$ :: forall (eff :: Effect) exc (m :: * -> *) a b.
Functor m =>
a -> ExceptionallyC eff exc m b -> ExceptionallyC eff exc m a
fmap :: (a -> b)
-> ExceptionallyC eff exc m a -> ExceptionallyC eff exc m b
$cfmap :: forall (eff :: Effect) exc (m :: * -> *) a b.
Functor m =>
(a -> b)
-> ExceptionallyC eff exc m a -> ExceptionallyC eff exc m b
Functor, Functor (ExceptionallyC eff exc m)
a -> ExceptionallyC eff exc m a
Functor (ExceptionallyC eff exc m)
-> (forall a. a -> ExceptionallyC eff exc m a)
-> (forall a b.
    ExceptionallyC eff exc m (a -> b)
    -> ExceptionallyC eff exc m a -> ExceptionallyC eff exc m b)
-> (forall a b c.
    (a -> b -> c)
    -> ExceptionallyC eff exc m a
    -> ExceptionallyC eff exc m b
    -> ExceptionallyC eff exc m c)
-> (forall a b.
    ExceptionallyC eff exc m a
    -> ExceptionallyC eff exc m b -> ExceptionallyC eff exc m b)
-> (forall a b.
    ExceptionallyC eff exc m a
    -> ExceptionallyC eff exc m b -> ExceptionallyC eff exc m a)
-> Applicative (ExceptionallyC eff exc m)
ExceptionallyC eff exc m a
-> ExceptionallyC eff exc m b -> ExceptionallyC eff exc m b
ExceptionallyC eff exc m a
-> ExceptionallyC eff exc m b -> ExceptionallyC eff exc m a
ExceptionallyC eff exc m (a -> b)
-> ExceptionallyC eff exc m a -> ExceptionallyC eff exc m b
(a -> b -> c)
-> ExceptionallyC eff exc m a
-> ExceptionallyC eff exc m b
-> ExceptionallyC eff exc m c
forall a. a -> ExceptionallyC eff exc m a
forall a b.
ExceptionallyC eff exc m a
-> ExceptionallyC eff exc m b -> ExceptionallyC eff exc m a
forall a b.
ExceptionallyC eff exc m a
-> ExceptionallyC eff exc m b -> ExceptionallyC eff exc m b
forall a b.
ExceptionallyC eff exc m (a -> b)
-> ExceptionallyC eff exc m a -> ExceptionallyC eff exc m b
forall a b c.
(a -> b -> c)
-> ExceptionallyC eff exc m a
-> ExceptionallyC eff exc m b
-> ExceptionallyC eff exc m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (eff :: Effect) exc (m :: * -> *).
Applicative m =>
Functor (ExceptionallyC eff exc m)
forall (eff :: Effect) exc (m :: * -> *) a.
Applicative m =>
a -> ExceptionallyC eff exc m a
forall (eff :: Effect) exc (m :: * -> *) a b.
Applicative m =>
ExceptionallyC eff exc m a
-> ExceptionallyC eff exc m b -> ExceptionallyC eff exc m a
forall (eff :: Effect) exc (m :: * -> *) a b.
Applicative m =>
ExceptionallyC eff exc m a
-> ExceptionallyC eff exc m b -> ExceptionallyC eff exc m b
forall (eff :: Effect) exc (m :: * -> *) a b.
Applicative m =>
ExceptionallyC eff exc m (a -> b)
-> ExceptionallyC eff exc m a -> ExceptionallyC eff exc m b
forall (eff :: Effect) exc (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> ExceptionallyC eff exc m a
-> ExceptionallyC eff exc m b
-> ExceptionallyC eff exc m c
<* :: ExceptionallyC eff exc m a
-> ExceptionallyC eff exc m b -> ExceptionallyC eff exc m a
$c<* :: forall (eff :: Effect) exc (m :: * -> *) a b.
Applicative m =>
ExceptionallyC eff exc m a
-> ExceptionallyC eff exc m b -> ExceptionallyC eff exc m a
*> :: ExceptionallyC eff exc m a
-> ExceptionallyC eff exc m b -> ExceptionallyC eff exc m b
$c*> :: forall (eff :: Effect) exc (m :: * -> *) a b.
Applicative m =>
ExceptionallyC eff exc m a
-> ExceptionallyC eff exc m b -> ExceptionallyC eff exc m b
liftA2 :: (a -> b -> c)
-> ExceptionallyC eff exc m a
-> ExceptionallyC eff exc m b
-> ExceptionallyC eff exc m c
$cliftA2 :: forall (eff :: Effect) exc (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> ExceptionallyC eff exc m a
-> ExceptionallyC eff exc m b
-> ExceptionallyC eff exc m c
<*> :: ExceptionallyC eff exc m (a -> b)
-> ExceptionallyC eff exc m a -> ExceptionallyC eff exc m b
$c<*> :: forall (eff :: Effect) exc (m :: * -> *) a b.
Applicative m =>
ExceptionallyC eff exc m (a -> b)
-> ExceptionallyC eff exc m a -> ExceptionallyC eff exc m b
pure :: a -> ExceptionallyC eff exc m a
$cpure :: forall (eff :: Effect) exc (m :: * -> *) a.
Applicative m =>
a -> ExceptionallyC eff exc m a
$cp1Applicative :: forall (eff :: Effect) exc (m :: * -> *).
Applicative m =>
Functor (ExceptionallyC eff exc m)
Applicative, Applicative (ExceptionallyC eff exc m)
a -> ExceptionallyC eff exc m a
Applicative (ExceptionallyC eff exc m)
-> (forall a b.
    ExceptionallyC eff exc m a
    -> (a -> ExceptionallyC eff exc m b) -> ExceptionallyC eff exc m b)
-> (forall a b.
    ExceptionallyC eff exc m a
    -> ExceptionallyC eff exc m b -> ExceptionallyC eff exc m b)
-> (forall a. a -> ExceptionallyC eff exc m a)
-> Monad (ExceptionallyC eff exc m)
ExceptionallyC eff exc m a
-> (a -> ExceptionallyC eff exc m b) -> ExceptionallyC eff exc m b
ExceptionallyC eff exc m a
-> ExceptionallyC eff exc m b -> ExceptionallyC eff exc m b
forall a. a -> ExceptionallyC eff exc m a
forall a b.
ExceptionallyC eff exc m a
-> ExceptionallyC eff exc m b -> ExceptionallyC eff exc m b
forall a b.
ExceptionallyC eff exc m a
-> (a -> ExceptionallyC eff exc m b) -> ExceptionallyC eff exc m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
forall (eff :: Effect) exc (m :: * -> *).
Monad m =>
Applicative (ExceptionallyC eff exc m)
forall (eff :: Effect) exc (m :: * -> *) a.
Monad m =>
a -> ExceptionallyC eff exc m a
forall (eff :: Effect) exc (m :: * -> *) a b.
Monad m =>
ExceptionallyC eff exc m a
-> ExceptionallyC eff exc m b -> ExceptionallyC eff exc m b
forall (eff :: Effect) exc (m :: * -> *) a b.
Monad m =>
ExceptionallyC eff exc m a
-> (a -> ExceptionallyC eff exc m b) -> ExceptionallyC eff exc m b
return :: a -> ExceptionallyC eff exc m a
$creturn :: forall (eff :: Effect) exc (m :: * -> *) a.
Monad m =>
a -> ExceptionallyC eff exc m a
>> :: ExceptionallyC eff exc m a
-> ExceptionallyC eff exc m b -> ExceptionallyC eff exc m b
$c>> :: forall (eff :: Effect) exc (m :: * -> *) a b.
Monad m =>
ExceptionallyC eff exc m a
-> ExceptionallyC eff exc m b -> ExceptionallyC eff exc m b
>>= :: ExceptionallyC eff exc m a
-> (a -> ExceptionallyC eff exc m b) -> ExceptionallyC eff exc m b
$c>>= :: forall (eff :: Effect) exc (m :: * -> *) a b.
Monad m =>
ExceptionallyC eff exc m a
-> (a -> ExceptionallyC eff exc m b) -> ExceptionallyC eff exc m b
$cp1Monad :: forall (eff :: Effect) exc (m :: * -> *).
Monad m =>
Applicative (ExceptionallyC eff exc m)
Monad
           , Applicative (ExceptionallyC eff exc m)
ExceptionallyC eff exc m a
Applicative (ExceptionallyC eff exc m)
-> (forall a. ExceptionallyC eff exc m a)
-> (forall a.
    ExceptionallyC eff exc m a
    -> ExceptionallyC eff exc m a -> ExceptionallyC eff exc m a)
-> (forall a.
    ExceptionallyC eff exc m a -> ExceptionallyC eff exc m [a])
-> (forall a.
    ExceptionallyC eff exc m a -> ExceptionallyC eff exc m [a])
-> Alternative (ExceptionallyC eff exc m)
ExceptionallyC eff exc m a
-> ExceptionallyC eff exc m a -> ExceptionallyC eff exc m a
ExceptionallyC eff exc m a -> ExceptionallyC eff exc m [a]
ExceptionallyC eff exc m a -> ExceptionallyC eff exc m [a]
forall a. ExceptionallyC eff exc m a
forall a.
ExceptionallyC eff exc m a -> ExceptionallyC eff exc m [a]
forall a.
ExceptionallyC eff exc m a
-> ExceptionallyC eff exc m a -> ExceptionallyC eff exc m a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
forall (eff :: Effect) exc (m :: * -> *).
Alternative m =>
Applicative (ExceptionallyC eff exc m)
forall (eff :: Effect) exc (m :: * -> *) a.
Alternative m =>
ExceptionallyC eff exc m a
forall (eff :: Effect) exc (m :: * -> *) a.
Alternative m =>
ExceptionallyC eff exc m a -> ExceptionallyC eff exc m [a]
forall (eff :: Effect) exc (m :: * -> *) a.
Alternative m =>
ExceptionallyC eff exc m a
-> ExceptionallyC eff exc m a -> ExceptionallyC eff exc m a
many :: ExceptionallyC eff exc m a -> ExceptionallyC eff exc m [a]
$cmany :: forall (eff :: Effect) exc (m :: * -> *) a.
Alternative m =>
ExceptionallyC eff exc m a -> ExceptionallyC eff exc m [a]
some :: ExceptionallyC eff exc m a -> ExceptionallyC eff exc m [a]
$csome :: forall (eff :: Effect) exc (m :: * -> *) a.
Alternative m =>
ExceptionallyC eff exc m a -> ExceptionallyC eff exc m [a]
<|> :: ExceptionallyC eff exc m a
-> ExceptionallyC eff exc m a -> ExceptionallyC eff exc m a
$c<|> :: forall (eff :: Effect) exc (m :: * -> *) a.
Alternative m =>
ExceptionallyC eff exc m a
-> ExceptionallyC eff exc m a -> ExceptionallyC eff exc m a
empty :: ExceptionallyC eff exc m a
$cempty :: forall (eff :: Effect) exc (m :: * -> *) a.
Alternative m =>
ExceptionallyC eff exc m a
$cp1Alternative :: forall (eff :: Effect) exc (m :: * -> *).
Alternative m =>
Applicative (ExceptionallyC eff exc m)
Alternative, Monad (ExceptionallyC eff exc m)
Alternative (ExceptionallyC eff exc m)
ExceptionallyC eff exc m a
Alternative (ExceptionallyC eff exc m)
-> Monad (ExceptionallyC eff exc m)
-> (forall a. ExceptionallyC eff exc m a)
-> (forall a.
    ExceptionallyC eff exc m a
    -> ExceptionallyC eff exc m a -> ExceptionallyC eff exc m a)
-> MonadPlus (ExceptionallyC eff exc m)
ExceptionallyC eff exc m a
-> ExceptionallyC eff exc m a -> ExceptionallyC eff exc m a
forall a. ExceptionallyC eff exc m a
forall a.
ExceptionallyC eff exc m a
-> ExceptionallyC eff exc m a -> ExceptionallyC eff exc m a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
forall (eff :: Effect) exc (m :: * -> *).
MonadPlus m =>
Monad (ExceptionallyC eff exc m)
forall (eff :: Effect) exc (m :: * -> *).
MonadPlus m =>
Alternative (ExceptionallyC eff exc m)
forall (eff :: Effect) exc (m :: * -> *) a.
MonadPlus m =>
ExceptionallyC eff exc m a
forall (eff :: Effect) exc (m :: * -> *) a.
MonadPlus m =>
ExceptionallyC eff exc m a
-> ExceptionallyC eff exc m a -> ExceptionallyC eff exc m a
mplus :: ExceptionallyC eff exc m a
-> ExceptionallyC eff exc m a -> ExceptionallyC eff exc m a
$cmplus :: forall (eff :: Effect) exc (m :: * -> *) a.
MonadPlus m =>
ExceptionallyC eff exc m a
-> ExceptionallyC eff exc m a -> ExceptionallyC eff exc m a
mzero :: ExceptionallyC eff exc m a
$cmzero :: forall (eff :: Effect) exc (m :: * -> *) a.
MonadPlus m =>
ExceptionallyC eff exc m a
$cp2MonadPlus :: forall (eff :: Effect) exc (m :: * -> *).
MonadPlus m =>
Monad (ExceptionallyC eff exc m)
$cp1MonadPlus :: forall (eff :: Effect) exc (m :: * -> *).
MonadPlus m =>
Alternative (ExceptionallyC eff exc m)
MonadPlus
           , Monad (ExceptionallyC eff exc m)
Monad (ExceptionallyC eff exc m)
-> (forall a.
    (a -> ExceptionallyC eff exc m a) -> ExceptionallyC eff exc m a)
-> MonadFix (ExceptionallyC eff exc m)
(a -> ExceptionallyC eff exc m a) -> ExceptionallyC eff exc m a
forall a.
(a -> ExceptionallyC eff exc m a) -> ExceptionallyC eff exc m a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
forall (eff :: Effect) exc (m :: * -> *).
MonadFix m =>
Monad (ExceptionallyC eff exc m)
forall (eff :: Effect) exc (m :: * -> *) a.
MonadFix m =>
(a -> ExceptionallyC eff exc m a) -> ExceptionallyC eff exc m a
mfix :: (a -> ExceptionallyC eff exc m a) -> ExceptionallyC eff exc m a
$cmfix :: forall (eff :: Effect) exc (m :: * -> *) a.
MonadFix m =>
(a -> ExceptionallyC eff exc m a) -> ExceptionallyC eff exc m a
$cp1MonadFix :: forall (eff :: Effect) exc (m :: * -> *).
MonadFix m =>
Monad (ExceptionallyC eff exc m)
MonadFix, Monad (ExceptionallyC eff exc m)
Monad (ExceptionallyC eff exc m)
-> (forall a. String -> ExceptionallyC eff exc m a)
-> MonadFail (ExceptionallyC eff exc m)
String -> ExceptionallyC eff exc m a
forall a. String -> ExceptionallyC eff exc m a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
forall (eff :: Effect) exc (m :: * -> *).
MonadFail m =>
Monad (ExceptionallyC eff exc m)
forall (eff :: Effect) exc (m :: * -> *) a.
MonadFail m =>
String -> ExceptionallyC eff exc m a
fail :: String -> ExceptionallyC eff exc m a
$cfail :: forall (eff :: Effect) exc (m :: * -> *) a.
MonadFail m =>
String -> ExceptionallyC eff exc m a
$cp1MonadFail :: forall (eff :: Effect) exc (m :: * -> *).
MonadFail m =>
Monad (ExceptionallyC eff exc m)
MonadFail, Monad (ExceptionallyC eff exc m)
Monad (ExceptionallyC eff exc m)
-> (forall a. IO a -> ExceptionallyC eff exc m a)
-> MonadIO (ExceptionallyC eff exc m)
IO a -> ExceptionallyC eff exc m a
forall a. IO a -> ExceptionallyC eff exc m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall (eff :: Effect) exc (m :: * -> *).
MonadIO m =>
Monad (ExceptionallyC eff exc m)
forall (eff :: Effect) exc (m :: * -> *) a.
MonadIO m =>
IO a -> ExceptionallyC eff exc m a
liftIO :: IO a -> ExceptionallyC eff exc m a
$cliftIO :: forall (eff :: Effect) exc (m :: * -> *) a.
MonadIO m =>
IO a -> ExceptionallyC eff exc m a
$cp1MonadIO :: forall (eff :: Effect) exc (m :: * -> *).
MonadIO m =>
Monad (ExceptionallyC eff exc m)
MonadIO
           , Monad (ExceptionallyC eff exc m)
e -> ExceptionallyC eff exc m a
Monad (ExceptionallyC eff exc m)
-> (forall e a. Exception e => e -> ExceptionallyC eff exc m a)
-> MonadThrow (ExceptionallyC eff exc m)
forall e a. Exception e => e -> ExceptionallyC eff exc m a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
forall (eff :: Effect) exc (m :: * -> *).
MonadThrow m =>
Monad (ExceptionallyC eff exc m)
forall (eff :: Effect) exc (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> ExceptionallyC eff exc m a
throwM :: e -> ExceptionallyC eff exc m a
$cthrowM :: forall (eff :: Effect) exc (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> ExceptionallyC eff exc m a
$cp1MonadThrow :: forall (eff :: Effect) exc (m :: * -> *).
MonadThrow m =>
Monad (ExceptionallyC eff exc m)
MonadThrow, MonadThrow (ExceptionallyC eff exc m)
MonadThrow (ExceptionallyC eff exc m)
-> (forall e a.
    Exception e =>
    ExceptionallyC eff exc m a
    -> (e -> ExceptionallyC eff exc m a) -> ExceptionallyC eff exc m a)
-> MonadCatch (ExceptionallyC eff exc m)
ExceptionallyC eff exc m a
-> (e -> ExceptionallyC eff exc m a) -> ExceptionallyC eff exc m a
forall e a.
Exception e =>
ExceptionallyC eff exc m a
-> (e -> ExceptionallyC eff exc m a) -> ExceptionallyC eff exc m a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
forall (eff :: Effect) exc (m :: * -> *).
MonadCatch m =>
MonadThrow (ExceptionallyC eff exc m)
forall (eff :: Effect) exc (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
ExceptionallyC eff exc m a
-> (e -> ExceptionallyC eff exc m a) -> ExceptionallyC eff exc m a
catch :: ExceptionallyC eff exc m a
-> (e -> ExceptionallyC eff exc m a) -> ExceptionallyC eff exc m a
$ccatch :: forall (eff :: Effect) exc (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
ExceptionallyC eff exc m a
-> (e -> ExceptionallyC eff exc m a) -> ExceptionallyC eff exc m a
$cp1MonadCatch :: forall (eff :: Effect) exc (m :: * -> *).
MonadCatch m =>
MonadThrow (ExceptionallyC eff exc m)
MonadCatch, MonadCatch (ExceptionallyC eff exc m)
MonadCatch (ExceptionallyC eff exc m)
-> (forall b.
    ((forall a.
      ExceptionallyC eff exc m a -> ExceptionallyC eff exc m a)
     -> ExceptionallyC eff exc m b)
    -> ExceptionallyC eff exc m b)
-> (forall b.
    ((forall a.
      ExceptionallyC eff exc m a -> ExceptionallyC eff exc m a)
     -> ExceptionallyC eff exc m b)
    -> ExceptionallyC eff exc m b)
-> (forall a b c.
    ExceptionallyC eff exc m a
    -> (a -> ExitCase b -> ExceptionallyC eff exc m c)
    -> (a -> ExceptionallyC eff exc m b)
    -> ExceptionallyC eff exc m (b, c))
-> MonadMask (ExceptionallyC eff exc m)
ExceptionallyC eff exc m a
-> (a -> ExitCase b -> ExceptionallyC eff exc m c)
-> (a -> ExceptionallyC eff exc m b)
-> ExceptionallyC eff exc m (b, c)
((forall a.
  ExceptionallyC eff exc m a -> ExceptionallyC eff exc m a)
 -> ExceptionallyC eff exc m b)
-> ExceptionallyC eff exc m b
((forall a.
  ExceptionallyC eff exc m a -> ExceptionallyC eff exc m a)
 -> ExceptionallyC eff exc m b)
-> ExceptionallyC eff exc m b
forall b.
((forall a.
  ExceptionallyC eff exc m a -> ExceptionallyC eff exc m a)
 -> ExceptionallyC eff exc m b)
-> ExceptionallyC eff exc m b
forall a b c.
ExceptionallyC eff exc m a
-> (a -> ExitCase b -> ExceptionallyC eff exc m c)
-> (a -> ExceptionallyC eff exc m b)
-> ExceptionallyC eff exc m (b, c)
forall (m :: * -> *).
MonadCatch m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
forall (eff :: Effect) exc (m :: * -> *).
MonadMask m =>
MonadCatch (ExceptionallyC eff exc m)
forall (eff :: Effect) exc (m :: * -> *) b.
MonadMask m =>
((forall a.
  ExceptionallyC eff exc m a -> ExceptionallyC eff exc m a)
 -> ExceptionallyC eff exc m b)
-> ExceptionallyC eff exc m b
forall (eff :: Effect) exc (m :: * -> *) a b c.
MonadMask m =>
ExceptionallyC eff exc m a
-> (a -> ExitCase b -> ExceptionallyC eff exc m c)
-> (a -> ExceptionallyC eff exc m b)
-> ExceptionallyC eff exc m (b, c)
generalBracket :: ExceptionallyC eff exc m a
-> (a -> ExitCase b -> ExceptionallyC eff exc m c)
-> (a -> ExceptionallyC eff exc m b)
-> ExceptionallyC eff exc m (b, c)
$cgeneralBracket :: forall (eff :: Effect) exc (m :: * -> *) a b c.
MonadMask m =>
ExceptionallyC eff exc m a
-> (a -> ExitCase b -> ExceptionallyC eff exc m c)
-> (a -> ExceptionallyC eff exc m b)
-> ExceptionallyC eff exc m (b, c)
uninterruptibleMask :: ((forall a.
  ExceptionallyC eff exc m a -> ExceptionallyC eff exc m a)
 -> ExceptionallyC eff exc m b)
-> ExceptionallyC eff exc m b
$cuninterruptibleMask :: forall (eff :: Effect) exc (m :: * -> *) b.
MonadMask m =>
((forall a.
  ExceptionallyC eff exc m a -> ExceptionallyC eff exc m a)
 -> ExceptionallyC eff exc m b)
-> ExceptionallyC eff exc m b
mask :: ((forall a.
  ExceptionallyC eff exc m a -> ExceptionallyC eff exc m a)
 -> ExceptionallyC eff exc m b)
-> ExceptionallyC eff exc m b
$cmask :: forall (eff :: Effect) exc (m :: * -> *) b.
MonadMask m =>
((forall a.
  ExceptionallyC eff exc m a -> ExceptionallyC eff exc m a)
 -> ExceptionallyC eff exc m b)
-> ExceptionallyC eff exc m b
$cp1MonadMask :: forall (eff :: Effect) exc (m :: * -> *).
MonadMask m =>
MonadCatch (ExceptionallyC eff exc m)
MonadMask
           , MonadBase b, MonadBaseControl b
           )
  deriving (m a -> ExceptionallyC eff exc m a
(forall (m :: * -> *) a.
 Monad m =>
 m a -> ExceptionallyC eff exc m a)
-> MonadTrans (ExceptionallyC eff exc)
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptionallyC eff exc m a
forall (t :: Effect).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
forall (eff :: Effect) exc (m :: * -> *) a.
Monad m =>
m a -> ExceptionallyC eff exc m a
lift :: m a -> ExceptionallyC eff exc m a
$clift :: forall (eff :: Effect) exc (m :: * -> *) a.
Monad m =>
m a -> ExceptionallyC eff exc m a
MonadTrans, MonadTrans (ExceptionallyC eff exc)
m (StT (ExceptionallyC eff exc) a) -> ExceptionallyC eff exc m a
MonadTrans (ExceptionallyC eff exc)
-> (forall (m :: * -> *) a.
    Monad m =>
    (Run (ExceptionallyC eff exc) -> m a)
    -> ExceptionallyC eff exc m a)
-> (forall (m :: * -> *) a.
    Monad m =>
    m (StT (ExceptionallyC eff exc) a) -> ExceptionallyC eff exc m a)
-> MonadTransControl (ExceptionallyC eff exc)
(Run (ExceptionallyC eff exc) -> m a) -> ExceptionallyC eff exc m a
forall (m :: * -> *) a.
Monad m =>
m (StT (ExceptionallyC eff exc) a) -> ExceptionallyC eff exc m a
forall (m :: * -> *) a.
Monad m =>
(Run (ExceptionallyC eff exc) -> m a) -> ExceptionallyC eff exc m a
forall (t :: Effect).
MonadTrans t
-> (forall (m :: * -> *) a. Monad m => (Run t -> m a) -> t m a)
-> (forall (m :: * -> *) a. Monad m => m (StT t a) -> t m a)
-> MonadTransControl t
forall (eff :: Effect) exc. MonadTrans (ExceptionallyC eff exc)
forall (eff :: Effect) exc (m :: * -> *) a.
Monad m =>
m (StT (ExceptionallyC eff exc) a) -> ExceptionallyC eff exc m a
forall (eff :: Effect) exc (m :: * -> *) a.
Monad m =>
(Run (ExceptionallyC eff exc) -> m a) -> ExceptionallyC eff exc m a
restoreT :: m (StT (ExceptionallyC eff exc) a) -> ExceptionallyC eff exc m a
$crestoreT :: forall (eff :: Effect) exc (m :: * -> *) a.
Monad m =>
m (StT (ExceptionallyC eff exc) a) -> ExceptionallyC eff exc m a
liftWith :: (Run (ExceptionallyC eff exc) -> m a) -> ExceptionallyC eff exc m a
$cliftWith :: forall (eff :: Effect) exc (m :: * -> *) a.
Monad m =>
(Run (ExceptionallyC eff exc) -> m a) -> ExceptionallyC eff exc m a
$cp1MonadTransControl :: forall (eff :: Effect) exc. MonadTrans (ExceptionallyC eff exc)
MonadTransControl) via IdentityT

instance Eff (Exceptional eff exc) m
      => Carrier (ExceptionallyC eff exc m) where
  type Derivs (ExceptionallyC eff exc m) = Catch exc ': eff ': Derivs m
  type Prims  (ExceptionallyC eff exc m) = Prims m

  algPrims :: Algebra'
  (Prims (ExceptionallyC eff exc m)) (ExceptionallyC eff exc m) a
algPrims = (Union (Prims m) m a -> m a)
-> Algebra' (Prims m) (ExceptionallyC eff exc m) a
coerce (forall a. Carrier m => Algebra' (Prims m) m a
forall (m :: * -> *) a. Carrier m => Algebra' (Prims m) m a
algPrims @m)
  {-# INLINEABLE algPrims #-}

  reformulate :: Reformulation'
  (Derivs (ExceptionallyC eff exc m))
  (Prims (ExceptionallyC eff exc m))
  (ExceptionallyC eff exc m)
  z
  a
reformulate forall x. ExceptionallyC eff exc m x -> z x
n Algebra (Prims (ExceptionallyC eff exc m)) z
alg =
    Algebra' (eff : Derivs m) z a
-> (Catch exc z a -> z a)
-> Algebra' (Catch exc : eff : Derivs m) z a
forall (e :: Effect) (r :: [Effect]) (m :: * -> *) a.
RepresentationalEff e =>
Algebra' r m a -> (e m a -> m a) -> Algebra' (e : r) m a
powerAlg (
    Algebra' (Derivs m) z a
-> (forall (z :: * -> *). Coercible z z => eff z a -> z a)
-> Algebra' (eff : Derivs m) z a
forall (e :: Effect) (r :: [Effect]) (m :: * -> *) a.
Algebra' r m a
-> (forall (z :: * -> *). Coercible z m => e z a -> m a)
-> Algebra' (e : r) m a
powerAlg' (
      Reformulation' (Derivs m) (Prims m) m z a
forall (m :: * -> *) (z :: * -> *) a.
(Carrier m, Monad z) =>
Reformulation' (Derivs m) (Prims m) m z a
reformulate (ExceptionallyC eff exc m x -> z x
forall x. ExceptionallyC eff exc m x -> z x
n (ExceptionallyC eff exc m x -> z x)
-> (m x -> ExceptionallyC eff exc m x) -> m x -> z x
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# m x -> ExceptionallyC eff exc m x
forall (t :: Effect) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift) forall x. Union (Prims m) z x -> z x
Algebra (Prims (ExceptionallyC eff exc m)) z
alg
    ) ((forall (z :: * -> *). Coercible z z => eff z a -> z a)
 -> Algebra' (eff : Derivs m) z a)
-> (forall (z :: * -> *). Coercible z z => eff z a -> z a)
-> Algebra' (eff : Derivs m) z a
forall a b. (a -> b) -> a -> b
$ \eff z a
e ->
      Reformulation' (Derivs m) (Prims m) m z a
forall (m :: * -> *) (z :: * -> *) a.
(Carrier m, Monad z) =>
Reformulation' (Derivs m) (Prims m) m z a
reformulate (ExceptionallyC eff exc m x -> z x
forall x. ExceptionallyC eff exc m x -> z x
n (ExceptionallyC eff exc m x -> z x)
-> (m x -> ExceptionallyC eff exc m x) -> m x -> z x
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# m x -> ExceptionallyC eff exc m x
forall (t :: Effect) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift) forall x. Union (Prims m) z x -> z x
Algebra (Prims (ExceptionallyC eff exc m)) z
alg Algebra' (Derivs m) z a -> Algebra' (Derivs m) z a
forall a b. (a -> b) -> a -> b
$ Exceptional eff exc z a -> Union (Derivs m) z a
forall (e :: Effect) (r :: [Effect]) (m :: * -> *) a.
Member e r =>
e m a -> Union r m a
inj (Exceptional eff exc z a -> Union (Derivs m) z a)
-> Exceptional eff exc z a -> Union (Derivs m) z a
forall a b. (a -> b) -> a -> b
$
        Union '[eff, Catch exc] z a -> Exceptional eff exc z a
forall (eff :: Effect) exc (m :: * -> *) a.
Union '[eff, Catch exc] m a -> Exceptional eff exc m a
Exceptional @eff @exc (ElemOf eff '[eff, Catch exc]
-> eff z a -> Union '[eff, Catch exc] z a
forall (z :: * -> *) (m :: * -> *) (e :: Effect) (r :: [Effect]) a.
Coercible z m =>
ElemOf e r -> e z a -> Union r m a
Union ElemOf eff '[eff, Catch exc]
forall a (e :: a) (r :: [a]). ElemOf e (e : r)
Here eff z a
e)
    ) ((Catch exc z a -> z a)
 -> Algebra' (Catch exc : eff : Derivs m) z a)
-> (Catch exc z a -> z a)
-> Algebra' (Catch exc : eff : Derivs m) z a
forall a b. (a -> b) -> a -> b
$ \Catch exc z a
e ->
      Reformulation' (Derivs m) (Prims m) m z a
forall (m :: * -> *) (z :: * -> *) a.
(Carrier m, Monad z) =>
Reformulation' (Derivs m) (Prims m) m z a
reformulate (ExceptionallyC eff exc m x -> z x
forall x. ExceptionallyC eff exc m x -> z x
n (ExceptionallyC eff exc m x -> z x)
-> (m x -> ExceptionallyC eff exc m x) -> m x -> z x
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# m x -> ExceptionallyC eff exc m x
forall (t :: Effect) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift) forall x. Union (Prims m) z x -> z x
Algebra (Prims (ExceptionallyC eff exc m)) z
alg Algebra' (Derivs m) z a -> Algebra' (Derivs m) z a
forall a b. (a -> b) -> a -> b
$ Exceptional eff exc z a -> Union (Derivs m) z a
forall (e :: Effect) (r :: [Effect]) (m :: * -> *) a.
Member e r =>
e m a -> Union r m a
inj (Exceptional eff exc z a -> Union (Derivs m) z a)
-> Exceptional eff exc z a -> Union (Derivs m) z a
forall a b. (a -> b) -> a -> b
$
        Union '[eff, Catch exc] z a -> Exceptional eff exc z a
forall (eff :: Effect) exc (m :: * -> *) a.
Union '[eff, Catch exc] m a -> Exceptional eff exc m a
Exceptional @eff @exc (ElemOf (Catch exc) '[eff, Catch exc]
-> Catch exc z a -> Union '[eff, Catch exc] z a
forall (z :: * -> *) (m :: * -> *) (e :: Effect) (r :: [Effect]) a.
Coercible z m =>
ElemOf e r -> e z a -> Union r m a
Union (ElemOf (Catch exc) '[Catch exc]
-> ElemOf (Catch exc) '[eff, Catch exc]
forall a (e :: a) (r :: [a]) (_e :: a).
ElemOf e r -> ElemOf e (_e : r)
There ElemOf (Catch exc) '[Catch exc]
forall a (e :: a) (r :: [a]). ElemOf e (e : r)
Here) Catch exc z a
e)
  {-# INLINEABLE reformulate #-}

  algDerivs :: Algebra'
  (Derivs (ExceptionallyC eff exc m)) (ExceptionallyC eff exc m) a
algDerivs =
    Algebra' (eff : Derivs m) (ExceptionallyC eff exc m) a
-> (Catch exc (ExceptionallyC eff exc m) a
    -> ExceptionallyC eff exc m a)
-> Algebra'
     (Catch exc : eff : Derivs m) (ExceptionallyC eff exc m) a
forall (e :: Effect) (r :: [Effect]) (m :: * -> *) a.
RepresentationalEff e =>
Algebra' r m a -> (e m a -> m a) -> Algebra' (e : r) m a
powerAlg (
    Algebra' (Derivs m) (ExceptionallyC eff exc m) a
-> (forall (z :: * -> *).
    Coercible z (ExceptionallyC eff exc m) =>
    eff z a -> ExceptionallyC eff exc m a)
-> Algebra' (eff : Derivs m) (ExceptionallyC eff exc m) a
forall (e :: Effect) (r :: [Effect]) (m :: * -> *) a.
Algebra' r m a
-> (forall (z :: * -> *). Coercible z m => e z a -> m a)
-> Algebra' (e : r) m a
powerAlg' (
      Algebra' (Derivs m) m a
-> Algebra' (Derivs m) (ExceptionallyC eff exc m) a
coerce (forall a. Carrier m => Algebra' (Derivs m) m a
forall (m :: * -> *) a. Carrier m => Algebra' (Derivs m) m a
algDerivs @m)
    ) ((forall (z :: * -> *).
  Coercible z (ExceptionallyC eff exc m) =>
  eff z a -> ExceptionallyC eff exc m a)
 -> Algebra' (eff : Derivs m) (ExceptionallyC eff exc m) a)
-> (forall (z :: * -> *).
    Coercible z (ExceptionallyC eff exc m) =>
    eff z a -> ExceptionallyC eff exc m a)
-> Algebra' (eff : Derivs m) (ExceptionallyC eff exc m) a
forall a b. (a -> b) -> a -> b
$ \eff z a
e ->
      Algebra' (Derivs m) m a
-> Algebra' (Derivs m) (ExceptionallyC eff exc m) a
forall (n :: * -> *) (m :: * -> *) (e :: Effect) a b.
(Coercible n m, RepresentationalEff e) =>
(e m a -> m b) -> e n a -> n b
coerceAlg (forall a. Carrier m => Algebra' (Derivs m) m a
forall (m :: * -> *) a. Carrier m => Algebra' (Derivs m) m a
algDerivs @m) Algebra' (Derivs m) (ExceptionallyC eff exc m) a
-> Algebra' (Derivs m) (ExceptionallyC eff exc m) a
forall a b. (a -> b) -> a -> b
$ Exceptional eff exc (ExceptionallyC eff exc m) a
-> Union (Derivs m) (ExceptionallyC eff exc m) a
forall (e :: Effect) (r :: [Effect]) (m :: * -> *) a.
Member e r =>
e m a -> Union r m a
inj (Exceptional eff exc (ExceptionallyC eff exc m) a
 -> Union (Derivs m) (ExceptionallyC eff exc m) a)
-> Exceptional eff exc (ExceptionallyC eff exc m) a
-> Union (Derivs m) (ExceptionallyC eff exc m) a
forall a b. (a -> b) -> a -> b
$ Union '[eff, Catch exc] (ExceptionallyC eff exc m) a
-> Exceptional eff exc (ExceptionallyC eff exc m) a
forall (eff :: Effect) exc (m :: * -> *) a.
Union '[eff, Catch exc] m a -> Exceptional eff exc m a
Exceptional @eff @exc (ElemOf eff '[eff, Catch exc]
-> eff z a -> Union '[eff, Catch exc] (ExceptionallyC eff exc m) a
forall (z :: * -> *) (m :: * -> *) (e :: Effect) (r :: [Effect]) a.
Coercible z m =>
ElemOf e r -> e z a -> Union r m a
Union ElemOf eff '[eff, Catch exc]
forall a (e :: a) (r :: [a]). ElemOf e (e : r)
Here eff z a
e)
    ) ((Catch exc (ExceptionallyC eff exc m) a
  -> ExceptionallyC eff exc m a)
 -> Algebra'
      (Catch exc : eff : Derivs m) (ExceptionallyC eff exc m) a)
-> (Catch exc (ExceptionallyC eff exc m) a
    -> ExceptionallyC eff exc m a)
-> Algebra'
     (Catch exc : eff : Derivs m) (ExceptionallyC eff exc m) a
forall a b. (a -> b) -> a -> b
$ \Catch exc (ExceptionallyC eff exc m) a
e ->
      Algebra' (Derivs m) m a
-> Algebra' (Derivs m) (ExceptionallyC eff exc m) a
forall (n :: * -> *) (m :: * -> *) (e :: Effect) a b.
(Coercible n m, RepresentationalEff e) =>
(e m a -> m b) -> e n a -> n b
coerceAlg (forall a. Carrier m => Algebra' (Derivs m) m a
forall (m :: * -> *) a. Carrier m => Algebra' (Derivs m) m a
algDerivs @m) Algebra' (Derivs m) (ExceptionallyC eff exc m) a
-> Algebra' (Derivs m) (ExceptionallyC eff exc m) a
forall a b. (a -> b) -> a -> b
$ Exceptional eff exc (ExceptionallyC eff exc m) a
-> Union (Derivs m) (ExceptionallyC eff exc m) a
forall (e :: Effect) (r :: [Effect]) (m :: * -> *) a.
Member e r =>
e m a -> Union r m a
inj (Exceptional eff exc (ExceptionallyC eff exc m) a
 -> Union (Derivs m) (ExceptionallyC eff exc m) a)
-> Exceptional eff exc (ExceptionallyC eff exc m) a
-> Union (Derivs m) (ExceptionallyC eff exc m) a
forall a b. (a -> b) -> a -> b
$ Union '[eff, Catch exc] (ExceptionallyC eff exc m) a
-> Exceptional eff exc (ExceptionallyC eff exc m) a
forall (eff :: Effect) exc (m :: * -> *) a.
Union '[eff, Catch exc] m a -> Exceptional eff exc m a
Exceptional @eff @exc (ElemOf (Catch exc) '[eff, Catch exc]
-> Catch exc (ExceptionallyC eff exc m) a
-> Union '[eff, Catch exc] (ExceptionallyC eff exc m) a
forall (z :: * -> *) (m :: * -> *) (e :: Effect) (r :: [Effect]) a.
Coercible z m =>
ElemOf e r -> e z a -> Union r m a
Union (ElemOf (Catch exc) '[Catch exc]
-> ElemOf (Catch exc) '[eff, Catch exc]
forall a (e :: a) (r :: [a]) (_e :: a).
ElemOf e r -> ElemOf e (_e : r)
There ElemOf (Catch exc) '[Catch exc]
forall a (e :: a) (r :: [a]). ElemOf e (e : r)
Here) Catch exc (ExceptionallyC eff exc m) a
e)
  {-# INLINEABLE algDerivs #-}

data ExceptionalH

instance ( Member eff (Derivs m)
         , Eff (Catch exc) m
         )
      => Handler ExceptionalH (Exceptional eff exc) m where
  -- Explicit pattern mathing and use of 'algDerivs' instead of using

  -- 'decomp' and 'send' so that we don't introduce the

  -- RepresentationalEff constraint.

  effHandler :: Exceptional eff exc (Effly z) x -> Effly z x
effHandler (Exceptional Union '[eff, Catch exc] (Effly z) x
e) = case Union '[eff, Catch exc] (Effly z) x
e of
    Union ElemOf e '[eff, Catch exc]
Here e z x
eff             -> Algebra' (Derivs (Effly z)) (Effly z) x
forall (m :: * -> *) a. Carrier m => Algebra' (Derivs m) m a
algDerivs (ElemOf e (Derivs m) -> e z x -> Union (Derivs m) (Effly z) x
forall (z :: * -> *) (m :: * -> *) (e :: Effect) (r :: [Effect]) a.
Coercible z m =>
ElemOf e r -> e z a -> Union r m a
Union ElemOf e (Derivs m)
forall k (e :: k) (r :: [k]). Member e r => ElemOf e r
membership e z x
eff)
    Union (There ElemOf e r
Here) e z x
eff     -> Algebra' (Derivs (Effly z)) (Effly z) x
forall (m :: * -> *) a. Carrier m => Algebra' (Derivs m) m a
algDerivs (ElemOf e (Derivs m) -> e z x -> Union (Derivs m) (Effly z) x
forall (z :: * -> *) (m :: * -> *) (e :: Effect) (r :: [Effect]) a.
Coercible z m =>
ElemOf e r -> e z a -> Union r m a
Union ElemOf e (Derivs m)
forall k (e :: k) (r :: [k]). Member e r => ElemOf e r
membership e z x
eff)
    Union (There (There ElemOf e r
pr)) e z x
_ -> ElemOf e '[] -> Effly z x
forall a (e :: a) b. ElemOf e '[] -> b
absurdMember ElemOf e r
ElemOf e '[]
pr
  {-# INLINEABLE effHandler #-}

type ExceptionalC eff exc = InterpretC ExceptionalH (Exceptional eff exc)

type SafeErrorToErrorC exc = ExceptionalC (Throw exc) exc

newtype SafeErrorC exc m a = SafeErrorC {
    SafeErrorC exc m a
-> IntroUnderC
     (SafeError exc)
     '[Catch exc, Throw exc]
     (SafeErrorToErrorC exc (ErrorC exc m))
     a
unSafeErrorC ::
        IntroUnderC (SafeError exc) '[Catch exc, Throw exc]
      ( SafeErrorToErrorC exc
      ( ErrorC exc
      ( m
      ))) a
  } deriving ( a -> SafeErrorC exc m b -> SafeErrorC exc m a
(a -> b) -> SafeErrorC exc m a -> SafeErrorC exc m b
(forall a b. (a -> b) -> SafeErrorC exc m a -> SafeErrorC exc m b)
-> (forall a b. a -> SafeErrorC exc m b -> SafeErrorC exc m a)
-> Functor (SafeErrorC exc m)
forall a b. a -> SafeErrorC exc m b -> SafeErrorC exc m a
forall a b. (a -> b) -> SafeErrorC exc m a -> SafeErrorC exc m b
forall exc (m :: * -> *) a b.
Functor m =>
a -> SafeErrorC exc m b -> SafeErrorC exc m a
forall exc (m :: * -> *) a b.
Functor m =>
(a -> b) -> SafeErrorC exc m a -> SafeErrorC exc m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> SafeErrorC exc m b -> SafeErrorC exc m a
$c<$ :: forall exc (m :: * -> *) a b.
Functor m =>
a -> SafeErrorC exc m b -> SafeErrorC exc m a
fmap :: (a -> b) -> SafeErrorC exc m a -> SafeErrorC exc m b
$cfmap :: forall exc (m :: * -> *) a b.
Functor m =>
(a -> b) -> SafeErrorC exc m a -> SafeErrorC exc m b
Functor, Functor (SafeErrorC exc m)
a -> SafeErrorC exc m a
Functor (SafeErrorC exc m)
-> (forall a. a -> SafeErrorC exc m a)
-> (forall a b.
    SafeErrorC exc m (a -> b)
    -> SafeErrorC exc m a -> SafeErrorC exc m b)
-> (forall a b c.
    (a -> b -> c)
    -> SafeErrorC exc m a -> SafeErrorC exc m b -> SafeErrorC exc m c)
-> (forall a b.
    SafeErrorC exc m a -> SafeErrorC exc m b -> SafeErrorC exc m b)
-> (forall a b.
    SafeErrorC exc m a -> SafeErrorC exc m b -> SafeErrorC exc m a)
-> Applicative (SafeErrorC exc m)
SafeErrorC exc m a -> SafeErrorC exc m b -> SafeErrorC exc m b
SafeErrorC exc m a -> SafeErrorC exc m b -> SafeErrorC exc m a
SafeErrorC exc m (a -> b)
-> SafeErrorC exc m a -> SafeErrorC exc m b
(a -> b -> c)
-> SafeErrorC exc m a -> SafeErrorC exc m b -> SafeErrorC exc m c
forall a. a -> SafeErrorC exc m a
forall a b.
SafeErrorC exc m a -> SafeErrorC exc m b -> SafeErrorC exc m a
forall a b.
SafeErrorC exc m a -> SafeErrorC exc m b -> SafeErrorC exc m b
forall a b.
SafeErrorC exc m (a -> b)
-> SafeErrorC exc m a -> SafeErrorC exc m b
forall a b c.
(a -> b -> c)
-> SafeErrorC exc m a -> SafeErrorC exc m b -> SafeErrorC exc m c
forall exc (m :: * -> *). Monad m => Functor (SafeErrorC exc m)
forall exc (m :: * -> *) a. Monad m => a -> SafeErrorC exc m a
forall exc (m :: * -> *) a b.
Monad m =>
SafeErrorC exc m a -> SafeErrorC exc m b -> SafeErrorC exc m a
forall exc (m :: * -> *) a b.
Monad m =>
SafeErrorC exc m a -> SafeErrorC exc m b -> SafeErrorC exc m b
forall exc (m :: * -> *) a b.
Monad m =>
SafeErrorC exc m (a -> b)
-> SafeErrorC exc m a -> SafeErrorC exc m b
forall exc (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> SafeErrorC exc m a -> SafeErrorC exc m b -> SafeErrorC exc m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: SafeErrorC exc m a -> SafeErrorC exc m b -> SafeErrorC exc m a
$c<* :: forall exc (m :: * -> *) a b.
Monad m =>
SafeErrorC exc m a -> SafeErrorC exc m b -> SafeErrorC exc m a
*> :: SafeErrorC exc m a -> SafeErrorC exc m b -> SafeErrorC exc m b
$c*> :: forall exc (m :: * -> *) a b.
Monad m =>
SafeErrorC exc m a -> SafeErrorC exc m b -> SafeErrorC exc m b
liftA2 :: (a -> b -> c)
-> SafeErrorC exc m a -> SafeErrorC exc m b -> SafeErrorC exc m c
$cliftA2 :: forall exc (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> SafeErrorC exc m a -> SafeErrorC exc m b -> SafeErrorC exc m c
<*> :: SafeErrorC exc m (a -> b)
-> SafeErrorC exc m a -> SafeErrorC exc m b
$c<*> :: forall exc (m :: * -> *) a b.
Monad m =>
SafeErrorC exc m (a -> b)
-> SafeErrorC exc m a -> SafeErrorC exc m b
pure :: a -> SafeErrorC exc m a
$cpure :: forall exc (m :: * -> *) a. Monad m => a -> SafeErrorC exc m a
$cp1Applicative :: forall exc (m :: * -> *). Monad m => Functor (SafeErrorC exc m)
Applicative, Applicative (SafeErrorC exc m)
a -> SafeErrorC exc m a
Applicative (SafeErrorC exc m)
-> (forall a b.
    SafeErrorC exc m a
    -> (a -> SafeErrorC exc m b) -> SafeErrorC exc m b)
-> (forall a b.
    SafeErrorC exc m a -> SafeErrorC exc m b -> SafeErrorC exc m b)
-> (forall a. a -> SafeErrorC exc m a)
-> Monad (SafeErrorC exc m)
SafeErrorC exc m a
-> (a -> SafeErrorC exc m b) -> SafeErrorC exc m b
SafeErrorC exc m a -> SafeErrorC exc m b -> SafeErrorC exc m b
forall a. a -> SafeErrorC exc m a
forall a b.
SafeErrorC exc m a -> SafeErrorC exc m b -> SafeErrorC exc m b
forall a b.
SafeErrorC exc m a
-> (a -> SafeErrorC exc m b) -> SafeErrorC exc m b
forall exc (m :: * -> *). Monad m => Applicative (SafeErrorC exc m)
forall exc (m :: * -> *) a. Monad m => a -> SafeErrorC exc m a
forall exc (m :: * -> *) a b.
Monad m =>
SafeErrorC exc m a -> SafeErrorC exc m b -> SafeErrorC exc m b
forall exc (m :: * -> *) a b.
Monad m =>
SafeErrorC exc m a
-> (a -> SafeErrorC exc m b) -> SafeErrorC exc m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> SafeErrorC exc m a
$creturn :: forall exc (m :: * -> *) a. Monad m => a -> SafeErrorC exc m a
>> :: SafeErrorC exc m a -> SafeErrorC exc m b -> SafeErrorC exc m b
$c>> :: forall exc (m :: * -> *) a b.
Monad m =>
SafeErrorC exc m a -> SafeErrorC exc m b -> SafeErrorC exc m b
>>= :: SafeErrorC exc m a
-> (a -> SafeErrorC exc m b) -> SafeErrorC exc m b
$c>>= :: forall exc (m :: * -> *) a b.
Monad m =>
SafeErrorC exc m a
-> (a -> SafeErrorC exc m b) -> SafeErrorC exc m b
$cp1Monad :: forall exc (m :: * -> *). Monad m => Applicative (SafeErrorC exc m)
Monad
             , Applicative (SafeErrorC exc m)
SafeErrorC exc m a
Applicative (SafeErrorC exc m)
-> (forall a. SafeErrorC exc m a)
-> (forall a.
    SafeErrorC exc m a -> SafeErrorC exc m a -> SafeErrorC exc m a)
-> (forall a. SafeErrorC exc m a -> SafeErrorC exc m [a])
-> (forall a. SafeErrorC exc m a -> SafeErrorC exc m [a])
-> Alternative (SafeErrorC exc m)
SafeErrorC exc m a -> SafeErrorC exc m a -> SafeErrorC exc m a
SafeErrorC exc m a -> SafeErrorC exc m [a]
SafeErrorC exc m a -> SafeErrorC exc m [a]
forall a. SafeErrorC exc m a
forall a. SafeErrorC exc m a -> SafeErrorC exc m [a]
forall a.
SafeErrorC exc m a -> SafeErrorC exc m a -> SafeErrorC exc m a
forall exc (m :: * -> *).
(Monad m, Monoid exc) =>
Applicative (SafeErrorC exc m)
forall exc (m :: * -> *) a.
(Monad m, Monoid exc) =>
SafeErrorC exc m a
forall exc (m :: * -> *) a.
(Monad m, Monoid exc) =>
SafeErrorC exc m a -> SafeErrorC exc m [a]
forall exc (m :: * -> *) a.
(Monad m, Monoid exc) =>
SafeErrorC exc m a -> SafeErrorC exc m a -> SafeErrorC exc m a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
many :: SafeErrorC exc m a -> SafeErrorC exc m [a]
$cmany :: forall exc (m :: * -> *) a.
(Monad m, Monoid exc) =>
SafeErrorC exc m a -> SafeErrorC exc m [a]
some :: SafeErrorC exc m a -> SafeErrorC exc m [a]
$csome :: forall exc (m :: * -> *) a.
(Monad m, Monoid exc) =>
SafeErrorC exc m a -> SafeErrorC exc m [a]
<|> :: SafeErrorC exc m a -> SafeErrorC exc m a -> SafeErrorC exc m a
$c<|> :: forall exc (m :: * -> *) a.
(Monad m, Monoid exc) =>
SafeErrorC exc m a -> SafeErrorC exc m a -> SafeErrorC exc m a
empty :: SafeErrorC exc m a
$cempty :: forall exc (m :: * -> *) a.
(Monad m, Monoid exc) =>
SafeErrorC exc m a
$cp1Alternative :: forall exc (m :: * -> *).
(Monad m, Monoid exc) =>
Applicative (SafeErrorC exc m)
Alternative, Monad (SafeErrorC exc m)
Alternative (SafeErrorC exc m)
SafeErrorC exc m a
Alternative (SafeErrorC exc m)
-> Monad (SafeErrorC exc m)
-> (forall a. SafeErrorC exc m a)
-> (forall a.
    SafeErrorC exc m a -> SafeErrorC exc m a -> SafeErrorC exc m a)
-> MonadPlus (SafeErrorC exc m)
SafeErrorC exc m a -> SafeErrorC exc m a -> SafeErrorC exc m a
forall a. SafeErrorC exc m a
forall a.
SafeErrorC exc m a -> SafeErrorC exc m a -> SafeErrorC exc m a
forall exc (m :: * -> *).
(Monad m, Monoid exc) =>
Monad (SafeErrorC exc m)
forall exc (m :: * -> *).
(Monad m, Monoid exc) =>
Alternative (SafeErrorC exc m)
forall exc (m :: * -> *) a.
(Monad m, Monoid exc) =>
SafeErrorC exc m a
forall exc (m :: * -> *) a.
(Monad m, Monoid exc) =>
SafeErrorC exc m a -> SafeErrorC exc m a -> SafeErrorC exc m a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
mplus :: SafeErrorC exc m a -> SafeErrorC exc m a -> SafeErrorC exc m a
$cmplus :: forall exc (m :: * -> *) a.
(Monad m, Monoid exc) =>
SafeErrorC exc m a -> SafeErrorC exc m a -> SafeErrorC exc m a
mzero :: SafeErrorC exc m a
$cmzero :: forall exc (m :: * -> *) a.
(Monad m, Monoid exc) =>
SafeErrorC exc m a
$cp2MonadPlus :: forall exc (m :: * -> *).
(Monad m, Monoid exc) =>
Monad (SafeErrorC exc m)
$cp1MonadPlus :: forall exc (m :: * -> *).
(Monad m, Monoid exc) =>
Alternative (SafeErrorC exc m)
MonadPlus
             , Monad (SafeErrorC exc m)
Monad (SafeErrorC exc m)
-> (forall a. (a -> SafeErrorC exc m a) -> SafeErrorC exc m a)
-> MonadFix (SafeErrorC exc m)
(a -> SafeErrorC exc m a) -> SafeErrorC exc m a
forall a. (a -> SafeErrorC exc m a) -> SafeErrorC exc m a
forall exc (m :: * -> *). MonadFix m => Monad (SafeErrorC exc m)
forall exc (m :: * -> *) a.
MonadFix m =>
(a -> SafeErrorC exc m a) -> SafeErrorC exc m a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
mfix :: (a -> SafeErrorC exc m a) -> SafeErrorC exc m a
$cmfix :: forall exc (m :: * -> *) a.
MonadFix m =>
(a -> SafeErrorC exc m a) -> SafeErrorC exc m a
$cp1MonadFix :: forall exc (m :: * -> *). MonadFix m => Monad (SafeErrorC exc m)
MonadFix, Monad (SafeErrorC exc m)
Monad (SafeErrorC exc m)
-> (forall a. String -> SafeErrorC exc m a)
-> MonadFail (SafeErrorC exc m)
String -> SafeErrorC exc m a
forall a. String -> SafeErrorC exc m a
forall exc (m :: * -> *). MonadFail m => Monad (SafeErrorC exc m)
forall exc (m :: * -> *) a.
MonadFail m =>
String -> SafeErrorC exc m a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
fail :: String -> SafeErrorC exc m a
$cfail :: forall exc (m :: * -> *) a.
MonadFail m =>
String -> SafeErrorC exc m a
$cp1MonadFail :: forall exc (m :: * -> *). MonadFail m => Monad (SafeErrorC exc m)
MonadFail, Monad (SafeErrorC exc m)
Monad (SafeErrorC exc m)
-> (forall a. IO a -> SafeErrorC exc m a)
-> MonadIO (SafeErrorC exc m)
IO a -> SafeErrorC exc m a
forall a. IO a -> SafeErrorC exc m a
forall exc (m :: * -> *). MonadIO m => Monad (SafeErrorC exc m)
forall exc (m :: * -> *) a. MonadIO m => IO a -> SafeErrorC exc m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> SafeErrorC exc m a
$cliftIO :: forall exc (m :: * -> *) a. MonadIO m => IO a -> SafeErrorC exc m a
$cp1MonadIO :: forall exc (m :: * -> *). MonadIO m => Monad (SafeErrorC exc m)
MonadIO
             , Monad (SafeErrorC exc m)
e -> SafeErrorC exc m a
Monad (SafeErrorC exc m)
-> (forall e a. Exception e => e -> SafeErrorC exc m a)
-> MonadThrow (SafeErrorC exc m)
forall e a. Exception e => e -> SafeErrorC exc m a
forall exc (m :: * -> *). MonadThrow m => Monad (SafeErrorC exc m)
forall exc (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> SafeErrorC exc m a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: e -> SafeErrorC exc m a
$cthrowM :: forall exc (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> SafeErrorC exc m a
$cp1MonadThrow :: forall exc (m :: * -> *). MonadThrow m => Monad (SafeErrorC exc m)
MonadThrow, MonadThrow (SafeErrorC exc m)
MonadThrow (SafeErrorC exc m)
-> (forall e a.
    Exception e =>
    SafeErrorC exc m a
    -> (e -> SafeErrorC exc m a) -> SafeErrorC exc m a)
-> MonadCatch (SafeErrorC exc m)
SafeErrorC exc m a
-> (e -> SafeErrorC exc m a) -> SafeErrorC exc m a
forall e a.
Exception e =>
SafeErrorC exc m a
-> (e -> SafeErrorC exc m a) -> SafeErrorC exc m a
forall exc (m :: * -> *).
MonadCatch m =>
MonadThrow (SafeErrorC exc m)
forall exc (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
SafeErrorC exc m a
-> (e -> SafeErrorC exc m a) -> SafeErrorC exc m a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
catch :: SafeErrorC exc m a
-> (e -> SafeErrorC exc m a) -> SafeErrorC exc m a
$ccatch :: forall exc (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
SafeErrorC exc m a
-> (e -> SafeErrorC exc m a) -> SafeErrorC exc m a
$cp1MonadCatch :: forall exc (m :: * -> *).
MonadCatch m =>
MonadThrow (SafeErrorC exc m)
MonadCatch, MonadCatch (SafeErrorC exc m)
MonadCatch (SafeErrorC exc m)
-> (forall b.
    ((forall a. SafeErrorC exc m a -> SafeErrorC exc m a)
     -> SafeErrorC exc m b)
    -> SafeErrorC exc m b)
-> (forall b.
    ((forall a. SafeErrorC exc m a -> SafeErrorC exc m a)
     -> SafeErrorC exc m b)
    -> SafeErrorC exc m b)
-> (forall a b c.
    SafeErrorC exc m a
    -> (a -> ExitCase b -> SafeErrorC exc m c)
    -> (a -> SafeErrorC exc m b)
    -> SafeErrorC exc m (b, c))
-> MonadMask (SafeErrorC exc m)
SafeErrorC exc m a
-> (a -> ExitCase b -> SafeErrorC exc m c)
-> (a -> SafeErrorC exc m b)
-> SafeErrorC exc m (b, c)
((forall a. SafeErrorC exc m a -> SafeErrorC exc m a)
 -> SafeErrorC exc m b)
-> SafeErrorC exc m b
((forall a. SafeErrorC exc m a -> SafeErrorC exc m a)
 -> SafeErrorC exc m b)
-> SafeErrorC exc m b
forall b.
((forall a. SafeErrorC exc m a -> SafeErrorC exc m a)
 -> SafeErrorC exc m b)
-> SafeErrorC exc m b
forall a b c.
SafeErrorC exc m a
-> (a -> ExitCase b -> SafeErrorC exc m c)
-> (a -> SafeErrorC exc m b)
-> SafeErrorC exc m (b, c)
forall exc (m :: * -> *).
MonadMask m =>
MonadCatch (SafeErrorC exc m)
forall exc (m :: * -> *) b.
MonadMask m =>
((forall a. SafeErrorC exc m a -> SafeErrorC exc m a)
 -> SafeErrorC exc m b)
-> SafeErrorC exc m b
forall exc (m :: * -> *) a b c.
MonadMask m =>
SafeErrorC exc m a
-> (a -> ExitCase b -> SafeErrorC exc m c)
-> (a -> SafeErrorC exc m b)
-> SafeErrorC exc m (b, c)
forall (m :: * -> *).
MonadCatch m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
generalBracket :: SafeErrorC exc m a
-> (a -> ExitCase b -> SafeErrorC exc m c)
-> (a -> SafeErrorC exc m b)
-> SafeErrorC exc m (b, c)
$cgeneralBracket :: forall exc (m :: * -> *) a b c.
MonadMask m =>
SafeErrorC exc m a
-> (a -> ExitCase b -> SafeErrorC exc m c)
-> (a -> SafeErrorC exc m b)
-> SafeErrorC exc m (b, c)
uninterruptibleMask :: ((forall a. SafeErrorC exc m a -> SafeErrorC exc m a)
 -> SafeErrorC exc m b)
-> SafeErrorC exc m b
$cuninterruptibleMask :: forall exc (m :: * -> *) b.
MonadMask m =>
((forall a. SafeErrorC exc m a -> SafeErrorC exc m a)
 -> SafeErrorC exc m b)
-> SafeErrorC exc m b
mask :: ((forall a. SafeErrorC exc m a -> SafeErrorC exc m a)
 -> SafeErrorC exc m b)
-> SafeErrorC exc m b
$cmask :: forall exc (m :: * -> *) b.
MonadMask m =>
((forall a. SafeErrorC exc m a -> SafeErrorC exc m a)
 -> SafeErrorC exc m b)
-> SafeErrorC exc m b
$cp1MonadMask :: forall exc (m :: * -> *).
MonadMask m =>
MonadCatch (SafeErrorC exc m)
MonadMask
             , MonadBase b, MonadBaseControl b
             )
    deriving (m a -> SafeErrorC exc m a
(forall (m :: * -> *) a. Monad m => m a -> SafeErrorC exc m a)
-> MonadTrans (SafeErrorC exc)
forall exc (m :: * -> *) a. Monad m => m a -> SafeErrorC exc m a
forall (m :: * -> *) a. Monad m => m a -> SafeErrorC exc m a
forall (t :: Effect).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> SafeErrorC exc m a
$clift :: forall exc (m :: * -> *) a. Monad m => m a -> SafeErrorC exc m a
MonadTrans, MonadTrans (SafeErrorC exc)
m (StT (SafeErrorC exc) a) -> SafeErrorC exc m a
MonadTrans (SafeErrorC exc)
-> (forall (m :: * -> *) a.
    Monad m =>
    (Run (SafeErrorC exc) -> m a) -> SafeErrorC exc m a)
-> (forall (m :: * -> *) a.
    Monad m =>
    m (StT (SafeErrorC exc) a) -> SafeErrorC exc m a)
-> MonadTransControl (SafeErrorC exc)
(Run (SafeErrorC exc) -> m a) -> SafeErrorC exc m a
forall exc. MonadTrans (SafeErrorC exc)
forall exc (m :: * -> *) a.
Monad m =>
m (StT (SafeErrorC exc) a) -> SafeErrorC exc m a
forall exc (m :: * -> *) a.
Monad m =>
(Run (SafeErrorC exc) -> m a) -> SafeErrorC exc m a
forall (m :: * -> *) a.
Monad m =>
m (StT (SafeErrorC exc) a) -> SafeErrorC exc m a
forall (m :: * -> *) a.
Monad m =>
(Run (SafeErrorC exc) -> m a) -> SafeErrorC exc m a
forall (t :: Effect).
MonadTrans t
-> (forall (m :: * -> *) a. Monad m => (Run t -> m a) -> t m a)
-> (forall (m :: * -> *) a. Monad m => m (StT t a) -> t m a)
-> MonadTransControl t
restoreT :: m (StT (SafeErrorC exc) a) -> SafeErrorC exc m a
$crestoreT :: forall exc (m :: * -> *) a.
Monad m =>
m (StT (SafeErrorC exc) a) -> SafeErrorC exc m a
liftWith :: (Run (SafeErrorC exc) -> m a) -> SafeErrorC exc m a
$cliftWith :: forall exc (m :: * -> *) a.
Monad m =>
(Run (SafeErrorC exc) -> m a) -> SafeErrorC exc m a
$cp1MonadTransControl :: forall exc. MonadTrans (SafeErrorC exc)
MonadTransControl)
    via CompositionBaseT
     '[ IntroUnderC (SafeError exc) '[Catch exc, Throw exc]
      , SafeErrorToErrorC exc
      , ErrorC exc
      ]

deriving instance (Carrier m, Threads (ExceptT exc) (Prims m))
               => Carrier (SafeErrorC exc m)

newtype SafeErrorToIOC' s s' exc m a = SafeErrorToIOC' {
    SafeErrorToIOC' s s' exc m a
-> IntroUnderC
     (SafeError exc)
     '[Catch exc, Throw exc]
     (SafeErrorToErrorC exc (ErrorToIOC' s s' exc m))
     a
unSafeErrorToIOC' ::
        IntroUnderC (SafeError exc) '[Catch exc, Throw exc]
      ( SafeErrorToErrorC exc
      ( ErrorToIOC' s s' exc
      ( m
      ))) a
  } deriving ( a -> SafeErrorToIOC' s s' exc m b -> SafeErrorToIOC' s s' exc m a
(a -> b)
-> SafeErrorToIOC' s s' exc m a -> SafeErrorToIOC' s s' exc m b
(forall a b.
 (a -> b)
 -> SafeErrorToIOC' s s' exc m a -> SafeErrorToIOC' s s' exc m b)
-> (forall a b.
    a -> SafeErrorToIOC' s s' exc m b -> SafeErrorToIOC' s s' exc m a)
-> Functor (SafeErrorToIOC' s s' exc m)
forall a b.
a -> SafeErrorToIOC' s s' exc m b -> SafeErrorToIOC' s s' exc m a
forall a b.
(a -> b)
-> SafeErrorToIOC' s s' exc m a -> SafeErrorToIOC' s s' exc m b
forall s s' exc (m :: * -> *) a b.
Functor m =>
a -> SafeErrorToIOC' s s' exc m b -> SafeErrorToIOC' s s' exc m a
forall s s' exc (m :: * -> *) a b.
Functor m =>
(a -> b)
-> SafeErrorToIOC' s s' exc m a -> SafeErrorToIOC' s s' exc m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> SafeErrorToIOC' s s' exc m b -> SafeErrorToIOC' s s' exc m a
$c<$ :: forall s s' exc (m :: * -> *) a b.
Functor m =>
a -> SafeErrorToIOC' s s' exc m b -> SafeErrorToIOC' s s' exc m a
fmap :: (a -> b)
-> SafeErrorToIOC' s s' exc m a -> SafeErrorToIOC' s s' exc m b
$cfmap :: forall s s' exc (m :: * -> *) a b.
Functor m =>
(a -> b)
-> SafeErrorToIOC' s s' exc m a -> SafeErrorToIOC' s s' exc m b
Functor, Functor (SafeErrorToIOC' s s' exc m)
a -> SafeErrorToIOC' s s' exc m a
Functor (SafeErrorToIOC' s s' exc m)
-> (forall a. a -> SafeErrorToIOC' s s' exc m a)
-> (forall a b.
    SafeErrorToIOC' s s' exc m (a -> b)
    -> SafeErrorToIOC' s s' exc m a -> SafeErrorToIOC' s s' exc m b)
-> (forall a b c.
    (a -> b -> c)
    -> SafeErrorToIOC' s s' exc m a
    -> SafeErrorToIOC' s s' exc m b
    -> SafeErrorToIOC' s s' exc m c)
-> (forall a b.
    SafeErrorToIOC' s s' exc m a
    -> SafeErrorToIOC' s s' exc m b -> SafeErrorToIOC' s s' exc m b)
-> (forall a b.
    SafeErrorToIOC' s s' exc m a
    -> SafeErrorToIOC' s s' exc m b -> SafeErrorToIOC' s s' exc m a)
-> Applicative (SafeErrorToIOC' s s' exc m)
SafeErrorToIOC' s s' exc m a
-> SafeErrorToIOC' s s' exc m b -> SafeErrorToIOC' s s' exc m b
SafeErrorToIOC' s s' exc m a
-> SafeErrorToIOC' s s' exc m b -> SafeErrorToIOC' s s' exc m a
SafeErrorToIOC' s s' exc m (a -> b)
-> SafeErrorToIOC' s s' exc m a -> SafeErrorToIOC' s s' exc m b
(a -> b -> c)
-> SafeErrorToIOC' s s' exc m a
-> SafeErrorToIOC' s s' exc m b
-> SafeErrorToIOC' s s' exc m c
forall a. a -> SafeErrorToIOC' s s' exc m a
forall a b.
SafeErrorToIOC' s s' exc m a
-> SafeErrorToIOC' s s' exc m b -> SafeErrorToIOC' s s' exc m a
forall a b.
SafeErrorToIOC' s s' exc m a
-> SafeErrorToIOC' s s' exc m b -> SafeErrorToIOC' s s' exc m b
forall a b.
SafeErrorToIOC' s s' exc m (a -> b)
-> SafeErrorToIOC' s s' exc m a -> SafeErrorToIOC' s s' exc m b
forall a b c.
(a -> b -> c)
-> SafeErrorToIOC' s s' exc m a
-> SafeErrorToIOC' s s' exc m b
-> SafeErrorToIOC' s s' exc m c
forall s s' exc (m :: * -> *).
Applicative m =>
Functor (SafeErrorToIOC' s s' exc m)
forall s s' exc (m :: * -> *) a.
Applicative m =>
a -> SafeErrorToIOC' s s' exc m a
forall s s' exc (m :: * -> *) a b.
Applicative m =>
SafeErrorToIOC' s s' exc m a
-> SafeErrorToIOC' s s' exc m b -> SafeErrorToIOC' s s' exc m a
forall s s' exc (m :: * -> *) a b.
Applicative m =>
SafeErrorToIOC' s s' exc m a
-> SafeErrorToIOC' s s' exc m b -> SafeErrorToIOC' s s' exc m b
forall s s' exc (m :: * -> *) a b.
Applicative m =>
SafeErrorToIOC' s s' exc m (a -> b)
-> SafeErrorToIOC' s s' exc m a -> SafeErrorToIOC' s s' exc m b
forall s s' exc (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> SafeErrorToIOC' s s' exc m a
-> SafeErrorToIOC' s s' exc m b
-> SafeErrorToIOC' s s' exc m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: SafeErrorToIOC' s s' exc m a
-> SafeErrorToIOC' s s' exc m b -> SafeErrorToIOC' s s' exc m a
$c<* :: forall s s' exc (m :: * -> *) a b.
Applicative m =>
SafeErrorToIOC' s s' exc m a
-> SafeErrorToIOC' s s' exc m b -> SafeErrorToIOC' s s' exc m a
*> :: SafeErrorToIOC' s s' exc m a
-> SafeErrorToIOC' s s' exc m b -> SafeErrorToIOC' s s' exc m b
$c*> :: forall s s' exc (m :: * -> *) a b.
Applicative m =>
SafeErrorToIOC' s s' exc m a
-> SafeErrorToIOC' s s' exc m b -> SafeErrorToIOC' s s' exc m b
liftA2 :: (a -> b -> c)
-> SafeErrorToIOC' s s' exc m a
-> SafeErrorToIOC' s s' exc m b
-> SafeErrorToIOC' s s' exc m c
$cliftA2 :: forall s s' exc (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> SafeErrorToIOC' s s' exc m a
-> SafeErrorToIOC' s s' exc m b
-> SafeErrorToIOC' s s' exc m c
<*> :: SafeErrorToIOC' s s' exc m (a -> b)
-> SafeErrorToIOC' s s' exc m a -> SafeErrorToIOC' s s' exc m b
$c<*> :: forall s s' exc (m :: * -> *) a b.
Applicative m =>
SafeErrorToIOC' s s' exc m (a -> b)
-> SafeErrorToIOC' s s' exc m a -> SafeErrorToIOC' s s' exc m b
pure :: a -> SafeErrorToIOC' s s' exc m a
$cpure :: forall s s' exc (m :: * -> *) a.
Applicative m =>
a -> SafeErrorToIOC' s s' exc m a
$cp1Applicative :: forall s s' exc (m :: * -> *).
Applicative m =>
Functor (SafeErrorToIOC' s s' exc m)
Applicative, Applicative (SafeErrorToIOC' s s' exc m)
a -> SafeErrorToIOC' s s' exc m a
Applicative (SafeErrorToIOC' s s' exc m)
-> (forall a b.
    SafeErrorToIOC' s s' exc m a
    -> (a -> SafeErrorToIOC' s s' exc m b)
    -> SafeErrorToIOC' s s' exc m b)
-> (forall a b.
    SafeErrorToIOC' s s' exc m a
    -> SafeErrorToIOC' s s' exc m b -> SafeErrorToIOC' s s' exc m b)
-> (forall a. a -> SafeErrorToIOC' s s' exc m a)
-> Monad (SafeErrorToIOC' s s' exc m)
SafeErrorToIOC' s s' exc m a
-> (a -> SafeErrorToIOC' s s' exc m b)
-> SafeErrorToIOC' s s' exc m b
SafeErrorToIOC' s s' exc m a
-> SafeErrorToIOC' s s' exc m b -> SafeErrorToIOC' s s' exc m b
forall a. a -> SafeErrorToIOC' s s' exc m a
forall a b.
SafeErrorToIOC' s s' exc m a
-> SafeErrorToIOC' s s' exc m b -> SafeErrorToIOC' s s' exc m b
forall a b.
SafeErrorToIOC' s s' exc m a
-> (a -> SafeErrorToIOC' s s' exc m b)
-> SafeErrorToIOC' s s' exc m b
forall s s' exc (m :: * -> *).
Monad m =>
Applicative (SafeErrorToIOC' s s' exc m)
forall s s' exc (m :: * -> *) a.
Monad m =>
a -> SafeErrorToIOC' s s' exc m a
forall s s' exc (m :: * -> *) a b.
Monad m =>
SafeErrorToIOC' s s' exc m a
-> SafeErrorToIOC' s s' exc m b -> SafeErrorToIOC' s s' exc m b
forall s s' exc (m :: * -> *) a b.
Monad m =>
SafeErrorToIOC' s s' exc m a
-> (a -> SafeErrorToIOC' s s' exc m b)
-> SafeErrorToIOC' s s' exc m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> SafeErrorToIOC' s s' exc m a
$creturn :: forall s s' exc (m :: * -> *) a.
Monad m =>
a -> SafeErrorToIOC' s s' exc m a
>> :: SafeErrorToIOC' s s' exc m a
-> SafeErrorToIOC' s s' exc m b -> SafeErrorToIOC' s s' exc m b
$c>> :: forall s s' exc (m :: * -> *) a b.
Monad m =>
SafeErrorToIOC' s s' exc m a
-> SafeErrorToIOC' s s' exc m b -> SafeErrorToIOC' s s' exc m b
>>= :: SafeErrorToIOC' s s' exc m a
-> (a -> SafeErrorToIOC' s s' exc m b)
-> SafeErrorToIOC' s s' exc m b
$c>>= :: forall s s' exc (m :: * -> *) a b.
Monad m =>
SafeErrorToIOC' s s' exc m a
-> (a -> SafeErrorToIOC' s s' exc m b)
-> SafeErrorToIOC' s s' exc m b
$cp1Monad :: forall s s' exc (m :: * -> *).
Monad m =>
Applicative (SafeErrorToIOC' s s' exc m)
Monad
             , Applicative (SafeErrorToIOC' s s' exc m)
SafeErrorToIOC' s s' exc m a
Applicative (SafeErrorToIOC' s s' exc m)
-> (forall a. SafeErrorToIOC' s s' exc m a)
-> (forall a.
    SafeErrorToIOC' s s' exc m a
    -> SafeErrorToIOC' s s' exc m a -> SafeErrorToIOC' s s' exc m a)
-> (forall a.
    SafeErrorToIOC' s s' exc m a -> SafeErrorToIOC' s s' exc m [a])
-> (forall a.
    SafeErrorToIOC' s s' exc m a -> SafeErrorToIOC' s s' exc m [a])
-> Alternative (SafeErrorToIOC' s s' exc m)
SafeErrorToIOC' s s' exc m a
-> SafeErrorToIOC' s s' exc m a -> SafeErrorToIOC' s s' exc m a
SafeErrorToIOC' s s' exc m a -> SafeErrorToIOC' s s' exc m [a]
SafeErrorToIOC' s s' exc m a -> SafeErrorToIOC' s s' exc m [a]
forall a. SafeErrorToIOC' s s' exc m a
forall a.
SafeErrorToIOC' s s' exc m a -> SafeErrorToIOC' s s' exc m [a]
forall a.
SafeErrorToIOC' s s' exc m a
-> SafeErrorToIOC' s s' exc m a -> SafeErrorToIOC' s s' exc m a
forall s s' exc (m :: * -> *).
Alternative m =>
Applicative (SafeErrorToIOC' s s' exc m)
forall s s' exc (m :: * -> *) a.
Alternative m =>
SafeErrorToIOC' s s' exc m a
forall s s' exc (m :: * -> *) a.
Alternative m =>
SafeErrorToIOC' s s' exc m a -> SafeErrorToIOC' s s' exc m [a]
forall s s' exc (m :: * -> *) a.
Alternative m =>
SafeErrorToIOC' s s' exc m a
-> SafeErrorToIOC' s s' exc m a -> SafeErrorToIOC' s s' exc m a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
many :: SafeErrorToIOC' s s' exc m a -> SafeErrorToIOC' s s' exc m [a]
$cmany :: forall s s' exc (m :: * -> *) a.
Alternative m =>
SafeErrorToIOC' s s' exc m a -> SafeErrorToIOC' s s' exc m [a]
some :: SafeErrorToIOC' s s' exc m a -> SafeErrorToIOC' s s' exc m [a]
$csome :: forall s s' exc (m :: * -> *) a.
Alternative m =>
SafeErrorToIOC' s s' exc m a -> SafeErrorToIOC' s s' exc m [a]
<|> :: SafeErrorToIOC' s s' exc m a
-> SafeErrorToIOC' s s' exc m a -> SafeErrorToIOC' s s' exc m a
$c<|> :: forall s s' exc (m :: * -> *) a.
Alternative m =>
SafeErrorToIOC' s s' exc m a
-> SafeErrorToIOC' s s' exc m a -> SafeErrorToIOC' s s' exc m a
empty :: SafeErrorToIOC' s s' exc m a
$cempty :: forall s s' exc (m :: * -> *) a.
Alternative m =>
SafeErrorToIOC' s s' exc m a
$cp1Alternative :: forall s s' exc (m :: * -> *).
Alternative m =>
Applicative (SafeErrorToIOC' s s' exc m)
Alternative, Monad (SafeErrorToIOC' s s' exc m)
Alternative (SafeErrorToIOC' s s' exc m)
SafeErrorToIOC' s s' exc m a
Alternative (SafeErrorToIOC' s s' exc m)
-> Monad (SafeErrorToIOC' s s' exc m)
-> (forall a. SafeErrorToIOC' s s' exc m a)
-> (forall a.
    SafeErrorToIOC' s s' exc m a
    -> SafeErrorToIOC' s s' exc m a -> SafeErrorToIOC' s s' exc m a)
-> MonadPlus (SafeErrorToIOC' s s' exc m)
SafeErrorToIOC' s s' exc m a
-> SafeErrorToIOC' s s' exc m a -> SafeErrorToIOC' s s' exc m a
forall a. SafeErrorToIOC' s s' exc m a
forall a.
SafeErrorToIOC' s s' exc m a
-> SafeErrorToIOC' s s' exc m a -> SafeErrorToIOC' s s' exc m a
forall s s' exc (m :: * -> *).
MonadPlus m =>
Monad (SafeErrorToIOC' s s' exc m)
forall s s' exc (m :: * -> *).
MonadPlus m =>
Alternative (SafeErrorToIOC' s s' exc m)
forall s s' exc (m :: * -> *) a.
MonadPlus m =>
SafeErrorToIOC' s s' exc m a
forall s s' exc (m :: * -> *) a.
MonadPlus m =>
SafeErrorToIOC' s s' exc m a
-> SafeErrorToIOC' s s' exc m a -> SafeErrorToIOC' s s' exc m a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
mplus :: SafeErrorToIOC' s s' exc m a
-> SafeErrorToIOC' s s' exc m a -> SafeErrorToIOC' s s' exc m a
$cmplus :: forall s s' exc (m :: * -> *) a.
MonadPlus m =>
SafeErrorToIOC' s s' exc m a
-> SafeErrorToIOC' s s' exc m a -> SafeErrorToIOC' s s' exc m a
mzero :: SafeErrorToIOC' s s' exc m a
$cmzero :: forall s s' exc (m :: * -> *) a.
MonadPlus m =>
SafeErrorToIOC' s s' exc m a
$cp2MonadPlus :: forall s s' exc (m :: * -> *).
MonadPlus m =>
Monad (SafeErrorToIOC' s s' exc m)
$cp1MonadPlus :: forall s s' exc (m :: * -> *).
MonadPlus m =>
Alternative (SafeErrorToIOC' s s' exc m)
MonadPlus
             , Monad (SafeErrorToIOC' s s' exc m)
Monad (SafeErrorToIOC' s s' exc m)
-> (forall a.
    (a -> SafeErrorToIOC' s s' exc m a)
    -> SafeErrorToIOC' s s' exc m a)
-> MonadFix (SafeErrorToIOC' s s' exc m)
(a -> SafeErrorToIOC' s s' exc m a) -> SafeErrorToIOC' s s' exc m a
forall a.
(a -> SafeErrorToIOC' s s' exc m a) -> SafeErrorToIOC' s s' exc m a
forall s s' exc (m :: * -> *).
MonadFix m =>
Monad (SafeErrorToIOC' s s' exc m)
forall s s' exc (m :: * -> *) a.
MonadFix m =>
(a -> SafeErrorToIOC' s s' exc m a) -> SafeErrorToIOC' s s' exc m a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
mfix :: (a -> SafeErrorToIOC' s s' exc m a) -> SafeErrorToIOC' s s' exc m a
$cmfix :: forall s s' exc (m :: * -> *) a.
MonadFix m =>
(a -> SafeErrorToIOC' s s' exc m a) -> SafeErrorToIOC' s s' exc m a
$cp1MonadFix :: forall s s' exc (m :: * -> *).
MonadFix m =>
Monad (SafeErrorToIOC' s s' exc m)
MonadFix, Monad (SafeErrorToIOC' s s' exc m)
Monad (SafeErrorToIOC' s s' exc m)
-> (forall a. String -> SafeErrorToIOC' s s' exc m a)
-> MonadFail (SafeErrorToIOC' s s' exc m)
String -> SafeErrorToIOC' s s' exc m a
forall a. String -> SafeErrorToIOC' s s' exc m a
forall s s' exc (m :: * -> *).
MonadFail m =>
Monad (SafeErrorToIOC' s s' exc m)
forall s s' exc (m :: * -> *) a.
MonadFail m =>
String -> SafeErrorToIOC' s s' exc m a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
fail :: String -> SafeErrorToIOC' s s' exc m a
$cfail :: forall s s' exc (m :: * -> *) a.
MonadFail m =>
String -> SafeErrorToIOC' s s' exc m a
$cp1MonadFail :: forall s s' exc (m :: * -> *).
MonadFail m =>
Monad (SafeErrorToIOC' s s' exc m)
MonadFail, Monad (SafeErrorToIOC' s s' exc m)
Monad (SafeErrorToIOC' s s' exc m)
-> (forall a. IO a -> SafeErrorToIOC' s s' exc m a)
-> MonadIO (SafeErrorToIOC' s s' exc m)
IO a -> SafeErrorToIOC' s s' exc m a
forall a. IO a -> SafeErrorToIOC' s s' exc m a
forall s s' exc (m :: * -> *).
MonadIO m =>
Monad (SafeErrorToIOC' s s' exc m)
forall s s' exc (m :: * -> *) a.
MonadIO m =>
IO a -> SafeErrorToIOC' s s' exc m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> SafeErrorToIOC' s s' exc m a
$cliftIO :: forall s s' exc (m :: * -> *) a.
MonadIO m =>
IO a -> SafeErrorToIOC' s s' exc m a
$cp1MonadIO :: forall s s' exc (m :: * -> *).
MonadIO m =>
Monad (SafeErrorToIOC' s s' exc m)
MonadIO
             , Monad (SafeErrorToIOC' s s' exc m)
e -> SafeErrorToIOC' s s' exc m a
Monad (SafeErrorToIOC' s s' exc m)
-> (forall e a. Exception e => e -> SafeErrorToIOC' s s' exc m a)
-> MonadThrow (SafeErrorToIOC' s s' exc m)
forall e a. Exception e => e -> SafeErrorToIOC' s s' exc m a
forall s s' exc (m :: * -> *).
MonadThrow m =>
Monad (SafeErrorToIOC' s s' exc m)
forall s s' exc (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> SafeErrorToIOC' s s' exc m a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: e -> SafeErrorToIOC' s s' exc m a
$cthrowM :: forall s s' exc (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> SafeErrorToIOC' s s' exc m a
$cp1MonadThrow :: forall s s' exc (m :: * -> *).
MonadThrow m =>
Monad (SafeErrorToIOC' s s' exc m)
MonadThrow, MonadThrow (SafeErrorToIOC' s s' exc m)
MonadThrow (SafeErrorToIOC' s s' exc m)
-> (forall e a.
    Exception e =>
    SafeErrorToIOC' s s' exc m a
    -> (e -> SafeErrorToIOC' s s' exc m a)
    -> SafeErrorToIOC' s s' exc m a)
-> MonadCatch (SafeErrorToIOC' s s' exc m)
SafeErrorToIOC' s s' exc m a
-> (e -> SafeErrorToIOC' s s' exc m a)
-> SafeErrorToIOC' s s' exc m a
forall e a.
Exception e =>
SafeErrorToIOC' s s' exc m a
-> (e -> SafeErrorToIOC' s s' exc m a)
-> SafeErrorToIOC' s s' exc m a
forall s s' exc (m :: * -> *).
MonadCatch m =>
MonadThrow (SafeErrorToIOC' s s' exc m)
forall s s' exc (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
SafeErrorToIOC' s s' exc m a
-> (e -> SafeErrorToIOC' s s' exc m a)
-> SafeErrorToIOC' s s' exc m a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
catch :: SafeErrorToIOC' s s' exc m a
-> (e -> SafeErrorToIOC' s s' exc m a)
-> SafeErrorToIOC' s s' exc m a
$ccatch :: forall s s' exc (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
SafeErrorToIOC' s s' exc m a
-> (e -> SafeErrorToIOC' s s' exc m a)
-> SafeErrorToIOC' s s' exc m a
$cp1MonadCatch :: forall s s' exc (m :: * -> *).
MonadCatch m =>
MonadThrow (SafeErrorToIOC' s s' exc m)
MonadCatch, MonadCatch (SafeErrorToIOC' s s' exc m)
MonadCatch (SafeErrorToIOC' s s' exc m)
-> (forall b.
    ((forall a.
      SafeErrorToIOC' s s' exc m a -> SafeErrorToIOC' s s' exc m a)
     -> SafeErrorToIOC' s s' exc m b)
    -> SafeErrorToIOC' s s' exc m b)
-> (forall b.
    ((forall a.
      SafeErrorToIOC' s s' exc m a -> SafeErrorToIOC' s s' exc m a)
     -> SafeErrorToIOC' s s' exc m b)
    -> SafeErrorToIOC' s s' exc m b)
-> (forall a b c.
    SafeErrorToIOC' s s' exc m a
    -> (a -> ExitCase b -> SafeErrorToIOC' s s' exc m c)
    -> (a -> SafeErrorToIOC' s s' exc m b)
    -> SafeErrorToIOC' s s' exc m (b, c))
-> MonadMask (SafeErrorToIOC' s s' exc m)
SafeErrorToIOC' s s' exc m a
-> (a -> ExitCase b -> SafeErrorToIOC' s s' exc m c)
-> (a -> SafeErrorToIOC' s s' exc m b)
-> SafeErrorToIOC' s s' exc m (b, c)
((forall a.
  SafeErrorToIOC' s s' exc m a -> SafeErrorToIOC' s s' exc m a)
 -> SafeErrorToIOC' s s' exc m b)
-> SafeErrorToIOC' s s' exc m b
((forall a.
  SafeErrorToIOC' s s' exc m a -> SafeErrorToIOC' s s' exc m a)
 -> SafeErrorToIOC' s s' exc m b)
-> SafeErrorToIOC' s s' exc m b
forall b.
((forall a.
  SafeErrorToIOC' s s' exc m a -> SafeErrorToIOC' s s' exc m a)
 -> SafeErrorToIOC' s s' exc m b)
-> SafeErrorToIOC' s s' exc m b
forall a b c.
SafeErrorToIOC' s s' exc m a
-> (a -> ExitCase b -> SafeErrorToIOC' s s' exc m c)
-> (a -> SafeErrorToIOC' s s' exc m b)
-> SafeErrorToIOC' s s' exc m (b, c)
forall s s' exc (m :: * -> *).
MonadMask m =>
MonadCatch (SafeErrorToIOC' s s' exc m)
forall s s' exc (m :: * -> *) b.
MonadMask m =>
((forall a.
  SafeErrorToIOC' s s' exc m a -> SafeErrorToIOC' s s' exc m a)
 -> SafeErrorToIOC' s s' exc m b)
-> SafeErrorToIOC' s s' exc m b
forall s s' exc (m :: * -> *) a b c.
MonadMask m =>
SafeErrorToIOC' s s' exc m a
-> (a -> ExitCase b -> SafeErrorToIOC' s s' exc m c)
-> (a -> SafeErrorToIOC' s s' exc m b)
-> SafeErrorToIOC' s s' exc m (b, c)
forall (m :: * -> *).
MonadCatch m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
generalBracket :: SafeErrorToIOC' s s' exc m a
-> (a -> ExitCase b -> SafeErrorToIOC' s s' exc m c)
-> (a -> SafeErrorToIOC' s s' exc m b)
-> SafeErrorToIOC' s s' exc m (b, c)
$cgeneralBracket :: forall s s' exc (m :: * -> *) a b c.
MonadMask m =>
SafeErrorToIOC' s s' exc m a
-> (a -> ExitCase b -> SafeErrorToIOC' s s' exc m c)
-> (a -> SafeErrorToIOC' s s' exc m b)
-> SafeErrorToIOC' s s' exc m (b, c)
uninterruptibleMask :: ((forall a.
  SafeErrorToIOC' s s' exc m a -> SafeErrorToIOC' s s' exc m a)
 -> SafeErrorToIOC' s s' exc m b)
-> SafeErrorToIOC' s s' exc m b
$cuninterruptibleMask :: forall s s' exc (m :: * -> *) b.
MonadMask m =>
((forall a.
  SafeErrorToIOC' s s' exc m a -> SafeErrorToIOC' s s' exc m a)
 -> SafeErrorToIOC' s s' exc m b)
-> SafeErrorToIOC' s s' exc m b
mask :: ((forall a.
  SafeErrorToIOC' s s' exc m a -> SafeErrorToIOC' s s' exc m a)
 -> SafeErrorToIOC' s s' exc m b)
-> SafeErrorToIOC' s s' exc m b
$cmask :: forall s s' exc (m :: * -> *) b.
MonadMask m =>
((forall a.
  SafeErrorToIOC' s s' exc m a -> SafeErrorToIOC' s s' exc m a)
 -> SafeErrorToIOC' s s' exc m b)
-> SafeErrorToIOC' s s' exc m b
$cp1MonadMask :: forall s s' exc (m :: * -> *).
MonadMask m =>
MonadCatch (SafeErrorToIOC' s s' exc m)
MonadMask
             , MonadBase b, MonadBaseControl b
             )
    deriving (m a -> SafeErrorToIOC' s s' exc m a
(forall (m :: * -> *) a.
 Monad m =>
 m a -> SafeErrorToIOC' s s' exc m a)
-> MonadTrans (SafeErrorToIOC' s s' exc)
forall s s' exc (m :: * -> *) a.
Monad m =>
m a -> SafeErrorToIOC' s s' exc m a
forall (m :: * -> *) a.
Monad m =>
m a -> SafeErrorToIOC' s s' exc m a
forall (t :: Effect).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> SafeErrorToIOC' s s' exc m a
$clift :: forall s s' exc (m :: * -> *) a.
Monad m =>
m a -> SafeErrorToIOC' s s' exc m a
MonadTrans, MonadTrans (SafeErrorToIOC' s s' exc)
m (StT (SafeErrorToIOC' s s' exc) a)
-> SafeErrorToIOC' s s' exc m a
MonadTrans (SafeErrorToIOC' s s' exc)
-> (forall (m :: * -> *) a.
    Monad m =>
    (Run (SafeErrorToIOC' s s' exc) -> m a)
    -> SafeErrorToIOC' s s' exc m a)
-> (forall (m :: * -> *) a.
    Monad m =>
    m (StT (SafeErrorToIOC' s s' exc) a)
    -> SafeErrorToIOC' s s' exc m a)
-> MonadTransControl (SafeErrorToIOC' s s' exc)
(Run (SafeErrorToIOC' s s' exc) -> m a)
-> SafeErrorToIOC' s s' exc m a
forall s s' exc. MonadTrans (SafeErrorToIOC' s s' exc)
forall s s' exc (m :: * -> *) a.
Monad m =>
m (StT (SafeErrorToIOC' s s' exc) a)
-> SafeErrorToIOC' s s' exc m a
forall s s' exc (m :: * -> *) a.
Monad m =>
(Run (SafeErrorToIOC' s s' exc) -> m a)
-> SafeErrorToIOC' s s' exc m a
forall (m :: * -> *) a.
Monad m =>
m (StT (SafeErrorToIOC' s s' exc) a)
-> SafeErrorToIOC' s s' exc m a
forall (m :: * -> *) a.
Monad m =>
(Run (SafeErrorToIOC' s s' exc) -> m a)
-> SafeErrorToIOC' s s' exc m a
forall (t :: Effect).
MonadTrans t
-> (forall (m :: * -> *) a. Monad m => (Run t -> m a) -> t m a)
-> (forall (m :: * -> *) a. Monad m => m (StT t a) -> t m a)
-> MonadTransControl t
restoreT :: m (StT (SafeErrorToIOC' s s' exc) a)
-> SafeErrorToIOC' s s' exc m a
$crestoreT :: forall s s' exc (m :: * -> *) a.
Monad m =>
m (StT (SafeErrorToIOC' s s' exc) a)
-> SafeErrorToIOC' s s' exc m a
liftWith :: (Run (SafeErrorToIOC' s s' exc) -> m a)
-> SafeErrorToIOC' s s' exc m a
$cliftWith :: forall s s' exc (m :: * -> *) a.
Monad m =>
(Run (SafeErrorToIOC' s s' exc) -> m a)
-> SafeErrorToIOC' s s' exc m a
$cp1MonadTransControl :: forall s s' exc. MonadTrans (SafeErrorToIOC' s s' exc)
MonadTransControl)
    via CompositionBaseT
     '[ IntroUnderC (SafeError exc) '[Catch exc, Throw exc]
      , SafeErrorToErrorC exc
      , ErrorToIOC' s s' exc
      ]

deriving instance ( Eff (Embed IO) m, MonadCatch m
                  , ReifiesErrorHandler s s' exc (ErrorIOToIOC m)
                  )
               => Carrier (SafeErrorToIOC' s s' exc m)

type SafeErrorToIOC e m a =
     forall s s'
   . ReifiesErrorHandler s s' e (ErrorIOToIOC m)
  => SafeErrorToIOC' s s' e m a

newtype SafeErrorToErrorIOC' s s' exc m a = SafeErrorToErrorIOC' {
    SafeErrorToErrorIOC' s s' exc m a
-> IntroUnderC
     (SafeError exc)
     '[Catch exc, Throw exc]
     (SafeErrorToErrorC exc (InterpretErrorC' s s' exc m))
     a
unSafeErrorToErrorIOC' ::
        IntroUnderC (SafeError exc) '[Catch exc, Throw exc]
      ( SafeErrorToErrorC exc
      ( InterpretErrorC' s s' exc
      ( m
      ))) a
  } deriving ( a
-> SafeErrorToErrorIOC' s s' exc m b
-> SafeErrorToErrorIOC' s s' exc m a
(a -> b)
-> SafeErrorToErrorIOC' s s' exc m a
-> SafeErrorToErrorIOC' s s' exc m b
(forall a b.
 (a -> b)
 -> SafeErrorToErrorIOC' s s' exc m a
 -> SafeErrorToErrorIOC' s s' exc m b)
-> (forall a b.
    a
    -> SafeErrorToErrorIOC' s s' exc m b
    -> SafeErrorToErrorIOC' s s' exc m a)
-> Functor (SafeErrorToErrorIOC' s s' exc m)
forall a b.
a
-> SafeErrorToErrorIOC' s s' exc m b
-> SafeErrorToErrorIOC' s s' exc m a
forall a b.
(a -> b)
-> SafeErrorToErrorIOC' s s' exc m a
-> SafeErrorToErrorIOC' s s' exc m b
forall s s' exc (m :: * -> *) a b.
Functor m =>
a
-> SafeErrorToErrorIOC' s s' exc m b
-> SafeErrorToErrorIOC' s s' exc m a
forall s s' exc (m :: * -> *) a b.
Functor m =>
(a -> b)
-> SafeErrorToErrorIOC' s s' exc m a
-> SafeErrorToErrorIOC' s s' exc m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a
-> SafeErrorToErrorIOC' s s' exc m b
-> SafeErrorToErrorIOC' s s' exc m a
$c<$ :: forall s s' exc (m :: * -> *) a b.
Functor m =>
a
-> SafeErrorToErrorIOC' s s' exc m b
-> SafeErrorToErrorIOC' s s' exc m a
fmap :: (a -> b)
-> SafeErrorToErrorIOC' s s' exc m a
-> SafeErrorToErrorIOC' s s' exc m b
$cfmap :: forall s s' exc (m :: * -> *) a b.
Functor m =>
(a -> b)
-> SafeErrorToErrorIOC' s s' exc m a
-> SafeErrorToErrorIOC' s s' exc m b
Functor, Functor (SafeErrorToErrorIOC' s s' exc m)
a -> SafeErrorToErrorIOC' s s' exc m a
Functor (SafeErrorToErrorIOC' s s' exc m)
-> (forall a. a -> SafeErrorToErrorIOC' s s' exc m a)
-> (forall a b.
    SafeErrorToErrorIOC' s s' exc m (a -> b)
    -> SafeErrorToErrorIOC' s s' exc m a
    -> SafeErrorToErrorIOC' s s' exc m b)
-> (forall a b c.
    (a -> b -> c)
    -> SafeErrorToErrorIOC' s s' exc m a
    -> SafeErrorToErrorIOC' s s' exc m b
    -> SafeErrorToErrorIOC' s s' exc m c)
-> (forall a b.
    SafeErrorToErrorIOC' s s' exc m a
    -> SafeErrorToErrorIOC' s s' exc m b
    -> SafeErrorToErrorIOC' s s' exc m b)
-> (forall a b.
    SafeErrorToErrorIOC' s s' exc m a
    -> SafeErrorToErrorIOC' s s' exc m b
    -> SafeErrorToErrorIOC' s s' exc m a)
-> Applicative (SafeErrorToErrorIOC' s s' exc m)
SafeErrorToErrorIOC' s s' exc m a
-> SafeErrorToErrorIOC' s s' exc m b
-> SafeErrorToErrorIOC' s s' exc m b
SafeErrorToErrorIOC' s s' exc m a
-> SafeErrorToErrorIOC' s s' exc m b
-> SafeErrorToErrorIOC' s s' exc m a
SafeErrorToErrorIOC' s s' exc m (a -> b)
-> SafeErrorToErrorIOC' s s' exc m a
-> SafeErrorToErrorIOC' s s' exc m b
(a -> b -> c)
-> SafeErrorToErrorIOC' s s' exc m a
-> SafeErrorToErrorIOC' s s' exc m b
-> SafeErrorToErrorIOC' s s' exc m c
forall a. a -> SafeErrorToErrorIOC' s s' exc m a
forall a b.
SafeErrorToErrorIOC' s s' exc m a
-> SafeErrorToErrorIOC' s s' exc m b
-> SafeErrorToErrorIOC' s s' exc m a
forall a b.
SafeErrorToErrorIOC' s s' exc m a
-> SafeErrorToErrorIOC' s s' exc m b
-> SafeErrorToErrorIOC' s s' exc m b
forall a b.
SafeErrorToErrorIOC' s s' exc m (a -> b)
-> SafeErrorToErrorIOC' s s' exc m a
-> SafeErrorToErrorIOC' s s' exc m b
forall a b c.
(a -> b -> c)
-> SafeErrorToErrorIOC' s s' exc m a
-> SafeErrorToErrorIOC' s s' exc m b
-> SafeErrorToErrorIOC' s s' exc m c
forall s s' exc (m :: * -> *).
Applicative m =>
Functor (SafeErrorToErrorIOC' s s' exc m)
forall s s' exc (m :: * -> *) a.
Applicative m =>
a -> SafeErrorToErrorIOC' s s' exc m a
forall s s' exc (m :: * -> *) a b.
Applicative m =>
SafeErrorToErrorIOC' s s' exc m a
-> SafeErrorToErrorIOC' s s' exc m b
-> SafeErrorToErrorIOC' s s' exc m a
forall s s' exc (m :: * -> *) a b.
Applicative m =>
SafeErrorToErrorIOC' s s' exc m a
-> SafeErrorToErrorIOC' s s' exc m b
-> SafeErrorToErrorIOC' s s' exc m b
forall s s' exc (m :: * -> *) a b.
Applicative m =>
SafeErrorToErrorIOC' s s' exc m (a -> b)
-> SafeErrorToErrorIOC' s s' exc m a
-> SafeErrorToErrorIOC' s s' exc m b
forall s s' exc (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> SafeErrorToErrorIOC' s s' exc m a
-> SafeErrorToErrorIOC' s s' exc m b
-> SafeErrorToErrorIOC' s s' exc m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: SafeErrorToErrorIOC' s s' exc m a
-> SafeErrorToErrorIOC' s s' exc m b
-> SafeErrorToErrorIOC' s s' exc m a
$c<* :: forall s s' exc (m :: * -> *) a b.
Applicative m =>
SafeErrorToErrorIOC' s s' exc m a
-> SafeErrorToErrorIOC' s s' exc m b
-> SafeErrorToErrorIOC' s s' exc m a
*> :: SafeErrorToErrorIOC' s s' exc m a
-> SafeErrorToErrorIOC' s s' exc m b
-> SafeErrorToErrorIOC' s s' exc m b
$c*> :: forall s s' exc (m :: * -> *) a b.
Applicative m =>
SafeErrorToErrorIOC' s s' exc m a
-> SafeErrorToErrorIOC' s s' exc m b
-> SafeErrorToErrorIOC' s s' exc m b
liftA2 :: (a -> b -> c)
-> SafeErrorToErrorIOC' s s' exc m a
-> SafeErrorToErrorIOC' s s' exc m b
-> SafeErrorToErrorIOC' s s' exc m c
$cliftA2 :: forall s s' exc (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> SafeErrorToErrorIOC' s s' exc m a
-> SafeErrorToErrorIOC' s s' exc m b
-> SafeErrorToErrorIOC' s s' exc m c
<*> :: SafeErrorToErrorIOC' s s' exc m (a -> b)
-> SafeErrorToErrorIOC' s s' exc m a
-> SafeErrorToErrorIOC' s s' exc m b
$c<*> :: forall s s' exc (m :: * -> *) a b.
Applicative m =>
SafeErrorToErrorIOC' s s' exc m (a -> b)
-> SafeErrorToErrorIOC' s s' exc m a
-> SafeErrorToErrorIOC' s s' exc m b
pure :: a -> SafeErrorToErrorIOC' s s' exc m a
$cpure :: forall s s' exc (m :: * -> *) a.
Applicative m =>
a -> SafeErrorToErrorIOC' s s' exc m a
$cp1Applicative :: forall s s' exc (m :: * -> *).
Applicative m =>
Functor (SafeErrorToErrorIOC' s s' exc m)
Applicative, Applicative (SafeErrorToErrorIOC' s s' exc m)
a -> SafeErrorToErrorIOC' s s' exc m a
Applicative (SafeErrorToErrorIOC' s s' exc m)
-> (forall a b.
    SafeErrorToErrorIOC' s s' exc m a
    -> (a -> SafeErrorToErrorIOC' s s' exc m b)
    -> SafeErrorToErrorIOC' s s' exc m b)
-> (forall a b.
    SafeErrorToErrorIOC' s s' exc m a
    -> SafeErrorToErrorIOC' s s' exc m b
    -> SafeErrorToErrorIOC' s s' exc m b)
-> (forall a. a -> SafeErrorToErrorIOC' s s' exc m a)
-> Monad (SafeErrorToErrorIOC' s s' exc m)
SafeErrorToErrorIOC' s s' exc m a
-> (a -> SafeErrorToErrorIOC' s s' exc m b)
-> SafeErrorToErrorIOC' s s' exc m b
SafeErrorToErrorIOC' s s' exc m a
-> SafeErrorToErrorIOC' s s' exc m b
-> SafeErrorToErrorIOC' s s' exc m b
forall a. a -> SafeErrorToErrorIOC' s s' exc m a
forall a b.
SafeErrorToErrorIOC' s s' exc m a
-> SafeErrorToErrorIOC' s s' exc m b
-> SafeErrorToErrorIOC' s s' exc m b
forall a b.
SafeErrorToErrorIOC' s s' exc m a
-> (a -> SafeErrorToErrorIOC' s s' exc m b)
-> SafeErrorToErrorIOC' s s' exc m b
forall s s' exc (m :: * -> *).
Monad m =>
Applicative (SafeErrorToErrorIOC' s s' exc m)
forall s s' exc (m :: * -> *) a.
Monad m =>
a -> SafeErrorToErrorIOC' s s' exc m a
forall s s' exc (m :: * -> *) a b.
Monad m =>
SafeErrorToErrorIOC' s s' exc m a
-> SafeErrorToErrorIOC' s s' exc m b
-> SafeErrorToErrorIOC' s s' exc m b
forall s s' exc (m :: * -> *) a b.
Monad m =>
SafeErrorToErrorIOC' s s' exc m a
-> (a -> SafeErrorToErrorIOC' s s' exc m b)
-> SafeErrorToErrorIOC' s s' exc m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> SafeErrorToErrorIOC' s s' exc m a
$creturn :: forall s s' exc (m :: * -> *) a.
Monad m =>
a -> SafeErrorToErrorIOC' s s' exc m a
>> :: SafeErrorToErrorIOC' s s' exc m a
-> SafeErrorToErrorIOC' s s' exc m b
-> SafeErrorToErrorIOC' s s' exc m b
$c>> :: forall s s' exc (m :: * -> *) a b.
Monad m =>
SafeErrorToErrorIOC' s s' exc m a
-> SafeErrorToErrorIOC' s s' exc m b
-> SafeErrorToErrorIOC' s s' exc m b
>>= :: SafeErrorToErrorIOC' s s' exc m a
-> (a -> SafeErrorToErrorIOC' s s' exc m b)
-> SafeErrorToErrorIOC' s s' exc m b
$c>>= :: forall s s' exc (m :: * -> *) a b.
Monad m =>
SafeErrorToErrorIOC' s s' exc m a
-> (a -> SafeErrorToErrorIOC' s s' exc m b)
-> SafeErrorToErrorIOC' s s' exc m b
$cp1Monad :: forall s s' exc (m :: * -> *).
Monad m =>
Applicative (SafeErrorToErrorIOC' s s' exc m)
Monad
             , Applicative (SafeErrorToErrorIOC' s s' exc m)
SafeErrorToErrorIOC' s s' exc m a
Applicative (SafeErrorToErrorIOC' s s' exc m)
-> (forall a. SafeErrorToErrorIOC' s s' exc m a)
-> (forall a.
    SafeErrorToErrorIOC' s s' exc m a
    -> SafeErrorToErrorIOC' s s' exc m a
    -> SafeErrorToErrorIOC' s s' exc m a)
-> (forall a.
    SafeErrorToErrorIOC' s s' exc m a
    -> SafeErrorToErrorIOC' s s' exc m [a])
-> (forall a.
    SafeErrorToErrorIOC' s s' exc m a
    -> SafeErrorToErrorIOC' s s' exc m [a])
-> Alternative (SafeErrorToErrorIOC' s s' exc m)
SafeErrorToErrorIOC' s s' exc m a
-> SafeErrorToErrorIOC' s s' exc m a
-> SafeErrorToErrorIOC' s s' exc m a
SafeErrorToErrorIOC' s s' exc m a
-> SafeErrorToErrorIOC' s s' exc m [a]
SafeErrorToErrorIOC' s s' exc m a
-> SafeErrorToErrorIOC' s s' exc m [a]
forall a. SafeErrorToErrorIOC' s s' exc m a
forall a.
SafeErrorToErrorIOC' s s' exc m a
-> SafeErrorToErrorIOC' s s' exc m [a]
forall a.
SafeErrorToErrorIOC' s s' exc m a
-> SafeErrorToErrorIOC' s s' exc m a
-> SafeErrorToErrorIOC' s s' exc m a
forall s s' exc (m :: * -> *).
Alternative m =>
Applicative (SafeErrorToErrorIOC' s s' exc m)
forall s s' exc (m :: * -> *) a.
Alternative m =>
SafeErrorToErrorIOC' s s' exc m a
forall s s' exc (m :: * -> *) a.
Alternative m =>
SafeErrorToErrorIOC' s s' exc m a
-> SafeErrorToErrorIOC' s s' exc m [a]
forall s s' exc (m :: * -> *) a.
Alternative m =>
SafeErrorToErrorIOC' s s' exc m a
-> SafeErrorToErrorIOC' s s' exc m a
-> SafeErrorToErrorIOC' s s' exc m a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
many :: SafeErrorToErrorIOC' s s' exc m a
-> SafeErrorToErrorIOC' s s' exc m [a]
$cmany :: forall s s' exc (m :: * -> *) a.
Alternative m =>
SafeErrorToErrorIOC' s s' exc m a
-> SafeErrorToErrorIOC' s s' exc m [a]
some :: SafeErrorToErrorIOC' s s' exc m a
-> SafeErrorToErrorIOC' s s' exc m [a]
$csome :: forall s s' exc (m :: * -> *) a.
Alternative m =>
SafeErrorToErrorIOC' s s' exc m a
-> SafeErrorToErrorIOC' s s' exc m [a]
<|> :: SafeErrorToErrorIOC' s s' exc m a
-> SafeErrorToErrorIOC' s s' exc m a
-> SafeErrorToErrorIOC' s s' exc m a
$c<|> :: forall s s' exc (m :: * -> *) a.
Alternative m =>
SafeErrorToErrorIOC' s s' exc m a
-> SafeErrorToErrorIOC' s s' exc m a
-> SafeErrorToErrorIOC' s s' exc m a
empty :: SafeErrorToErrorIOC' s s' exc m a
$cempty :: forall s s' exc (m :: * -> *) a.
Alternative m =>
SafeErrorToErrorIOC' s s' exc m a
$cp1Alternative :: forall s s' exc (m :: * -> *).
Alternative m =>
Applicative (SafeErrorToErrorIOC' s s' exc m)
Alternative, Monad (SafeErrorToErrorIOC' s s' exc m)
Alternative (SafeErrorToErrorIOC' s s' exc m)
SafeErrorToErrorIOC' s s' exc m a
Alternative (SafeErrorToErrorIOC' s s' exc m)
-> Monad (SafeErrorToErrorIOC' s s' exc m)
-> (forall a. SafeErrorToErrorIOC' s s' exc m a)
-> (forall a.
    SafeErrorToErrorIOC' s s' exc m a
    -> SafeErrorToErrorIOC' s s' exc m a
    -> SafeErrorToErrorIOC' s s' exc m a)
-> MonadPlus (SafeErrorToErrorIOC' s s' exc m)
SafeErrorToErrorIOC' s s' exc m a
-> SafeErrorToErrorIOC' s s' exc m a
-> SafeErrorToErrorIOC' s s' exc m a
forall a. SafeErrorToErrorIOC' s s' exc m a
forall a.
SafeErrorToErrorIOC' s s' exc m a
-> SafeErrorToErrorIOC' s s' exc m a
-> SafeErrorToErrorIOC' s s' exc m a
forall s s' exc (m :: * -> *).
MonadPlus m =>
Monad (SafeErrorToErrorIOC' s s' exc m)
forall s s' exc (m :: * -> *).
MonadPlus m =>
Alternative (SafeErrorToErrorIOC' s s' exc m)
forall s s' exc (m :: * -> *) a.
MonadPlus m =>
SafeErrorToErrorIOC' s s' exc m a
forall s s' exc (m :: * -> *) a.
MonadPlus m =>
SafeErrorToErrorIOC' s s' exc m a
-> SafeErrorToErrorIOC' s s' exc m a
-> SafeErrorToErrorIOC' s s' exc m a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
mplus :: SafeErrorToErrorIOC' s s' exc m a
-> SafeErrorToErrorIOC' s s' exc m a
-> SafeErrorToErrorIOC' s s' exc m a
$cmplus :: forall s s' exc (m :: * -> *) a.
MonadPlus m =>
SafeErrorToErrorIOC' s s' exc m a
-> SafeErrorToErrorIOC' s s' exc m a
-> SafeErrorToErrorIOC' s s' exc m a
mzero :: SafeErrorToErrorIOC' s s' exc m a
$cmzero :: forall s s' exc (m :: * -> *) a.
MonadPlus m =>
SafeErrorToErrorIOC' s s' exc m a
$cp2MonadPlus :: forall s s' exc (m :: * -> *).
MonadPlus m =>
Monad (SafeErrorToErrorIOC' s s' exc m)
$cp1MonadPlus :: forall s s' exc (m :: * -> *).
MonadPlus m =>
Alternative (SafeErrorToErrorIOC' s s' exc m)
MonadPlus
             , Monad (SafeErrorToErrorIOC' s s' exc m)
Monad (SafeErrorToErrorIOC' s s' exc m)
-> (forall a.
    (a -> SafeErrorToErrorIOC' s s' exc m a)
    -> SafeErrorToErrorIOC' s s' exc m a)
-> MonadFix (SafeErrorToErrorIOC' s s' exc m)
(a -> SafeErrorToErrorIOC' s s' exc m a)
-> SafeErrorToErrorIOC' s s' exc m a
forall a.
(a -> SafeErrorToErrorIOC' s s' exc m a)
-> SafeErrorToErrorIOC' s s' exc m a
forall s s' exc (m :: * -> *).
MonadFix m =>
Monad (SafeErrorToErrorIOC' s s' exc m)
forall s s' exc (m :: * -> *) a.
MonadFix m =>
(a -> SafeErrorToErrorIOC' s s' exc m a)
-> SafeErrorToErrorIOC' s s' exc m a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
mfix :: (a -> SafeErrorToErrorIOC' s s' exc m a)
-> SafeErrorToErrorIOC' s s' exc m a
$cmfix :: forall s s' exc (m :: * -> *) a.
MonadFix m =>
(a -> SafeErrorToErrorIOC' s s' exc m a)
-> SafeErrorToErrorIOC' s s' exc m a
$cp1MonadFix :: forall s s' exc (m :: * -> *).
MonadFix m =>
Monad (SafeErrorToErrorIOC' s s' exc m)
MonadFix, Monad (SafeErrorToErrorIOC' s s' exc m)
Monad (SafeErrorToErrorIOC' s s' exc m)
-> (forall a. String -> SafeErrorToErrorIOC' s s' exc m a)
-> MonadFail (SafeErrorToErrorIOC' s s' exc m)
String -> SafeErrorToErrorIOC' s s' exc m a
forall a. String -> SafeErrorToErrorIOC' s s' exc m a
forall s s' exc (m :: * -> *).
MonadFail m =>
Monad (SafeErrorToErrorIOC' s s' exc m)
forall s s' exc (m :: * -> *) a.
MonadFail m =>
String -> SafeErrorToErrorIOC' s s' exc m a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
fail :: String -> SafeErrorToErrorIOC' s s' exc m a
$cfail :: forall s s' exc (m :: * -> *) a.
MonadFail m =>
String -> SafeErrorToErrorIOC' s s' exc m a
$cp1MonadFail :: forall s s' exc (m :: * -> *).
MonadFail m =>
Monad (SafeErrorToErrorIOC' s s' exc m)
MonadFail, Monad (SafeErrorToErrorIOC' s s' exc m)
Monad (SafeErrorToErrorIOC' s s' exc m)
-> (forall a. IO a -> SafeErrorToErrorIOC' s s' exc m a)
-> MonadIO (SafeErrorToErrorIOC' s s' exc m)
IO a -> SafeErrorToErrorIOC' s s' exc m a
forall a. IO a -> SafeErrorToErrorIOC' s s' exc m a
forall s s' exc (m :: * -> *).
MonadIO m =>
Monad (SafeErrorToErrorIOC' s s' exc m)
forall s s' exc (m :: * -> *) a.
MonadIO m =>
IO a -> SafeErrorToErrorIOC' s s' exc m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> SafeErrorToErrorIOC' s s' exc m a
$cliftIO :: forall s s' exc (m :: * -> *) a.
MonadIO m =>
IO a -> SafeErrorToErrorIOC' s s' exc m a
$cp1MonadIO :: forall s s' exc (m :: * -> *).
MonadIO m =>
Monad (SafeErrorToErrorIOC' s s' exc m)
MonadIO
             , Monad (SafeErrorToErrorIOC' s s' exc m)
e -> SafeErrorToErrorIOC' s s' exc m a
Monad (SafeErrorToErrorIOC' s s' exc m)
-> (forall e a.
    Exception e =>
    e -> SafeErrorToErrorIOC' s s' exc m a)
-> MonadThrow (SafeErrorToErrorIOC' s s' exc m)
forall e a. Exception e => e -> SafeErrorToErrorIOC' s s' exc m a
forall s s' exc (m :: * -> *).
MonadThrow m =>
Monad (SafeErrorToErrorIOC' s s' exc m)
forall s s' exc (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> SafeErrorToErrorIOC' s s' exc m a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: e -> SafeErrorToErrorIOC' s s' exc m a
$cthrowM :: forall s s' exc (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> SafeErrorToErrorIOC' s s' exc m a
$cp1MonadThrow :: forall s s' exc (m :: * -> *).
MonadThrow m =>
Monad (SafeErrorToErrorIOC' s s' exc m)
MonadThrow, MonadThrow (SafeErrorToErrorIOC' s s' exc m)
MonadThrow (SafeErrorToErrorIOC' s s' exc m)
-> (forall e a.
    Exception e =>
    SafeErrorToErrorIOC' s s' exc m a
    -> (e -> SafeErrorToErrorIOC' s s' exc m a)
    -> SafeErrorToErrorIOC' s s' exc m a)
-> MonadCatch (SafeErrorToErrorIOC' s s' exc m)
SafeErrorToErrorIOC' s s' exc m a
-> (e -> SafeErrorToErrorIOC' s s' exc m a)
-> SafeErrorToErrorIOC' s s' exc m a
forall e a.
Exception e =>
SafeErrorToErrorIOC' s s' exc m a
-> (e -> SafeErrorToErrorIOC' s s' exc m a)
-> SafeErrorToErrorIOC' s s' exc m a
forall s s' exc (m :: * -> *).
MonadCatch m =>
MonadThrow (SafeErrorToErrorIOC' s s' exc m)
forall s s' exc (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
SafeErrorToErrorIOC' s s' exc m a
-> (e -> SafeErrorToErrorIOC' s s' exc m a)
-> SafeErrorToErrorIOC' s s' exc m a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
catch :: SafeErrorToErrorIOC' s s' exc m a
-> (e -> SafeErrorToErrorIOC' s s' exc m a)
-> SafeErrorToErrorIOC' s s' exc m a
$ccatch :: forall s s' exc (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
SafeErrorToErrorIOC' s s' exc m a
-> (e -> SafeErrorToErrorIOC' s s' exc m a)
-> SafeErrorToErrorIOC' s s' exc m a
$cp1MonadCatch :: forall s s' exc (m :: * -> *).
MonadCatch m =>
MonadThrow (SafeErrorToErrorIOC' s s' exc m)
MonadCatch, MonadCatch (SafeErrorToErrorIOC' s s' exc m)
MonadCatch (SafeErrorToErrorIOC' s s' exc m)
-> (forall b.
    ((forall a.
      SafeErrorToErrorIOC' s s' exc m a
      -> SafeErrorToErrorIOC' s s' exc m a)
     -> SafeErrorToErrorIOC' s s' exc m b)
    -> SafeErrorToErrorIOC' s s' exc m b)
-> (forall b.
    ((forall a.
      SafeErrorToErrorIOC' s s' exc m a
      -> SafeErrorToErrorIOC' s s' exc m a)
     -> SafeErrorToErrorIOC' s s' exc m b)
    -> SafeErrorToErrorIOC' s s' exc m b)
-> (forall a b c.
    SafeErrorToErrorIOC' s s' exc m a
    -> (a -> ExitCase b -> SafeErrorToErrorIOC' s s' exc m c)
    -> (a -> SafeErrorToErrorIOC' s s' exc m b)
    -> SafeErrorToErrorIOC' s s' exc m (b, c))
-> MonadMask (SafeErrorToErrorIOC' s s' exc m)
SafeErrorToErrorIOC' s s' exc m a
-> (a -> ExitCase b -> SafeErrorToErrorIOC' s s' exc m c)
-> (a -> SafeErrorToErrorIOC' s s' exc m b)
-> SafeErrorToErrorIOC' s s' exc m (b, c)
((forall a.
  SafeErrorToErrorIOC' s s' exc m a
  -> SafeErrorToErrorIOC' s s' exc m a)
 -> SafeErrorToErrorIOC' s s' exc m b)
-> SafeErrorToErrorIOC' s s' exc m b
((forall a.
  SafeErrorToErrorIOC' s s' exc m a
  -> SafeErrorToErrorIOC' s s' exc m a)
 -> SafeErrorToErrorIOC' s s' exc m b)
-> SafeErrorToErrorIOC' s s' exc m b
forall b.
((forall a.
  SafeErrorToErrorIOC' s s' exc m a
  -> SafeErrorToErrorIOC' s s' exc m a)
 -> SafeErrorToErrorIOC' s s' exc m b)
-> SafeErrorToErrorIOC' s s' exc m b
forall a b c.
SafeErrorToErrorIOC' s s' exc m a
-> (a -> ExitCase b -> SafeErrorToErrorIOC' s s' exc m c)
-> (a -> SafeErrorToErrorIOC' s s' exc m b)
-> SafeErrorToErrorIOC' s s' exc m (b, c)
forall s s' exc (m :: * -> *).
MonadMask m =>
MonadCatch (SafeErrorToErrorIOC' s s' exc m)
forall s s' exc (m :: * -> *) b.
MonadMask m =>
((forall a.
  SafeErrorToErrorIOC' s s' exc m a
  -> SafeErrorToErrorIOC' s s' exc m a)
 -> SafeErrorToErrorIOC' s s' exc m b)
-> SafeErrorToErrorIOC' s s' exc m b
forall s s' exc (m :: * -> *) a b c.
MonadMask m =>
SafeErrorToErrorIOC' s s' exc m a
-> (a -> ExitCase b -> SafeErrorToErrorIOC' s s' exc m c)
-> (a -> SafeErrorToErrorIOC' s s' exc m b)
-> SafeErrorToErrorIOC' s s' exc m (b, c)
forall (m :: * -> *).
MonadCatch m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
generalBracket :: SafeErrorToErrorIOC' s s' exc m a
-> (a -> ExitCase b -> SafeErrorToErrorIOC' s s' exc m c)
-> (a -> SafeErrorToErrorIOC' s s' exc m b)
-> SafeErrorToErrorIOC' s s' exc m (b, c)
$cgeneralBracket :: forall s s' exc (m :: * -> *) a b c.
MonadMask m =>
SafeErrorToErrorIOC' s s' exc m a
-> (a -> ExitCase b -> SafeErrorToErrorIOC' s s' exc m c)
-> (a -> SafeErrorToErrorIOC' s s' exc m b)
-> SafeErrorToErrorIOC' s s' exc m (b, c)
uninterruptibleMask :: ((forall a.
  SafeErrorToErrorIOC' s s' exc m a
  -> SafeErrorToErrorIOC' s s' exc m a)
 -> SafeErrorToErrorIOC' s s' exc m b)
-> SafeErrorToErrorIOC' s s' exc m b
$cuninterruptibleMask :: forall s s' exc (m :: * -> *) b.
MonadMask m =>
((forall a.
  SafeErrorToErrorIOC' s s' exc m a
  -> SafeErrorToErrorIOC' s s' exc m a)
 -> SafeErrorToErrorIOC' s s' exc m b)
-> SafeErrorToErrorIOC' s s' exc m b
mask :: ((forall a.
  SafeErrorToErrorIOC' s s' exc m a
  -> SafeErrorToErrorIOC' s s' exc m a)
 -> SafeErrorToErrorIOC' s s' exc m b)
-> SafeErrorToErrorIOC' s s' exc m b
$cmask :: forall s s' exc (m :: * -> *) b.
MonadMask m =>
((forall a.
  SafeErrorToErrorIOC' s s' exc m a
  -> SafeErrorToErrorIOC' s s' exc m a)
 -> SafeErrorToErrorIOC' s s' exc m b)
-> SafeErrorToErrorIOC' s s' exc m b
$cp1MonadMask :: forall s s' exc (m :: * -> *).
MonadMask m =>
MonadCatch (SafeErrorToErrorIOC' s s' exc m)
MonadMask
             , MonadBase b, MonadBaseControl b
             )
    deriving (m a -> SafeErrorToErrorIOC' s s' exc m a
(forall (m :: * -> *) a.
 Monad m =>
 m a -> SafeErrorToErrorIOC' s s' exc m a)
-> MonadTrans (SafeErrorToErrorIOC' s s' exc)
forall s s' exc (m :: * -> *) a.
Monad m =>
m a -> SafeErrorToErrorIOC' s s' exc m a
forall (m :: * -> *) a.
Monad m =>
m a -> SafeErrorToErrorIOC' s s' exc m a
forall (t :: Effect).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> SafeErrorToErrorIOC' s s' exc m a
$clift :: forall s s' exc (m :: * -> *) a.
Monad m =>
m a -> SafeErrorToErrorIOC' s s' exc m a
MonadTrans, MonadTrans (SafeErrorToErrorIOC' s s' exc)
m (StT (SafeErrorToErrorIOC' s s' exc) a)
-> SafeErrorToErrorIOC' s s' exc m a
MonadTrans (SafeErrorToErrorIOC' s s' exc)
-> (forall (m :: * -> *) a.
    Monad m =>
    (Run (SafeErrorToErrorIOC' s s' exc) -> m a)
    -> SafeErrorToErrorIOC' s s' exc m a)
-> (forall (m :: * -> *) a.
    Monad m =>
    m (StT (SafeErrorToErrorIOC' s s' exc) a)
    -> SafeErrorToErrorIOC' s s' exc m a)
-> MonadTransControl (SafeErrorToErrorIOC' s s' exc)
(Run (SafeErrorToErrorIOC' s s' exc) -> m a)
-> SafeErrorToErrorIOC' s s' exc m a
forall s s' exc. MonadTrans (SafeErrorToErrorIOC' s s' exc)
forall s s' exc (m :: * -> *) a.
Monad m =>
m (StT (SafeErrorToErrorIOC' s s' exc) a)
-> SafeErrorToErrorIOC' s s' exc m a
forall s s' exc (m :: * -> *) a.
Monad m =>
(Run (SafeErrorToErrorIOC' s s' exc) -> m a)
-> SafeErrorToErrorIOC' s s' exc m a
forall (m :: * -> *) a.
Monad m =>
m (StT (SafeErrorToErrorIOC' s s' exc) a)
-> SafeErrorToErrorIOC' s s' exc m a
forall (m :: * -> *) a.
Monad m =>
(Run (SafeErrorToErrorIOC' s s' exc) -> m a)
-> SafeErrorToErrorIOC' s s' exc m a
forall (t :: Effect).
MonadTrans t
-> (forall (m :: * -> *) a. Monad m => (Run t -> m a) -> t m a)
-> (forall (m :: * -> *) a. Monad m => m (StT t a) -> t m a)
-> MonadTransControl t
restoreT :: m (StT (SafeErrorToErrorIOC' s s' exc) a)
-> SafeErrorToErrorIOC' s s' exc m a
$crestoreT :: forall s s' exc (m :: * -> *) a.
Monad m =>
m (StT (SafeErrorToErrorIOC' s s' exc) a)
-> SafeErrorToErrorIOC' s s' exc m a
liftWith :: (Run (SafeErrorToErrorIOC' s s' exc) -> m a)
-> SafeErrorToErrorIOC' s s' exc m a
$cliftWith :: forall s s' exc (m :: * -> *) a.
Monad m =>
(Run (SafeErrorToErrorIOC' s s' exc) -> m a)
-> SafeErrorToErrorIOC' s s' exc m a
$cp1MonadTransControl :: forall s s' exc. MonadTrans (SafeErrorToErrorIOC' s s' exc)
MonadTransControl)
    via CompositionBaseT
     '[ IntroUnderC (SafeError exc) '[Catch exc, Throw exc]
      , SafeErrorToErrorC exc
      , InterpretErrorC' s s' exc
      ]

deriving instance (Carrier m, ReifiesErrorHandler s s' exc m)
               => Carrier (SafeErrorToErrorIOC' s s' exc m)

type SafeErrorToErrorIOC e m a =
     forall s s'
   . ReifiesErrorHandler s s' e m
  => SafeErrorToErrorIOC' s s' e m a

newtype SafeErrorToIOSimpleC exc m a = SafeErrorToIOSimpleC {
    SafeErrorToIOSimpleC exc m a
-> IntroUnderC
     (SafeError exc)
     '[Catch exc, Throw exc]
     (SafeErrorToErrorC exc (ErrorToIOSimpleC exc m))
     a
unSafeErrorToIOSimpleC ::
        IntroUnderC (SafeError exc) '[Catch exc, Throw exc]
      ( SafeErrorToErrorC exc
      ( ErrorToIOSimpleC exc
      ( m
      ))) a
  } deriving ( a -> SafeErrorToIOSimpleC exc m b -> SafeErrorToIOSimpleC exc m a
(a -> b)
-> SafeErrorToIOSimpleC exc m a -> SafeErrorToIOSimpleC exc m b
(forall a b.
 (a -> b)
 -> SafeErrorToIOSimpleC exc m a -> SafeErrorToIOSimpleC exc m b)
-> (forall a b.
    a -> SafeErrorToIOSimpleC exc m b -> SafeErrorToIOSimpleC exc m a)
-> Functor (SafeErrorToIOSimpleC exc m)
forall a b.
a -> SafeErrorToIOSimpleC exc m b -> SafeErrorToIOSimpleC exc m a
forall a b.
(a -> b)
-> SafeErrorToIOSimpleC exc m a -> SafeErrorToIOSimpleC exc m b
forall exc (m :: * -> *) a b.
Functor m =>
a -> SafeErrorToIOSimpleC exc m b -> SafeErrorToIOSimpleC exc m a
forall exc (m :: * -> *) a b.
Functor m =>
(a -> b)
-> SafeErrorToIOSimpleC exc m a -> SafeErrorToIOSimpleC exc m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> SafeErrorToIOSimpleC exc m b -> SafeErrorToIOSimpleC exc m a
$c<$ :: forall exc (m :: * -> *) a b.
Functor m =>
a -> SafeErrorToIOSimpleC exc m b -> SafeErrorToIOSimpleC exc m a
fmap :: (a -> b)
-> SafeErrorToIOSimpleC exc m a -> SafeErrorToIOSimpleC exc m b
$cfmap :: forall exc (m :: * -> *) a b.
Functor m =>
(a -> b)
-> SafeErrorToIOSimpleC exc m a -> SafeErrorToIOSimpleC exc m b
Functor, Functor (SafeErrorToIOSimpleC exc m)
a -> SafeErrorToIOSimpleC exc m a
Functor (SafeErrorToIOSimpleC exc m)
-> (forall a. a -> SafeErrorToIOSimpleC exc m a)
-> (forall a b.
    SafeErrorToIOSimpleC exc m (a -> b)
    -> SafeErrorToIOSimpleC exc m a -> SafeErrorToIOSimpleC exc m b)
-> (forall a b c.
    (a -> b -> c)
    -> SafeErrorToIOSimpleC exc m a
    -> SafeErrorToIOSimpleC exc m b
    -> SafeErrorToIOSimpleC exc m c)
-> (forall a b.
    SafeErrorToIOSimpleC exc m a
    -> SafeErrorToIOSimpleC exc m b -> SafeErrorToIOSimpleC exc m b)
-> (forall a b.
    SafeErrorToIOSimpleC exc m a
    -> SafeErrorToIOSimpleC exc m b -> SafeErrorToIOSimpleC exc m a)
-> Applicative (SafeErrorToIOSimpleC exc m)
SafeErrorToIOSimpleC exc m a
-> SafeErrorToIOSimpleC exc m b -> SafeErrorToIOSimpleC exc m b
SafeErrorToIOSimpleC exc m a
-> SafeErrorToIOSimpleC exc m b -> SafeErrorToIOSimpleC exc m a
SafeErrorToIOSimpleC exc m (a -> b)
-> SafeErrorToIOSimpleC exc m a -> SafeErrorToIOSimpleC exc m b
(a -> b -> c)
-> SafeErrorToIOSimpleC exc m a
-> SafeErrorToIOSimpleC exc m b
-> SafeErrorToIOSimpleC exc m c
forall a. a -> SafeErrorToIOSimpleC exc m a
forall a b.
SafeErrorToIOSimpleC exc m a
-> SafeErrorToIOSimpleC exc m b -> SafeErrorToIOSimpleC exc m a
forall a b.
SafeErrorToIOSimpleC exc m a
-> SafeErrorToIOSimpleC exc m b -> SafeErrorToIOSimpleC exc m b
forall a b.
SafeErrorToIOSimpleC exc m (a -> b)
-> SafeErrorToIOSimpleC exc m a -> SafeErrorToIOSimpleC exc m b
forall a b c.
(a -> b -> c)
-> SafeErrorToIOSimpleC exc m a
-> SafeErrorToIOSimpleC exc m b
-> SafeErrorToIOSimpleC exc m c
forall exc (m :: * -> *).
Applicative m =>
Functor (SafeErrorToIOSimpleC exc m)
forall exc (m :: * -> *) a.
Applicative m =>
a -> SafeErrorToIOSimpleC exc m a
forall exc (m :: * -> *) a b.
Applicative m =>
SafeErrorToIOSimpleC exc m a
-> SafeErrorToIOSimpleC exc m b -> SafeErrorToIOSimpleC exc m a
forall exc (m :: * -> *) a b.
Applicative m =>
SafeErrorToIOSimpleC exc m a
-> SafeErrorToIOSimpleC exc m b -> SafeErrorToIOSimpleC exc m b
forall exc (m :: * -> *) a b.
Applicative m =>
SafeErrorToIOSimpleC exc m (a -> b)
-> SafeErrorToIOSimpleC exc m a -> SafeErrorToIOSimpleC exc m b
forall exc (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> SafeErrorToIOSimpleC exc m a
-> SafeErrorToIOSimpleC exc m b
-> SafeErrorToIOSimpleC exc m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: SafeErrorToIOSimpleC exc m a
-> SafeErrorToIOSimpleC exc m b -> SafeErrorToIOSimpleC exc m a
$c<* :: forall exc (m :: * -> *) a b.
Applicative m =>
SafeErrorToIOSimpleC exc m a
-> SafeErrorToIOSimpleC exc m b -> SafeErrorToIOSimpleC exc m a
*> :: SafeErrorToIOSimpleC exc m a
-> SafeErrorToIOSimpleC exc m b -> SafeErrorToIOSimpleC exc m b
$c*> :: forall exc (m :: * -> *) a b.
Applicative m =>
SafeErrorToIOSimpleC exc m a
-> SafeErrorToIOSimpleC exc m b -> SafeErrorToIOSimpleC exc m b
liftA2 :: (a -> b -> c)
-> SafeErrorToIOSimpleC exc m a
-> SafeErrorToIOSimpleC exc m b
-> SafeErrorToIOSimpleC exc m c
$cliftA2 :: forall exc (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> SafeErrorToIOSimpleC exc m a
-> SafeErrorToIOSimpleC exc m b
-> SafeErrorToIOSimpleC exc m c
<*> :: SafeErrorToIOSimpleC exc m (a -> b)
-> SafeErrorToIOSimpleC exc m a -> SafeErrorToIOSimpleC exc m b
$c<*> :: forall exc (m :: * -> *) a b.
Applicative m =>
SafeErrorToIOSimpleC exc m (a -> b)
-> SafeErrorToIOSimpleC exc m a -> SafeErrorToIOSimpleC exc m b
pure :: a -> SafeErrorToIOSimpleC exc m a
$cpure :: forall exc (m :: * -> *) a.
Applicative m =>
a -> SafeErrorToIOSimpleC exc m a
$cp1Applicative :: forall exc (m :: * -> *).
Applicative m =>
Functor (SafeErrorToIOSimpleC exc m)
Applicative, Applicative (SafeErrorToIOSimpleC exc m)
a -> SafeErrorToIOSimpleC exc m a
Applicative (SafeErrorToIOSimpleC exc m)
-> (forall a b.
    SafeErrorToIOSimpleC exc m a
    -> (a -> SafeErrorToIOSimpleC exc m b)
    -> SafeErrorToIOSimpleC exc m b)
-> (forall a b.
    SafeErrorToIOSimpleC exc m a
    -> SafeErrorToIOSimpleC exc m b -> SafeErrorToIOSimpleC exc m b)
-> (forall a. a -> SafeErrorToIOSimpleC exc m a)
-> Monad (SafeErrorToIOSimpleC exc m)
SafeErrorToIOSimpleC exc m a
-> (a -> SafeErrorToIOSimpleC exc m b)
-> SafeErrorToIOSimpleC exc m b
SafeErrorToIOSimpleC exc m a
-> SafeErrorToIOSimpleC exc m b -> SafeErrorToIOSimpleC exc m b
forall a. a -> SafeErrorToIOSimpleC exc m a
forall a b.
SafeErrorToIOSimpleC exc m a
-> SafeErrorToIOSimpleC exc m b -> SafeErrorToIOSimpleC exc m b
forall a b.
SafeErrorToIOSimpleC exc m a
-> (a -> SafeErrorToIOSimpleC exc m b)
-> SafeErrorToIOSimpleC exc m b
forall exc (m :: * -> *).
Monad m =>
Applicative (SafeErrorToIOSimpleC exc m)
forall exc (m :: * -> *) a.
Monad m =>
a -> SafeErrorToIOSimpleC exc m a
forall exc (m :: * -> *) a b.
Monad m =>
SafeErrorToIOSimpleC exc m a
-> SafeErrorToIOSimpleC exc m b -> SafeErrorToIOSimpleC exc m b
forall exc (m :: * -> *) a b.
Monad m =>
SafeErrorToIOSimpleC exc m a
-> (a -> SafeErrorToIOSimpleC exc m b)
-> SafeErrorToIOSimpleC exc m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> SafeErrorToIOSimpleC exc m a
$creturn :: forall exc (m :: * -> *) a.
Monad m =>
a -> SafeErrorToIOSimpleC exc m a
>> :: SafeErrorToIOSimpleC exc m a
-> SafeErrorToIOSimpleC exc m b -> SafeErrorToIOSimpleC exc m b
$c>> :: forall exc (m :: * -> *) a b.
Monad m =>
SafeErrorToIOSimpleC exc m a
-> SafeErrorToIOSimpleC exc m b -> SafeErrorToIOSimpleC exc m b
>>= :: SafeErrorToIOSimpleC exc m a
-> (a -> SafeErrorToIOSimpleC exc m b)
-> SafeErrorToIOSimpleC exc m b
$c>>= :: forall exc (m :: * -> *) a b.
Monad m =>
SafeErrorToIOSimpleC exc m a
-> (a -> SafeErrorToIOSimpleC exc m b)
-> SafeErrorToIOSimpleC exc m b
$cp1Monad :: forall exc (m :: * -> *).
Monad m =>
Applicative (SafeErrorToIOSimpleC exc m)
Monad
             , Applicative (SafeErrorToIOSimpleC exc m)
SafeErrorToIOSimpleC exc m a
Applicative (SafeErrorToIOSimpleC exc m)
-> (forall a. SafeErrorToIOSimpleC exc m a)
-> (forall a.
    SafeErrorToIOSimpleC exc m a
    -> SafeErrorToIOSimpleC exc m a -> SafeErrorToIOSimpleC exc m a)
-> (forall a.
    SafeErrorToIOSimpleC exc m a -> SafeErrorToIOSimpleC exc m [a])
-> (forall a.
    SafeErrorToIOSimpleC exc m a -> SafeErrorToIOSimpleC exc m [a])
-> Alternative (SafeErrorToIOSimpleC exc m)
SafeErrorToIOSimpleC exc m a
-> SafeErrorToIOSimpleC exc m a -> SafeErrorToIOSimpleC exc m a
SafeErrorToIOSimpleC exc m a -> SafeErrorToIOSimpleC exc m [a]
SafeErrorToIOSimpleC exc m a -> SafeErrorToIOSimpleC exc m [a]
forall a. SafeErrorToIOSimpleC exc m a
forall a.
SafeErrorToIOSimpleC exc m a -> SafeErrorToIOSimpleC exc m [a]
forall a.
SafeErrorToIOSimpleC exc m a
-> SafeErrorToIOSimpleC exc m a -> SafeErrorToIOSimpleC exc m a
forall exc (m :: * -> *).
Alternative m =>
Applicative (SafeErrorToIOSimpleC exc m)
forall exc (m :: * -> *) a.
Alternative m =>
SafeErrorToIOSimpleC exc m a
forall exc (m :: * -> *) a.
Alternative m =>
SafeErrorToIOSimpleC exc m a -> SafeErrorToIOSimpleC exc m [a]
forall exc (m :: * -> *) a.
Alternative m =>
SafeErrorToIOSimpleC exc m a
-> SafeErrorToIOSimpleC exc m a -> SafeErrorToIOSimpleC exc m a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
many :: SafeErrorToIOSimpleC exc m a -> SafeErrorToIOSimpleC exc m [a]
$cmany :: forall exc (m :: * -> *) a.
Alternative m =>
SafeErrorToIOSimpleC exc m a -> SafeErrorToIOSimpleC exc m [a]
some :: SafeErrorToIOSimpleC exc m a -> SafeErrorToIOSimpleC exc m [a]
$csome :: forall exc (m :: * -> *) a.
Alternative m =>
SafeErrorToIOSimpleC exc m a -> SafeErrorToIOSimpleC exc m [a]
<|> :: SafeErrorToIOSimpleC exc m a
-> SafeErrorToIOSimpleC exc m a -> SafeErrorToIOSimpleC exc m a
$c<|> :: forall exc (m :: * -> *) a.
Alternative m =>
SafeErrorToIOSimpleC exc m a
-> SafeErrorToIOSimpleC exc m a -> SafeErrorToIOSimpleC exc m a
empty :: SafeErrorToIOSimpleC exc m a
$cempty :: forall exc (m :: * -> *) a.
Alternative m =>
SafeErrorToIOSimpleC exc m a
$cp1Alternative :: forall exc (m :: * -> *).
Alternative m =>
Applicative (SafeErrorToIOSimpleC exc m)
Alternative, Monad (SafeErrorToIOSimpleC exc m)
Alternative (SafeErrorToIOSimpleC exc m)
SafeErrorToIOSimpleC exc m a
Alternative (SafeErrorToIOSimpleC exc m)
-> Monad (SafeErrorToIOSimpleC exc m)
-> (forall a. SafeErrorToIOSimpleC exc m a)
-> (forall a.
    SafeErrorToIOSimpleC exc m a
    -> SafeErrorToIOSimpleC exc m a -> SafeErrorToIOSimpleC exc m a)
-> MonadPlus (SafeErrorToIOSimpleC exc m)
SafeErrorToIOSimpleC exc m a
-> SafeErrorToIOSimpleC exc m a -> SafeErrorToIOSimpleC exc m a
forall a. SafeErrorToIOSimpleC exc m a
forall a.
SafeErrorToIOSimpleC exc m a
-> SafeErrorToIOSimpleC exc m a -> SafeErrorToIOSimpleC exc m a
forall exc (m :: * -> *).
MonadPlus m =>
Monad (SafeErrorToIOSimpleC exc m)
forall exc (m :: * -> *).
MonadPlus m =>
Alternative (SafeErrorToIOSimpleC exc m)
forall exc (m :: * -> *) a.
MonadPlus m =>
SafeErrorToIOSimpleC exc m a
forall exc (m :: * -> *) a.
MonadPlus m =>
SafeErrorToIOSimpleC exc m a
-> SafeErrorToIOSimpleC exc m a -> SafeErrorToIOSimpleC exc m a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
mplus :: SafeErrorToIOSimpleC exc m a
-> SafeErrorToIOSimpleC exc m a -> SafeErrorToIOSimpleC exc m a
$cmplus :: forall exc (m :: * -> *) a.
MonadPlus m =>
SafeErrorToIOSimpleC exc m a
-> SafeErrorToIOSimpleC exc m a -> SafeErrorToIOSimpleC exc m a
mzero :: SafeErrorToIOSimpleC exc m a
$cmzero :: forall exc (m :: * -> *) a.
MonadPlus m =>
SafeErrorToIOSimpleC exc m a
$cp2MonadPlus :: forall exc (m :: * -> *).
MonadPlus m =>
Monad (SafeErrorToIOSimpleC exc m)
$cp1MonadPlus :: forall exc (m :: * -> *).
MonadPlus m =>
Alternative (SafeErrorToIOSimpleC exc m)
MonadPlus
             , Monad (SafeErrorToIOSimpleC exc m)
Monad (SafeErrorToIOSimpleC exc m)
-> (forall a.
    (a -> SafeErrorToIOSimpleC exc m a)
    -> SafeErrorToIOSimpleC exc m a)
-> MonadFix (SafeErrorToIOSimpleC exc m)
(a -> SafeErrorToIOSimpleC exc m a) -> SafeErrorToIOSimpleC exc m a
forall a.
(a -> SafeErrorToIOSimpleC exc m a) -> SafeErrorToIOSimpleC exc m a
forall exc (m :: * -> *).
MonadFix m =>
Monad (SafeErrorToIOSimpleC exc m)
forall exc (m :: * -> *) a.
MonadFix m =>
(a -> SafeErrorToIOSimpleC exc m a) -> SafeErrorToIOSimpleC exc m a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
mfix :: (a -> SafeErrorToIOSimpleC exc m a) -> SafeErrorToIOSimpleC exc m a
$cmfix :: forall exc (m :: * -> *) a.
MonadFix m =>
(a -> SafeErrorToIOSimpleC exc m a) -> SafeErrorToIOSimpleC exc m a
$cp1MonadFix :: forall exc (m :: * -> *).
MonadFix m =>
Monad (SafeErrorToIOSimpleC exc m)
MonadFix, Monad (SafeErrorToIOSimpleC exc m)
Monad (SafeErrorToIOSimpleC exc m)
-> (forall a. String -> SafeErrorToIOSimpleC exc m a)
-> MonadFail (SafeErrorToIOSimpleC exc m)
String -> SafeErrorToIOSimpleC exc m a
forall a. String -> SafeErrorToIOSimpleC exc m a
forall exc (m :: * -> *).
MonadFail m =>
Monad (SafeErrorToIOSimpleC exc m)
forall exc (m :: * -> *) a.
MonadFail m =>
String -> SafeErrorToIOSimpleC exc m a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
fail :: String -> SafeErrorToIOSimpleC exc m a
$cfail :: forall exc (m :: * -> *) a.
MonadFail m =>
String -> SafeErrorToIOSimpleC exc m a
$cp1MonadFail :: forall exc (m :: * -> *).
MonadFail m =>
Monad (SafeErrorToIOSimpleC exc m)
MonadFail, Monad (SafeErrorToIOSimpleC exc m)
Monad (SafeErrorToIOSimpleC exc m)
-> (forall a. IO a -> SafeErrorToIOSimpleC exc m a)
-> MonadIO (SafeErrorToIOSimpleC exc m)
IO a -> SafeErrorToIOSimpleC exc m a
forall a. IO a -> SafeErrorToIOSimpleC exc m a
forall exc (m :: * -> *).
MonadIO m =>
Monad (SafeErrorToIOSimpleC exc m)
forall exc (m :: * -> *) a.
MonadIO m =>
IO a -> SafeErrorToIOSimpleC exc m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> SafeErrorToIOSimpleC exc m a
$cliftIO :: forall exc (m :: * -> *) a.
MonadIO m =>
IO a -> SafeErrorToIOSimpleC exc m a
$cp1MonadIO :: forall exc (m :: * -> *).
MonadIO m =>
Monad (SafeErrorToIOSimpleC exc m)
MonadIO
             , Monad (SafeErrorToIOSimpleC exc m)
e -> SafeErrorToIOSimpleC exc m a
Monad (SafeErrorToIOSimpleC exc m)
-> (forall e a. Exception e => e -> SafeErrorToIOSimpleC exc m a)
-> MonadThrow (SafeErrorToIOSimpleC exc m)
forall e a. Exception e => e -> SafeErrorToIOSimpleC exc m a
forall exc (m :: * -> *).
MonadThrow m =>
Monad (SafeErrorToIOSimpleC exc m)
forall exc (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> SafeErrorToIOSimpleC exc m a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: e -> SafeErrorToIOSimpleC exc m a
$cthrowM :: forall exc (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> SafeErrorToIOSimpleC exc m a
$cp1MonadThrow :: forall exc (m :: * -> *).
MonadThrow m =>
Monad (SafeErrorToIOSimpleC exc m)
MonadThrow, MonadThrow (SafeErrorToIOSimpleC exc m)
MonadThrow (SafeErrorToIOSimpleC exc m)
-> (forall e a.
    Exception e =>
    SafeErrorToIOSimpleC exc m a
    -> (e -> SafeErrorToIOSimpleC exc m a)
    -> SafeErrorToIOSimpleC exc m a)
-> MonadCatch (SafeErrorToIOSimpleC exc m)
SafeErrorToIOSimpleC exc m a
-> (e -> SafeErrorToIOSimpleC exc m a)
-> SafeErrorToIOSimpleC exc m a
forall e a.
Exception e =>
SafeErrorToIOSimpleC exc m a
-> (e -> SafeErrorToIOSimpleC exc m a)
-> SafeErrorToIOSimpleC exc m a
forall exc (m :: * -> *).
MonadCatch m =>
MonadThrow (SafeErrorToIOSimpleC exc m)
forall exc (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
SafeErrorToIOSimpleC exc m a
-> (e -> SafeErrorToIOSimpleC exc m a)
-> SafeErrorToIOSimpleC exc m a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
catch :: SafeErrorToIOSimpleC exc m a
-> (e -> SafeErrorToIOSimpleC exc m a)
-> SafeErrorToIOSimpleC exc m a
$ccatch :: forall exc (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
SafeErrorToIOSimpleC exc m a
-> (e -> SafeErrorToIOSimpleC exc m a)
-> SafeErrorToIOSimpleC exc m a
$cp1MonadCatch :: forall exc (m :: * -> *).
MonadCatch m =>
MonadThrow (SafeErrorToIOSimpleC exc m)
MonadCatch, MonadCatch (SafeErrorToIOSimpleC exc m)
MonadCatch (SafeErrorToIOSimpleC exc m)
-> (forall b.
    ((forall a.
      SafeErrorToIOSimpleC exc m a -> SafeErrorToIOSimpleC exc m a)
     -> SafeErrorToIOSimpleC exc m b)
    -> SafeErrorToIOSimpleC exc m b)
-> (forall b.
    ((forall a.
      SafeErrorToIOSimpleC exc m a -> SafeErrorToIOSimpleC exc m a)
     -> SafeErrorToIOSimpleC exc m b)
    -> SafeErrorToIOSimpleC exc m b)
-> (forall a b c.
    SafeErrorToIOSimpleC exc m a
    -> (a -> ExitCase b -> SafeErrorToIOSimpleC exc m c)
    -> (a -> SafeErrorToIOSimpleC exc m b)
    -> SafeErrorToIOSimpleC exc m (b, c))
-> MonadMask (SafeErrorToIOSimpleC exc m)
SafeErrorToIOSimpleC exc m a
-> (a -> ExitCase b -> SafeErrorToIOSimpleC exc m c)
-> (a -> SafeErrorToIOSimpleC exc m b)
-> SafeErrorToIOSimpleC exc m (b, c)
((forall a.
  SafeErrorToIOSimpleC exc m a -> SafeErrorToIOSimpleC exc m a)
 -> SafeErrorToIOSimpleC exc m b)
-> SafeErrorToIOSimpleC exc m b
((forall a.
  SafeErrorToIOSimpleC exc m a -> SafeErrorToIOSimpleC exc m a)
 -> SafeErrorToIOSimpleC exc m b)
-> SafeErrorToIOSimpleC exc m b
forall b.
((forall a.
  SafeErrorToIOSimpleC exc m a -> SafeErrorToIOSimpleC exc m a)
 -> SafeErrorToIOSimpleC exc m b)
-> SafeErrorToIOSimpleC exc m b
forall a b c.
SafeErrorToIOSimpleC exc m a
-> (a -> ExitCase b -> SafeErrorToIOSimpleC exc m c)
-> (a -> SafeErrorToIOSimpleC exc m b)
-> SafeErrorToIOSimpleC exc m (b, c)
forall exc (m :: * -> *).
MonadMask m =>
MonadCatch (SafeErrorToIOSimpleC exc m)
forall exc (m :: * -> *) b.
MonadMask m =>
((forall a.
  SafeErrorToIOSimpleC exc m a -> SafeErrorToIOSimpleC exc m a)
 -> SafeErrorToIOSimpleC exc m b)
-> SafeErrorToIOSimpleC exc m b
forall exc (m :: * -> *) a b c.
MonadMask m =>
SafeErrorToIOSimpleC exc m a
-> (a -> ExitCase b -> SafeErrorToIOSimpleC exc m c)
-> (a -> SafeErrorToIOSimpleC exc m b)
-> SafeErrorToIOSimpleC exc m (b, c)
forall (m :: * -> *).
MonadCatch m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
generalBracket :: SafeErrorToIOSimpleC exc m a
-> (a -> ExitCase b -> SafeErrorToIOSimpleC exc m c)
-> (a -> SafeErrorToIOSimpleC exc m b)
-> SafeErrorToIOSimpleC exc m (b, c)
$cgeneralBracket :: forall exc (m :: * -> *) a b c.
MonadMask m =>
SafeErrorToIOSimpleC exc m a
-> (a -> ExitCase b -> SafeErrorToIOSimpleC exc m c)
-> (a -> SafeErrorToIOSimpleC exc m b)
-> SafeErrorToIOSimpleC exc m (b, c)
uninterruptibleMask :: ((forall a.
  SafeErrorToIOSimpleC exc m a -> SafeErrorToIOSimpleC exc m a)
 -> SafeErrorToIOSimpleC exc m b)
-> SafeErrorToIOSimpleC exc m b
$cuninterruptibleMask :: forall exc (m :: * -> *) b.
MonadMask m =>
((forall a.
  SafeErrorToIOSimpleC exc m a -> SafeErrorToIOSimpleC exc m a)
 -> SafeErrorToIOSimpleC exc m b)
-> SafeErrorToIOSimpleC exc m b
mask :: ((forall a.
  SafeErrorToIOSimpleC exc m a -> SafeErrorToIOSimpleC exc m a)
 -> SafeErrorToIOSimpleC exc m b)
-> SafeErrorToIOSimpleC exc m b
$cmask :: forall exc (m :: * -> *) b.
MonadMask m =>
((forall a.
  SafeErrorToIOSimpleC exc m a -> SafeErrorToIOSimpleC exc m a)
 -> SafeErrorToIOSimpleC exc m b)
-> SafeErrorToIOSimpleC exc m b
$cp1MonadMask :: forall exc (m :: * -> *).
MonadMask m =>
MonadCatch (SafeErrorToIOSimpleC exc m)
MonadMask
             , MonadBase b, MonadBaseControl b
             )
    deriving m a -> SafeErrorToIOSimpleC exc m a
(forall (m :: * -> *) a.
 Monad m =>
 m a -> SafeErrorToIOSimpleC exc m a)
-> MonadTrans (SafeErrorToIOSimpleC exc)
forall exc (m :: * -> *) a.
Monad m =>
m a -> SafeErrorToIOSimpleC exc m a
forall (m :: * -> *) a.
Monad m =>
m a -> SafeErrorToIOSimpleC exc m a
forall (t :: Effect).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> SafeErrorToIOSimpleC exc m a
$clift :: forall exc (m :: * -> *) a.
Monad m =>
m a -> SafeErrorToIOSimpleC exc m a
MonadTrans
    via CompositionBaseT
     '[ IntroUnderC (SafeError exc) '[Catch exc, Throw exc]
      , SafeErrorToErrorC exc
      , ErrorToIOSimpleC exc
      ]

deriving instance ( Eff (Embed IO) m, MonadCatch m
                  , Threaders '[ReaderThreads] m p
                  )
               => Carrier (SafeErrorToIOSimpleC e m)


newtype SafeErrorToErrorIOSimpleC exc m a = SafeErrorToErrorIOSimpleC {
    SafeErrorToErrorIOSimpleC exc m a
-> IntroUnderC
     (SafeError exc)
     '[Catch exc, Throw exc]
     (SafeErrorToErrorC exc (InterpretErrorSimpleC exc m))
     a
unSafeErrorToErrorIOSimpleC ::
        IntroUnderC (SafeError exc) '[Catch exc, Throw exc]
      ( SafeErrorToErrorC exc
      ( InterpretErrorSimpleC exc
      ( m
      ))) a
  } deriving ( a
-> SafeErrorToErrorIOSimpleC exc m b
-> SafeErrorToErrorIOSimpleC exc m a
(a -> b)
-> SafeErrorToErrorIOSimpleC exc m a
-> SafeErrorToErrorIOSimpleC exc m b
(forall a b.
 (a -> b)
 -> SafeErrorToErrorIOSimpleC exc m a
 -> SafeErrorToErrorIOSimpleC exc m b)
-> (forall a b.
    a
    -> SafeErrorToErrorIOSimpleC exc m b
    -> SafeErrorToErrorIOSimpleC exc m a)
-> Functor (SafeErrorToErrorIOSimpleC exc m)
forall a b.
a
-> SafeErrorToErrorIOSimpleC exc m b
-> SafeErrorToErrorIOSimpleC exc m a
forall a b.
(a -> b)
-> SafeErrorToErrorIOSimpleC exc m a
-> SafeErrorToErrorIOSimpleC exc m b
forall exc (m :: * -> *) a b.
Functor m =>
a
-> SafeErrorToErrorIOSimpleC exc m b
-> SafeErrorToErrorIOSimpleC exc m a
forall exc (m :: * -> *) a b.
Functor m =>
(a -> b)
-> SafeErrorToErrorIOSimpleC exc m a
-> SafeErrorToErrorIOSimpleC exc m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a
-> SafeErrorToErrorIOSimpleC exc m b
-> SafeErrorToErrorIOSimpleC exc m a
$c<$ :: forall exc (m :: * -> *) a b.
Functor m =>
a
-> SafeErrorToErrorIOSimpleC exc m b
-> SafeErrorToErrorIOSimpleC exc m a
fmap :: (a -> b)
-> SafeErrorToErrorIOSimpleC exc m a
-> SafeErrorToErrorIOSimpleC exc m b
$cfmap :: forall exc (m :: * -> *) a b.
Functor m =>
(a -> b)
-> SafeErrorToErrorIOSimpleC exc m a
-> SafeErrorToErrorIOSimpleC exc m b
Functor, Functor (SafeErrorToErrorIOSimpleC exc m)
a -> SafeErrorToErrorIOSimpleC exc m a
Functor (SafeErrorToErrorIOSimpleC exc m)
-> (forall a. a -> SafeErrorToErrorIOSimpleC exc m a)
-> (forall a b.
    SafeErrorToErrorIOSimpleC exc m (a -> b)
    -> SafeErrorToErrorIOSimpleC exc m a
    -> SafeErrorToErrorIOSimpleC exc m b)
-> (forall a b c.
    (a -> b -> c)
    -> SafeErrorToErrorIOSimpleC exc m a
    -> SafeErrorToErrorIOSimpleC exc m b
    -> SafeErrorToErrorIOSimpleC exc m c)
-> (forall a b.
    SafeErrorToErrorIOSimpleC exc m a
    -> SafeErrorToErrorIOSimpleC exc m b
    -> SafeErrorToErrorIOSimpleC exc m b)
-> (forall a b.
    SafeErrorToErrorIOSimpleC exc m a
    -> SafeErrorToErrorIOSimpleC exc m b
    -> SafeErrorToErrorIOSimpleC exc m a)
-> Applicative (SafeErrorToErrorIOSimpleC exc m)
SafeErrorToErrorIOSimpleC exc m a
-> SafeErrorToErrorIOSimpleC exc m b
-> SafeErrorToErrorIOSimpleC exc m b
SafeErrorToErrorIOSimpleC exc m a
-> SafeErrorToErrorIOSimpleC exc m b
-> SafeErrorToErrorIOSimpleC exc m a
SafeErrorToErrorIOSimpleC exc m (a -> b)
-> SafeErrorToErrorIOSimpleC exc m a
-> SafeErrorToErrorIOSimpleC exc m b
(a -> b -> c)
-> SafeErrorToErrorIOSimpleC exc m a
-> SafeErrorToErrorIOSimpleC exc m b
-> SafeErrorToErrorIOSimpleC exc m c
forall a. a -> SafeErrorToErrorIOSimpleC exc m a
forall a b.
SafeErrorToErrorIOSimpleC exc m a
-> SafeErrorToErrorIOSimpleC exc m b
-> SafeErrorToErrorIOSimpleC exc m a
forall a b.
SafeErrorToErrorIOSimpleC exc m a
-> SafeErrorToErrorIOSimpleC exc m b
-> SafeErrorToErrorIOSimpleC exc m b
forall a b.
SafeErrorToErrorIOSimpleC exc m (a -> b)
-> SafeErrorToErrorIOSimpleC exc m a
-> SafeErrorToErrorIOSimpleC exc m b
forall a b c.
(a -> b -> c)
-> SafeErrorToErrorIOSimpleC exc m a
-> SafeErrorToErrorIOSimpleC exc m b
-> SafeErrorToErrorIOSimpleC exc m c
forall exc (m :: * -> *).
Applicative m =>
Functor (SafeErrorToErrorIOSimpleC exc m)
forall exc (m :: * -> *) a.
Applicative m =>
a -> SafeErrorToErrorIOSimpleC exc m a
forall exc (m :: * -> *) a b.
Applicative m =>
SafeErrorToErrorIOSimpleC exc m a
-> SafeErrorToErrorIOSimpleC exc m b
-> SafeErrorToErrorIOSimpleC exc m a
forall exc (m :: * -> *) a b.
Applicative m =>
SafeErrorToErrorIOSimpleC exc m a
-> SafeErrorToErrorIOSimpleC exc m b
-> SafeErrorToErrorIOSimpleC exc m b
forall exc (m :: * -> *) a b.
Applicative m =>
SafeErrorToErrorIOSimpleC exc m (a -> b)
-> SafeErrorToErrorIOSimpleC exc m a
-> SafeErrorToErrorIOSimpleC exc m b
forall exc (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> SafeErrorToErrorIOSimpleC exc m a
-> SafeErrorToErrorIOSimpleC exc m b
-> SafeErrorToErrorIOSimpleC exc m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: SafeErrorToErrorIOSimpleC exc m a
-> SafeErrorToErrorIOSimpleC exc m b
-> SafeErrorToErrorIOSimpleC exc m a
$c<* :: forall exc (m :: * -> *) a b.
Applicative m =>
SafeErrorToErrorIOSimpleC exc m a
-> SafeErrorToErrorIOSimpleC exc m b
-> SafeErrorToErrorIOSimpleC exc m a
*> :: SafeErrorToErrorIOSimpleC exc m a
-> SafeErrorToErrorIOSimpleC exc m b
-> SafeErrorToErrorIOSimpleC exc m b
$c*> :: forall exc (m :: * -> *) a b.
Applicative m =>
SafeErrorToErrorIOSimpleC exc m a
-> SafeErrorToErrorIOSimpleC exc m b
-> SafeErrorToErrorIOSimpleC exc m b
liftA2 :: (a -> b -> c)
-> SafeErrorToErrorIOSimpleC exc m a
-> SafeErrorToErrorIOSimpleC exc m b
-> SafeErrorToErrorIOSimpleC exc m c
$cliftA2 :: forall exc (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> SafeErrorToErrorIOSimpleC exc m a
-> SafeErrorToErrorIOSimpleC exc m b
-> SafeErrorToErrorIOSimpleC exc m c
<*> :: SafeErrorToErrorIOSimpleC exc m (a -> b)
-> SafeErrorToErrorIOSimpleC exc m a
-> SafeErrorToErrorIOSimpleC exc m b
$c<*> :: forall exc (m :: * -> *) a b.
Applicative m =>
SafeErrorToErrorIOSimpleC exc m (a -> b)
-> SafeErrorToErrorIOSimpleC exc m a
-> SafeErrorToErrorIOSimpleC exc m b
pure :: a -> SafeErrorToErrorIOSimpleC exc m a
$cpure :: forall exc (m :: * -> *) a.
Applicative m =>
a -> SafeErrorToErrorIOSimpleC exc m a
$cp1Applicative :: forall exc (m :: * -> *).
Applicative m =>
Functor (SafeErrorToErrorIOSimpleC exc m)
Applicative, Applicative (SafeErrorToErrorIOSimpleC exc m)
a -> SafeErrorToErrorIOSimpleC exc m a
Applicative (SafeErrorToErrorIOSimpleC exc m)
-> (forall a b.
    SafeErrorToErrorIOSimpleC exc m a
    -> (a -> SafeErrorToErrorIOSimpleC exc m b)
    -> SafeErrorToErrorIOSimpleC exc m b)
-> (forall a b.
    SafeErrorToErrorIOSimpleC exc m a
    -> SafeErrorToErrorIOSimpleC exc m b
    -> SafeErrorToErrorIOSimpleC exc m b)
-> (forall a. a -> SafeErrorToErrorIOSimpleC exc m a)
-> Monad (SafeErrorToErrorIOSimpleC exc m)
SafeErrorToErrorIOSimpleC exc m a
-> (a -> SafeErrorToErrorIOSimpleC exc m b)
-> SafeErrorToErrorIOSimpleC exc m b
SafeErrorToErrorIOSimpleC exc m a
-> SafeErrorToErrorIOSimpleC exc m b
-> SafeErrorToErrorIOSimpleC exc m b
forall a. a -> SafeErrorToErrorIOSimpleC exc m a
forall a b.
SafeErrorToErrorIOSimpleC exc m a
-> SafeErrorToErrorIOSimpleC exc m b
-> SafeErrorToErrorIOSimpleC exc m b
forall a b.
SafeErrorToErrorIOSimpleC exc m a
-> (a -> SafeErrorToErrorIOSimpleC exc m b)
-> SafeErrorToErrorIOSimpleC exc m b
forall exc (m :: * -> *).
Monad m =>
Applicative (SafeErrorToErrorIOSimpleC exc m)
forall exc (m :: * -> *) a.
Monad m =>
a -> SafeErrorToErrorIOSimpleC exc m a
forall exc (m :: * -> *) a b.
Monad m =>
SafeErrorToErrorIOSimpleC exc m a
-> SafeErrorToErrorIOSimpleC exc m b
-> SafeErrorToErrorIOSimpleC exc m b
forall exc (m :: * -> *) a b.
Monad m =>
SafeErrorToErrorIOSimpleC exc m a
-> (a -> SafeErrorToErrorIOSimpleC exc m b)
-> SafeErrorToErrorIOSimpleC exc m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> SafeErrorToErrorIOSimpleC exc m a
$creturn :: forall exc (m :: * -> *) a.
Monad m =>
a -> SafeErrorToErrorIOSimpleC exc m a
>> :: SafeErrorToErrorIOSimpleC exc m a
-> SafeErrorToErrorIOSimpleC exc m b
-> SafeErrorToErrorIOSimpleC exc m b
$c>> :: forall exc (m :: * -> *) a b.
Monad m =>
SafeErrorToErrorIOSimpleC exc m a
-> SafeErrorToErrorIOSimpleC exc m b
-> SafeErrorToErrorIOSimpleC exc m b
>>= :: SafeErrorToErrorIOSimpleC exc m a
-> (a -> SafeErrorToErrorIOSimpleC exc m b)
-> SafeErrorToErrorIOSimpleC exc m b
$c>>= :: forall exc (m :: * -> *) a b.
Monad m =>
SafeErrorToErrorIOSimpleC exc m a
-> (a -> SafeErrorToErrorIOSimpleC exc m b)
-> SafeErrorToErrorIOSimpleC exc m b
$cp1Monad :: forall exc (m :: * -> *).
Monad m =>
Applicative (SafeErrorToErrorIOSimpleC exc m)
Monad
             , Applicative (SafeErrorToErrorIOSimpleC exc m)
SafeErrorToErrorIOSimpleC exc m a
Applicative (SafeErrorToErrorIOSimpleC exc m)
-> (forall a. SafeErrorToErrorIOSimpleC exc m a)
-> (forall a.
    SafeErrorToErrorIOSimpleC exc m a
    -> SafeErrorToErrorIOSimpleC exc m a
    -> SafeErrorToErrorIOSimpleC exc m a)
-> (forall a.
    SafeErrorToErrorIOSimpleC exc m a
    -> SafeErrorToErrorIOSimpleC exc m [a])
-> (forall a.
    SafeErrorToErrorIOSimpleC exc m a
    -> SafeErrorToErrorIOSimpleC exc m [a])
-> Alternative (SafeErrorToErrorIOSimpleC exc m)
SafeErrorToErrorIOSimpleC exc m a
-> SafeErrorToErrorIOSimpleC exc m a
-> SafeErrorToErrorIOSimpleC exc m a
SafeErrorToErrorIOSimpleC exc m a
-> SafeErrorToErrorIOSimpleC exc m [a]
SafeErrorToErrorIOSimpleC exc m a
-> SafeErrorToErrorIOSimpleC exc m [a]
forall a. SafeErrorToErrorIOSimpleC exc m a
forall a.
SafeErrorToErrorIOSimpleC exc m a
-> SafeErrorToErrorIOSimpleC exc m [a]
forall a.
SafeErrorToErrorIOSimpleC exc m a
-> SafeErrorToErrorIOSimpleC exc m a
-> SafeErrorToErrorIOSimpleC exc m a
forall exc (m :: * -> *).
Alternative m =>
Applicative (SafeErrorToErrorIOSimpleC exc m)
forall exc (m :: * -> *) a.
Alternative m =>
SafeErrorToErrorIOSimpleC exc m a
forall exc (m :: * -> *) a.
Alternative m =>
SafeErrorToErrorIOSimpleC exc m a
-> SafeErrorToErrorIOSimpleC exc m [a]
forall exc (m :: * -> *) a.
Alternative m =>
SafeErrorToErrorIOSimpleC exc m a
-> SafeErrorToErrorIOSimpleC exc m a
-> SafeErrorToErrorIOSimpleC exc m a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
many :: SafeErrorToErrorIOSimpleC exc m a
-> SafeErrorToErrorIOSimpleC exc m [a]
$cmany :: forall exc (m :: * -> *) a.
Alternative m =>
SafeErrorToErrorIOSimpleC exc m a
-> SafeErrorToErrorIOSimpleC exc m [a]
some :: SafeErrorToErrorIOSimpleC exc m a
-> SafeErrorToErrorIOSimpleC exc m [a]
$csome :: forall exc (m :: * -> *) a.
Alternative m =>
SafeErrorToErrorIOSimpleC exc m a
-> SafeErrorToErrorIOSimpleC exc m [a]
<|> :: SafeErrorToErrorIOSimpleC exc m a
-> SafeErrorToErrorIOSimpleC exc m a
-> SafeErrorToErrorIOSimpleC exc m a
$c<|> :: forall exc (m :: * -> *) a.
Alternative m =>
SafeErrorToErrorIOSimpleC exc m a
-> SafeErrorToErrorIOSimpleC exc m a
-> SafeErrorToErrorIOSimpleC exc m a
empty :: SafeErrorToErrorIOSimpleC exc m a
$cempty :: forall exc (m :: * -> *) a.
Alternative m =>
SafeErrorToErrorIOSimpleC exc m a
$cp1Alternative :: forall exc (m :: * -> *).
Alternative m =>
Applicative (SafeErrorToErrorIOSimpleC exc m)
Alternative, Monad (SafeErrorToErrorIOSimpleC exc m)
Alternative (SafeErrorToErrorIOSimpleC exc m)
SafeErrorToErrorIOSimpleC exc m a
Alternative (SafeErrorToErrorIOSimpleC exc m)
-> Monad (SafeErrorToErrorIOSimpleC exc m)
-> (forall a. SafeErrorToErrorIOSimpleC exc m a)
-> (forall a.
    SafeErrorToErrorIOSimpleC exc m a
    -> SafeErrorToErrorIOSimpleC exc m a
    -> SafeErrorToErrorIOSimpleC exc m a)
-> MonadPlus (SafeErrorToErrorIOSimpleC exc m)
SafeErrorToErrorIOSimpleC exc m a
-> SafeErrorToErrorIOSimpleC exc m a
-> SafeErrorToErrorIOSimpleC exc m a
forall a. SafeErrorToErrorIOSimpleC exc m a
forall a.
SafeErrorToErrorIOSimpleC exc m a
-> SafeErrorToErrorIOSimpleC exc m a
-> SafeErrorToErrorIOSimpleC exc m a
forall exc (m :: * -> *).
MonadPlus m =>
Monad (SafeErrorToErrorIOSimpleC exc m)
forall exc (m :: * -> *).
MonadPlus m =>
Alternative (SafeErrorToErrorIOSimpleC exc m)
forall exc (m :: * -> *) a.
MonadPlus m =>
SafeErrorToErrorIOSimpleC exc m a
forall exc (m :: * -> *) a.
MonadPlus m =>
SafeErrorToErrorIOSimpleC exc m a
-> SafeErrorToErrorIOSimpleC exc m a
-> SafeErrorToErrorIOSimpleC exc m a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
mplus :: SafeErrorToErrorIOSimpleC exc m a
-> SafeErrorToErrorIOSimpleC exc m a
-> SafeErrorToErrorIOSimpleC exc m a
$cmplus :: forall exc (m :: * -> *) a.
MonadPlus m =>
SafeErrorToErrorIOSimpleC exc m a
-> SafeErrorToErrorIOSimpleC exc m a
-> SafeErrorToErrorIOSimpleC exc m a
mzero :: SafeErrorToErrorIOSimpleC exc m a
$cmzero :: forall exc (m :: * -> *) a.
MonadPlus m =>
SafeErrorToErrorIOSimpleC exc m a
$cp2MonadPlus :: forall exc (m :: * -> *).
MonadPlus m =>
Monad (SafeErrorToErrorIOSimpleC exc m)
$cp1MonadPlus :: forall exc (m :: * -> *).
MonadPlus m =>
Alternative (SafeErrorToErrorIOSimpleC exc m)
MonadPlus
             , Monad (SafeErrorToErrorIOSimpleC exc m)
Monad (SafeErrorToErrorIOSimpleC exc m)
-> (forall a.
    (a -> SafeErrorToErrorIOSimpleC exc m a)
    -> SafeErrorToErrorIOSimpleC exc m a)
-> MonadFix (SafeErrorToErrorIOSimpleC exc m)
(a -> SafeErrorToErrorIOSimpleC exc m a)
-> SafeErrorToErrorIOSimpleC exc m a
forall a.
(a -> SafeErrorToErrorIOSimpleC exc m a)
-> SafeErrorToErrorIOSimpleC exc m a
forall exc (m :: * -> *).
MonadFix m =>
Monad (SafeErrorToErrorIOSimpleC exc m)
forall exc (m :: * -> *) a.
MonadFix m =>
(a -> SafeErrorToErrorIOSimpleC exc m a)
-> SafeErrorToErrorIOSimpleC exc m a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
mfix :: (a -> SafeErrorToErrorIOSimpleC exc m a)
-> SafeErrorToErrorIOSimpleC exc m a
$cmfix :: forall exc (m :: * -> *) a.
MonadFix m =>
(a -> SafeErrorToErrorIOSimpleC exc m a)
-> SafeErrorToErrorIOSimpleC exc m a
$cp1MonadFix :: forall exc (m :: * -> *).
MonadFix m =>
Monad (SafeErrorToErrorIOSimpleC exc m)
MonadFix, Monad (SafeErrorToErrorIOSimpleC exc m)
Monad (SafeErrorToErrorIOSimpleC exc m)
-> (forall a. String -> SafeErrorToErrorIOSimpleC exc m a)
-> MonadFail (SafeErrorToErrorIOSimpleC exc m)
String -> SafeErrorToErrorIOSimpleC exc m a
forall a. String -> SafeErrorToErrorIOSimpleC exc m a
forall exc (m :: * -> *).
MonadFail m =>
Monad (SafeErrorToErrorIOSimpleC exc m)
forall exc (m :: * -> *) a.
MonadFail m =>
String -> SafeErrorToErrorIOSimpleC exc m a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
fail :: String -> SafeErrorToErrorIOSimpleC exc m a
$cfail :: forall exc (m :: * -> *) a.
MonadFail m =>
String -> SafeErrorToErrorIOSimpleC exc m a
$cp1MonadFail :: forall exc (m :: * -> *).
MonadFail m =>
Monad (SafeErrorToErrorIOSimpleC exc m)
MonadFail, Monad (SafeErrorToErrorIOSimpleC exc m)
Monad (SafeErrorToErrorIOSimpleC exc m)
-> (forall a. IO a -> SafeErrorToErrorIOSimpleC exc m a)
-> MonadIO (SafeErrorToErrorIOSimpleC exc m)
IO a -> SafeErrorToErrorIOSimpleC exc m a
forall a. IO a -> SafeErrorToErrorIOSimpleC exc m a
forall exc (m :: * -> *).
MonadIO m =>
Monad (SafeErrorToErrorIOSimpleC exc m)
forall exc (m :: * -> *) a.
MonadIO m =>
IO a -> SafeErrorToErrorIOSimpleC exc m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> SafeErrorToErrorIOSimpleC exc m a
$cliftIO :: forall exc (m :: * -> *) a.
MonadIO m =>
IO a -> SafeErrorToErrorIOSimpleC exc m a
$cp1MonadIO :: forall exc (m :: * -> *).
MonadIO m =>
Monad (SafeErrorToErrorIOSimpleC exc m)
MonadIO
             , Monad (SafeErrorToErrorIOSimpleC exc m)
e -> SafeErrorToErrorIOSimpleC exc m a
Monad (SafeErrorToErrorIOSimpleC exc m)
-> (forall e a.
    Exception e =>
    e -> SafeErrorToErrorIOSimpleC exc m a)
-> MonadThrow (SafeErrorToErrorIOSimpleC exc m)
forall e a. Exception e => e -> SafeErrorToErrorIOSimpleC exc m a
forall exc (m :: * -> *).
MonadThrow m =>
Monad (SafeErrorToErrorIOSimpleC exc m)
forall exc (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> SafeErrorToErrorIOSimpleC exc m a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: e -> SafeErrorToErrorIOSimpleC exc m a
$cthrowM :: forall exc (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> SafeErrorToErrorIOSimpleC exc m a
$cp1MonadThrow :: forall exc (m :: * -> *).
MonadThrow m =>
Monad (SafeErrorToErrorIOSimpleC exc m)
MonadThrow, MonadThrow (SafeErrorToErrorIOSimpleC exc m)
MonadThrow (SafeErrorToErrorIOSimpleC exc m)
-> (forall e a.
    Exception e =>
    SafeErrorToErrorIOSimpleC exc m a
    -> (e -> SafeErrorToErrorIOSimpleC exc m a)
    -> SafeErrorToErrorIOSimpleC exc m a)
-> MonadCatch (SafeErrorToErrorIOSimpleC exc m)
SafeErrorToErrorIOSimpleC exc m a
-> (e -> SafeErrorToErrorIOSimpleC exc m a)
-> SafeErrorToErrorIOSimpleC exc m a
forall e a.
Exception e =>
SafeErrorToErrorIOSimpleC exc m a
-> (e -> SafeErrorToErrorIOSimpleC exc m a)
-> SafeErrorToErrorIOSimpleC exc m a
forall exc (m :: * -> *).
MonadCatch m =>
MonadThrow (SafeErrorToErrorIOSimpleC exc m)
forall exc (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
SafeErrorToErrorIOSimpleC exc m a
-> (e -> SafeErrorToErrorIOSimpleC exc m a)
-> SafeErrorToErrorIOSimpleC exc m a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
catch :: SafeErrorToErrorIOSimpleC exc m a
-> (e -> SafeErrorToErrorIOSimpleC exc m a)
-> SafeErrorToErrorIOSimpleC exc m a
$ccatch :: forall exc (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
SafeErrorToErrorIOSimpleC exc m a
-> (e -> SafeErrorToErrorIOSimpleC exc m a)
-> SafeErrorToErrorIOSimpleC exc m a
$cp1MonadCatch :: forall exc (m :: * -> *).
MonadCatch m =>
MonadThrow (SafeErrorToErrorIOSimpleC exc m)
MonadCatch, MonadCatch (SafeErrorToErrorIOSimpleC exc m)
MonadCatch (SafeErrorToErrorIOSimpleC exc m)
-> (forall b.
    ((forall a.
      SafeErrorToErrorIOSimpleC exc m a
      -> SafeErrorToErrorIOSimpleC exc m a)
     -> SafeErrorToErrorIOSimpleC exc m b)
    -> SafeErrorToErrorIOSimpleC exc m b)
-> (forall b.
    ((forall a.
      SafeErrorToErrorIOSimpleC exc m a
      -> SafeErrorToErrorIOSimpleC exc m a)
     -> SafeErrorToErrorIOSimpleC exc m b)
    -> SafeErrorToErrorIOSimpleC exc m b)
-> (forall a b c.
    SafeErrorToErrorIOSimpleC exc m a
    -> (a -> ExitCase b -> SafeErrorToErrorIOSimpleC exc m c)
    -> (a -> SafeErrorToErrorIOSimpleC exc m b)
    -> SafeErrorToErrorIOSimpleC exc m (b, c))
-> MonadMask (SafeErrorToErrorIOSimpleC exc m)
SafeErrorToErrorIOSimpleC exc m a
-> (a -> ExitCase b -> SafeErrorToErrorIOSimpleC exc m c)
-> (a -> SafeErrorToErrorIOSimpleC exc m b)
-> SafeErrorToErrorIOSimpleC exc m (b, c)
((forall a.
  SafeErrorToErrorIOSimpleC exc m a
  -> SafeErrorToErrorIOSimpleC exc m a)
 -> SafeErrorToErrorIOSimpleC exc m b)
-> SafeErrorToErrorIOSimpleC exc m b
((forall a.
  SafeErrorToErrorIOSimpleC exc m a
  -> SafeErrorToErrorIOSimpleC exc m a)
 -> SafeErrorToErrorIOSimpleC exc m b)
-> SafeErrorToErrorIOSimpleC exc m b
forall b.
((forall a.
  SafeErrorToErrorIOSimpleC exc m a
  -> SafeErrorToErrorIOSimpleC exc m a)
 -> SafeErrorToErrorIOSimpleC exc m b)
-> SafeErrorToErrorIOSimpleC exc m b
forall a b c.
SafeErrorToErrorIOSimpleC exc m a
-> (a -> ExitCase b -> SafeErrorToErrorIOSimpleC exc m c)
-> (a -> SafeErrorToErrorIOSimpleC exc m b)
-> SafeErrorToErrorIOSimpleC exc m (b, c)
forall exc (m :: * -> *).
MonadMask m =>
MonadCatch (SafeErrorToErrorIOSimpleC exc m)
forall exc (m :: * -> *) b.
MonadMask m =>
((forall a.
  SafeErrorToErrorIOSimpleC exc m a
  -> SafeErrorToErrorIOSimpleC exc m a)
 -> SafeErrorToErrorIOSimpleC exc m b)
-> SafeErrorToErrorIOSimpleC exc m b
forall exc (m :: * -> *) a b c.
MonadMask m =>
SafeErrorToErrorIOSimpleC exc m a
-> (a -> ExitCase b -> SafeErrorToErrorIOSimpleC exc m c)
-> (a -> SafeErrorToErrorIOSimpleC exc m b)
-> SafeErrorToErrorIOSimpleC exc m (b, c)
forall (m :: * -> *).
MonadCatch m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
generalBracket :: SafeErrorToErrorIOSimpleC exc m a
-> (a -> ExitCase b -> SafeErrorToErrorIOSimpleC exc m c)
-> (a -> SafeErrorToErrorIOSimpleC exc m b)
-> SafeErrorToErrorIOSimpleC exc m (b, c)
$cgeneralBracket :: forall exc (m :: * -> *) a b c.
MonadMask m =>
SafeErrorToErrorIOSimpleC exc m a
-> (a -> ExitCase b -> SafeErrorToErrorIOSimpleC exc m c)
-> (a -> SafeErrorToErrorIOSimpleC exc m b)
-> SafeErrorToErrorIOSimpleC exc m (b, c)
uninterruptibleMask :: ((forall a.
  SafeErrorToErrorIOSimpleC exc m a
  -> SafeErrorToErrorIOSimpleC exc m a)
 -> SafeErrorToErrorIOSimpleC exc m b)
-> SafeErrorToErrorIOSimpleC exc m b
$cuninterruptibleMask :: forall exc (m :: * -> *) b.
MonadMask m =>
((forall a.
  SafeErrorToErrorIOSimpleC exc m a
  -> SafeErrorToErrorIOSimpleC exc m a)
 -> SafeErrorToErrorIOSimpleC exc m b)
-> SafeErrorToErrorIOSimpleC exc m b
mask :: ((forall a.
  SafeErrorToErrorIOSimpleC exc m a
  -> SafeErrorToErrorIOSimpleC exc m a)
 -> SafeErrorToErrorIOSimpleC exc m b)
-> SafeErrorToErrorIOSimpleC exc m b
$cmask :: forall exc (m :: * -> *) b.
MonadMask m =>
((forall a.
  SafeErrorToErrorIOSimpleC exc m a
  -> SafeErrorToErrorIOSimpleC exc m a)
 -> SafeErrorToErrorIOSimpleC exc m b)
-> SafeErrorToErrorIOSimpleC exc m b
$cp1MonadMask :: forall exc (m :: * -> *).
MonadMask m =>
MonadCatch (SafeErrorToErrorIOSimpleC exc m)
MonadMask
             , MonadBase b, MonadBaseControl b
             )
    deriving m a -> SafeErrorToErrorIOSimpleC exc m a
(forall (m :: * -> *) a.
 Monad m =>
 m a -> SafeErrorToErrorIOSimpleC exc m a)
-> MonadTrans (SafeErrorToErrorIOSimpleC exc)
forall exc (m :: * -> *) a.
Monad m =>
m a -> SafeErrorToErrorIOSimpleC exc m a
forall (m :: * -> *) a.
Monad m =>
m a -> SafeErrorToErrorIOSimpleC exc m a
forall (t :: Effect).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> SafeErrorToErrorIOSimpleC exc m a
$clift :: forall exc (m :: * -> *) a.
Monad m =>
m a -> SafeErrorToErrorIOSimpleC exc m a
MonadTrans
    via CompositionBaseT
     '[ IntroUnderC (SafeError exc) '[Catch exc, Throw exc]
      , SafeErrorToErrorC exc
      , InterpretErrorSimpleC exc
      ]

deriving instance (Carrier m , Threaders '[ReaderThreads] m p)
               => Carrier (SafeErrorToErrorIOSimpleC e m)