{-# OPTIONS_HADDOCK not-home #-}
{-# LANGUAGE BlockArguments, DerivingVia #-}
module Control.Effect.Internal.Error where
import Data.Coerce
import Control.Applicative
import Control.Monad
import Control.Effect
import Control.Effect.ErrorIO
import Control.Effect.Type.Throw
import Control.Effect.Type.Catch
import Control.Effect.Optional
import Control.Effect.Carrier
import Control.Monad.Trans.Except
import qualified Control.Exception as X
import qualified Control.Monad.Catch as C
import Control.Effect.Carrier.Internal.Interpret
import Control.Effect.Carrier.Internal.Intro
import Control.Effect.Carrier.Internal.Compose
import Control.Effect.Internal.ErrorIO
import Control.Effect.Internal.Utils
import Data.Unique
import GHC.Exts (Any)
import Unsafe.Coerce
newtype ThrowC e m a = ThrowC { ThrowC e m a -> ExceptT e m a
unThrowC :: ExceptT e m a }
deriving ( a -> ThrowC e m b -> ThrowC e m a
(a -> b) -> ThrowC e m a -> ThrowC e m b
(forall a b. (a -> b) -> ThrowC e m a -> ThrowC e m b)
-> (forall a b. a -> ThrowC e m b -> ThrowC e m a)
-> Functor (ThrowC e m)
forall a b. a -> ThrowC e m b -> ThrowC e m a
forall a b. (a -> b) -> ThrowC e m a -> ThrowC e m b
forall e (m :: * -> *) a b.
Functor m =>
a -> ThrowC e m b -> ThrowC e m a
forall e (m :: * -> *) a b.
Functor m =>
(a -> b) -> ThrowC e m a -> ThrowC e m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ThrowC e m b -> ThrowC e m a
$c<$ :: forall e (m :: * -> *) a b.
Functor m =>
a -> ThrowC e m b -> ThrowC e m a
fmap :: (a -> b) -> ThrowC e m a -> ThrowC e m b
$cfmap :: forall e (m :: * -> *) a b.
Functor m =>
(a -> b) -> ThrowC e m a -> ThrowC e m b
Functor, Functor (ThrowC e m)
a -> ThrowC e m a
Functor (ThrowC e m)
-> (forall a. a -> ThrowC e m a)
-> (forall a b.
ThrowC e m (a -> b) -> ThrowC e m a -> ThrowC e m b)
-> (forall a b c.
(a -> b -> c) -> ThrowC e m a -> ThrowC e m b -> ThrowC e m c)
-> (forall a b. ThrowC e m a -> ThrowC e m b -> ThrowC e m b)
-> (forall a b. ThrowC e m a -> ThrowC e m b -> ThrowC e m a)
-> Applicative (ThrowC e m)
ThrowC e m a -> ThrowC e m b -> ThrowC e m b
ThrowC e m a -> ThrowC e m b -> ThrowC e m a
ThrowC e m (a -> b) -> ThrowC e m a -> ThrowC e m b
(a -> b -> c) -> ThrowC e m a -> ThrowC e m b -> ThrowC e m c
forall a. a -> ThrowC e m a
forall a b. ThrowC e m a -> ThrowC e m b -> ThrowC e m a
forall a b. ThrowC e m a -> ThrowC e m b -> ThrowC e m b
forall a b. ThrowC e m (a -> b) -> ThrowC e m a -> ThrowC e m b
forall a b c.
(a -> b -> c) -> ThrowC e m a -> ThrowC e m b -> ThrowC e m c
forall e (m :: * -> *). Monad m => Functor (ThrowC e m)
forall e (m :: * -> *) a. Monad m => a -> ThrowC e m a
forall e (m :: * -> *) a b.
Monad m =>
ThrowC e m a -> ThrowC e m b -> ThrowC e m a
forall e (m :: * -> *) a b.
Monad m =>
ThrowC e m a -> ThrowC e m b -> ThrowC e m b
forall e (m :: * -> *) a b.
Monad m =>
ThrowC e m (a -> b) -> ThrowC e m a -> ThrowC e m b
forall e (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> ThrowC e m a -> ThrowC e m b -> ThrowC e 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
<* :: ThrowC e m a -> ThrowC e m b -> ThrowC e m a
$c<* :: forall e (m :: * -> *) a b.
Monad m =>
ThrowC e m a -> ThrowC e m b -> ThrowC e m a
*> :: ThrowC e m a -> ThrowC e m b -> ThrowC e m b
$c*> :: forall e (m :: * -> *) a b.
Monad m =>
ThrowC e m a -> ThrowC e m b -> ThrowC e m b
liftA2 :: (a -> b -> c) -> ThrowC e m a -> ThrowC e m b -> ThrowC e m c
$cliftA2 :: forall e (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> ThrowC e m a -> ThrowC e m b -> ThrowC e m c
<*> :: ThrowC e m (a -> b) -> ThrowC e m a -> ThrowC e m b
$c<*> :: forall e (m :: * -> *) a b.
Monad m =>
ThrowC e m (a -> b) -> ThrowC e m a -> ThrowC e m b
pure :: a -> ThrowC e m a
$cpure :: forall e (m :: * -> *) a. Monad m => a -> ThrowC e m a
$cp1Applicative :: forall e (m :: * -> *). Monad m => Functor (ThrowC e m)
Applicative, Applicative (ThrowC e m)
a -> ThrowC e m a
Applicative (ThrowC e m)
-> (forall a b.
ThrowC e m a -> (a -> ThrowC e m b) -> ThrowC e m b)
-> (forall a b. ThrowC e m a -> ThrowC e m b -> ThrowC e m b)
-> (forall a. a -> ThrowC e m a)
-> Monad (ThrowC e m)
ThrowC e m a -> (a -> ThrowC e m b) -> ThrowC e m b
ThrowC e m a -> ThrowC e m b -> ThrowC e m b
forall a. a -> ThrowC e m a
forall a b. ThrowC e m a -> ThrowC e m b -> ThrowC e m b
forall a b. ThrowC e m a -> (a -> ThrowC e m b) -> ThrowC e m b
forall e (m :: * -> *). Monad m => Applicative (ThrowC e m)
forall e (m :: * -> *) a. Monad m => a -> ThrowC e m a
forall e (m :: * -> *) a b.
Monad m =>
ThrowC e m a -> ThrowC e m b -> ThrowC e m b
forall e (m :: * -> *) a b.
Monad m =>
ThrowC e m a -> (a -> ThrowC e m b) -> ThrowC e 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 -> ThrowC e m a
$creturn :: forall e (m :: * -> *) a. Monad m => a -> ThrowC e m a
>> :: ThrowC e m a -> ThrowC e m b -> ThrowC e m b
$c>> :: forall e (m :: * -> *) a b.
Monad m =>
ThrowC e m a -> ThrowC e m b -> ThrowC e m b
>>= :: ThrowC e m a -> (a -> ThrowC e m b) -> ThrowC e m b
$c>>= :: forall e (m :: * -> *) a b.
Monad m =>
ThrowC e m a -> (a -> ThrowC e m b) -> ThrowC e m b
$cp1Monad :: forall e (m :: * -> *). Monad m => Applicative (ThrowC e m)
Monad
, Applicative (ThrowC e m)
ThrowC e m a
Applicative (ThrowC e m)
-> (forall a. ThrowC e m a)
-> (forall a. ThrowC e m a -> ThrowC e m a -> ThrowC e m a)
-> (forall a. ThrowC e m a -> ThrowC e m [a])
-> (forall a. ThrowC e m a -> ThrowC e m [a])
-> Alternative (ThrowC e m)
ThrowC e m a -> ThrowC e m a -> ThrowC e m a
ThrowC e m a -> ThrowC e m [a]
ThrowC e m a -> ThrowC e m [a]
forall a. ThrowC e m a
forall a. ThrowC e m a -> ThrowC e m [a]
forall a. ThrowC e m a -> ThrowC e m a -> ThrowC e m a
forall e (m :: * -> *).
(Monad m, Monoid e) =>
Applicative (ThrowC e m)
forall e (m :: * -> *) a. (Monad m, Monoid e) => ThrowC e m a
forall e (m :: * -> *) a.
(Monad m, Monoid e) =>
ThrowC e m a -> ThrowC e m [a]
forall e (m :: * -> *) a.
(Monad m, Monoid e) =>
ThrowC e m a -> ThrowC e m a -> ThrowC e 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 :: ThrowC e m a -> ThrowC e m [a]
$cmany :: forall e (m :: * -> *) a.
(Monad m, Monoid e) =>
ThrowC e m a -> ThrowC e m [a]
some :: ThrowC e m a -> ThrowC e m [a]
$csome :: forall e (m :: * -> *) a.
(Monad m, Monoid e) =>
ThrowC e m a -> ThrowC e m [a]
<|> :: ThrowC e m a -> ThrowC e m a -> ThrowC e m a
$c<|> :: forall e (m :: * -> *) a.
(Monad m, Monoid e) =>
ThrowC e m a -> ThrowC e m a -> ThrowC e m a
empty :: ThrowC e m a
$cempty :: forall e (m :: * -> *) a. (Monad m, Monoid e) => ThrowC e m a
$cp1Alternative :: forall e (m :: * -> *).
(Monad m, Monoid e) =>
Applicative (ThrowC e m)
Alternative, Monad (ThrowC e m)
Alternative (ThrowC e m)
ThrowC e m a
Alternative (ThrowC e m)
-> Monad (ThrowC e m)
-> (forall a. ThrowC e m a)
-> (forall a. ThrowC e m a -> ThrowC e m a -> ThrowC e m a)
-> MonadPlus (ThrowC e m)
ThrowC e m a -> ThrowC e m a -> ThrowC e m a
forall a. ThrowC e m a
forall a. ThrowC e m a -> ThrowC e m a -> ThrowC e m a
forall e (m :: * -> *). (Monad m, Monoid e) => Monad (ThrowC e m)
forall e (m :: * -> *).
(Monad m, Monoid e) =>
Alternative (ThrowC e m)
forall e (m :: * -> *) a. (Monad m, Monoid e) => ThrowC e m a
forall e (m :: * -> *) a.
(Monad m, Monoid e) =>
ThrowC e m a -> ThrowC e m a -> ThrowC e m a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
mplus :: ThrowC e m a -> ThrowC e m a -> ThrowC e m a
$cmplus :: forall e (m :: * -> *) a.
(Monad m, Monoid e) =>
ThrowC e m a -> ThrowC e m a -> ThrowC e m a
mzero :: ThrowC e m a
$cmzero :: forall e (m :: * -> *) a. (Monad m, Monoid e) => ThrowC e m a
$cp2MonadPlus :: forall e (m :: * -> *). (Monad m, Monoid e) => Monad (ThrowC e m)
$cp1MonadPlus :: forall e (m :: * -> *).
(Monad m, Monoid e) =>
Alternative (ThrowC e m)
MonadPlus
, Monad (ThrowC e m)
Monad (ThrowC e m)
-> (forall a. (a -> ThrowC e m a) -> ThrowC e m a)
-> MonadFix (ThrowC e m)
(a -> ThrowC e m a) -> ThrowC e m a
forall a. (a -> ThrowC e m a) -> ThrowC e m a
forall e (m :: * -> *). MonadFix m => Monad (ThrowC e m)
forall e (m :: * -> *) a.
MonadFix m =>
(a -> ThrowC e m a) -> ThrowC e m a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
mfix :: (a -> ThrowC e m a) -> ThrowC e m a
$cmfix :: forall e (m :: * -> *) a.
MonadFix m =>
(a -> ThrowC e m a) -> ThrowC e m a
$cp1MonadFix :: forall e (m :: * -> *). MonadFix m => Monad (ThrowC e m)
MonadFix, Monad (ThrowC e m)
Monad (ThrowC e m)
-> (forall a. String -> ThrowC e m a) -> MonadFail (ThrowC e m)
String -> ThrowC e m a
forall a. String -> ThrowC e m a
forall e (m :: * -> *). MonadFail m => Monad (ThrowC e m)
forall e (m :: * -> *) a. MonadFail m => String -> ThrowC e m a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
fail :: String -> ThrowC e m a
$cfail :: forall e (m :: * -> *) a. MonadFail m => String -> ThrowC e m a
$cp1MonadFail :: forall e (m :: * -> *). MonadFail m => Monad (ThrowC e m)
MonadFail, Monad (ThrowC e m)
Monad (ThrowC e m)
-> (forall a. IO a -> ThrowC e m a) -> MonadIO (ThrowC e m)
IO a -> ThrowC e m a
forall a. IO a -> ThrowC e m a
forall e (m :: * -> *). MonadIO m => Monad (ThrowC e m)
forall e (m :: * -> *) a. MonadIO m => IO a -> ThrowC e m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> ThrowC e m a
$cliftIO :: forall e (m :: * -> *) a. MonadIO m => IO a -> ThrowC e m a
$cp1MonadIO :: forall e (m :: * -> *). MonadIO m => Monad (ThrowC e m)
MonadIO
, Monad (ThrowC e m)
e -> ThrowC e m a
Monad (ThrowC e m)
-> (forall e a. Exception e => e -> ThrowC e m a)
-> MonadThrow (ThrowC e m)
forall e a. Exception e => e -> ThrowC e m a
forall e (m :: * -> *). MonadThrow m => Monad (ThrowC e m)
forall e (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> ThrowC e m a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: e -> ThrowC e m a
$cthrowM :: forall e (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> ThrowC e m a
$cp1MonadThrow :: forall e (m :: * -> *). MonadThrow m => Monad (ThrowC e m)
MonadThrow, MonadThrow (ThrowC e m)
MonadThrow (ThrowC e m)
-> (forall e a.
Exception e =>
ThrowC e m a -> (e -> ThrowC e m a) -> ThrowC e m a)
-> MonadCatch (ThrowC e m)
ThrowC e m a -> (e -> ThrowC e m a) -> ThrowC e m a
forall e a.
Exception e =>
ThrowC e m a -> (e -> ThrowC e m a) -> ThrowC e m a
forall e (m :: * -> *). MonadCatch m => MonadThrow (ThrowC e m)
forall e (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
ThrowC e m a -> (e -> ThrowC e m a) -> ThrowC e m a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
catch :: ThrowC e m a -> (e -> ThrowC e m a) -> ThrowC e m a
$ccatch :: forall e (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
ThrowC e m a -> (e -> ThrowC e m a) -> ThrowC e m a
$cp1MonadCatch :: forall e (m :: * -> *). MonadCatch m => MonadThrow (ThrowC e m)
MonadCatch, MonadCatch (ThrowC e m)
MonadCatch (ThrowC e m)
-> (forall b.
((forall a. ThrowC e m a -> ThrowC e m a) -> ThrowC e m b)
-> ThrowC e m b)
-> (forall b.
((forall a. ThrowC e m a -> ThrowC e m a) -> ThrowC e m b)
-> ThrowC e m b)
-> (forall a b c.
ThrowC e m a
-> (a -> ExitCase b -> ThrowC e m c)
-> (a -> ThrowC e m b)
-> ThrowC e m (b, c))
-> MonadMask (ThrowC e m)
ThrowC e m a
-> (a -> ExitCase b -> ThrowC e m c)
-> (a -> ThrowC e m b)
-> ThrowC e m (b, c)
((forall a. ThrowC e m a -> ThrowC e m a) -> ThrowC e m b)
-> ThrowC e m b
((forall a. ThrowC e m a -> ThrowC e m a) -> ThrowC e m b)
-> ThrowC e m b
forall b.
((forall a. ThrowC e m a -> ThrowC e m a) -> ThrowC e m b)
-> ThrowC e m b
forall a b c.
ThrowC e m a
-> (a -> ExitCase b -> ThrowC e m c)
-> (a -> ThrowC e m b)
-> ThrowC e m (b, c)
forall e (m :: * -> *). MonadMask m => MonadCatch (ThrowC e m)
forall e (m :: * -> *) b.
MonadMask m =>
((forall a. ThrowC e m a -> ThrowC e m a) -> ThrowC e m b)
-> ThrowC e m b
forall e (m :: * -> *) a b c.
MonadMask m =>
ThrowC e m a
-> (a -> ExitCase b -> ThrowC e m c)
-> (a -> ThrowC e m b)
-> ThrowC e 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 :: ThrowC e m a
-> (a -> ExitCase b -> ThrowC e m c)
-> (a -> ThrowC e m b)
-> ThrowC e m (b, c)
$cgeneralBracket :: forall e (m :: * -> *) a b c.
MonadMask m =>
ThrowC e m a
-> (a -> ExitCase b -> ThrowC e m c)
-> (a -> ThrowC e m b)
-> ThrowC e m (b, c)
uninterruptibleMask :: ((forall a. ThrowC e m a -> ThrowC e m a) -> ThrowC e m b)
-> ThrowC e m b
$cuninterruptibleMask :: forall e (m :: * -> *) b.
MonadMask m =>
((forall a. ThrowC e m a -> ThrowC e m a) -> ThrowC e m b)
-> ThrowC e m b
mask :: ((forall a. ThrowC e m a -> ThrowC e m a) -> ThrowC e m b)
-> ThrowC e m b
$cmask :: forall e (m :: * -> *) b.
MonadMask m =>
((forall a. ThrowC e m a -> ThrowC e m a) -> ThrowC e m b)
-> ThrowC e m b
$cp1MonadMask :: forall e (m :: * -> *). MonadMask m => MonadCatch (ThrowC e m)
MonadMask
, MonadBase b, MonadBaseControl b
)
deriving (m a -> ThrowC e m a
(forall (m :: * -> *) a. Monad m => m a -> ThrowC e m a)
-> MonadTrans (ThrowC e)
forall e (m :: * -> *) a. Monad m => m a -> ThrowC e m a
forall (m :: * -> *) a. Monad m => m a -> ThrowC e m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> ThrowC e m a
$clift :: forall e (m :: * -> *) a. Monad m => m a -> ThrowC e m a
MonadTrans, MonadTrans (ThrowC e)
m (StT (ThrowC e) a) -> ThrowC e m a
MonadTrans (ThrowC e)
-> (forall (m :: * -> *) a.
Monad m =>
(Run (ThrowC e) -> m a) -> ThrowC e m a)
-> (forall (m :: * -> *) a.
Monad m =>
m (StT (ThrowC e) a) -> ThrowC e m a)
-> MonadTransControl (ThrowC e)
(Run (ThrowC e) -> m a) -> ThrowC e m a
forall e. MonadTrans (ThrowC e)
forall e (m :: * -> *) a.
Monad m =>
m (StT (ThrowC e) a) -> ThrowC e m a
forall e (m :: * -> *) a.
Monad m =>
(Run (ThrowC e) -> m a) -> ThrowC e m a
forall (m :: * -> *) a.
Monad m =>
m (StT (ThrowC e) a) -> ThrowC e m a
forall (m :: * -> *) a.
Monad m =>
(Run (ThrowC e) -> m a) -> ThrowC e m a
forall (t :: (* -> *) -> * -> *).
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 (ThrowC e) a) -> ThrowC e m a
$crestoreT :: forall e (m :: * -> *) a.
Monad m =>
m (StT (ThrowC e) a) -> ThrowC e m a
liftWith :: (Run (ThrowC e) -> m a) -> ThrowC e m a
$cliftWith :: forall e (m :: * -> *) a.
Monad m =>
(Run (ThrowC e) -> m a) -> ThrowC e m a
$cp1MonadTransControl :: forall e. MonadTrans (ThrowC e)
MonadTransControl)
newtype ErrorC e m a = ErrorC { ErrorC e m a -> ExceptT e m a
unErrorC :: ExceptT e m a }
deriving ( a -> ErrorC e m b -> ErrorC e m a
(a -> b) -> ErrorC e m a -> ErrorC e m b
(forall a b. (a -> b) -> ErrorC e m a -> ErrorC e m b)
-> (forall a b. a -> ErrorC e m b -> ErrorC e m a)
-> Functor (ErrorC e m)
forall a b. a -> ErrorC e m b -> ErrorC e m a
forall a b. (a -> b) -> ErrorC e m a -> ErrorC e m b
forall e (m :: * -> *) a b.
Functor m =>
a -> ErrorC e m b -> ErrorC e m a
forall e (m :: * -> *) a b.
Functor m =>
(a -> b) -> ErrorC e m a -> ErrorC e m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ErrorC e m b -> ErrorC e m a
$c<$ :: forall e (m :: * -> *) a b.
Functor m =>
a -> ErrorC e m b -> ErrorC e m a
fmap :: (a -> b) -> ErrorC e m a -> ErrorC e m b
$cfmap :: forall e (m :: * -> *) a b.
Functor m =>
(a -> b) -> ErrorC e m a -> ErrorC e m b
Functor, Functor (ErrorC e m)
a -> ErrorC e m a
Functor (ErrorC e m)
-> (forall a. a -> ErrorC e m a)
-> (forall a b.
ErrorC e m (a -> b) -> ErrorC e m a -> ErrorC e m b)
-> (forall a b c.
(a -> b -> c) -> ErrorC e m a -> ErrorC e m b -> ErrorC e m c)
-> (forall a b. ErrorC e m a -> ErrorC e m b -> ErrorC e m b)
-> (forall a b. ErrorC e m a -> ErrorC e m b -> ErrorC e m a)
-> Applicative (ErrorC e m)
ErrorC e m a -> ErrorC e m b -> ErrorC e m b
ErrorC e m a -> ErrorC e m b -> ErrorC e m a
ErrorC e m (a -> b) -> ErrorC e m a -> ErrorC e m b
(a -> b -> c) -> ErrorC e m a -> ErrorC e m b -> ErrorC e m c
forall a. a -> ErrorC e m a
forall a b. ErrorC e m a -> ErrorC e m b -> ErrorC e m a
forall a b. ErrorC e m a -> ErrorC e m b -> ErrorC e m b
forall a b. ErrorC e m (a -> b) -> ErrorC e m a -> ErrorC e m b
forall a b c.
(a -> b -> c) -> ErrorC e m a -> ErrorC e m b -> ErrorC e m c
forall e (m :: * -> *). Monad m => Functor (ErrorC e m)
forall e (m :: * -> *) a. Monad m => a -> ErrorC e m a
forall e (m :: * -> *) a b.
Monad m =>
ErrorC e m a -> ErrorC e m b -> ErrorC e m a
forall e (m :: * -> *) a b.
Monad m =>
ErrorC e m a -> ErrorC e m b -> ErrorC e m b
forall e (m :: * -> *) a b.
Monad m =>
ErrorC e m (a -> b) -> ErrorC e m a -> ErrorC e m b
forall e (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> ErrorC e m a -> ErrorC e m b -> ErrorC e 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
<* :: ErrorC e m a -> ErrorC e m b -> ErrorC e m a
$c<* :: forall e (m :: * -> *) a b.
Monad m =>
ErrorC e m a -> ErrorC e m b -> ErrorC e m a
*> :: ErrorC e m a -> ErrorC e m b -> ErrorC e m b
$c*> :: forall e (m :: * -> *) a b.
Monad m =>
ErrorC e m a -> ErrorC e m b -> ErrorC e m b
liftA2 :: (a -> b -> c) -> ErrorC e m a -> ErrorC e m b -> ErrorC e m c
$cliftA2 :: forall e (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> ErrorC e m a -> ErrorC e m b -> ErrorC e m c
<*> :: ErrorC e m (a -> b) -> ErrorC e m a -> ErrorC e m b
$c<*> :: forall e (m :: * -> *) a b.
Monad m =>
ErrorC e m (a -> b) -> ErrorC e m a -> ErrorC e m b
pure :: a -> ErrorC e m a
$cpure :: forall e (m :: * -> *) a. Monad m => a -> ErrorC e m a
$cp1Applicative :: forall e (m :: * -> *). Monad m => Functor (ErrorC e m)
Applicative, Applicative (ErrorC e m)
a -> ErrorC e m a
Applicative (ErrorC e m)
-> (forall a b.
ErrorC e m a -> (a -> ErrorC e m b) -> ErrorC e m b)
-> (forall a b. ErrorC e m a -> ErrorC e m b -> ErrorC e m b)
-> (forall a. a -> ErrorC e m a)
-> Monad (ErrorC e m)
ErrorC e m a -> (a -> ErrorC e m b) -> ErrorC e m b
ErrorC e m a -> ErrorC e m b -> ErrorC e m b
forall a. a -> ErrorC e m a
forall a b. ErrorC e m a -> ErrorC e m b -> ErrorC e m b
forall a b. ErrorC e m a -> (a -> ErrorC e m b) -> ErrorC e m b
forall e (m :: * -> *). Monad m => Applicative (ErrorC e m)
forall e (m :: * -> *) a. Monad m => a -> ErrorC e m a
forall e (m :: * -> *) a b.
Monad m =>
ErrorC e m a -> ErrorC e m b -> ErrorC e m b
forall e (m :: * -> *) a b.
Monad m =>
ErrorC e m a -> (a -> ErrorC e m b) -> ErrorC e 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 -> ErrorC e m a
$creturn :: forall e (m :: * -> *) a. Monad m => a -> ErrorC e m a
>> :: ErrorC e m a -> ErrorC e m b -> ErrorC e m b
$c>> :: forall e (m :: * -> *) a b.
Monad m =>
ErrorC e m a -> ErrorC e m b -> ErrorC e m b
>>= :: ErrorC e m a -> (a -> ErrorC e m b) -> ErrorC e m b
$c>>= :: forall e (m :: * -> *) a b.
Monad m =>
ErrorC e m a -> (a -> ErrorC e m b) -> ErrorC e m b
$cp1Monad :: forall e (m :: * -> *). Monad m => Applicative (ErrorC e m)
Monad
, Applicative (ErrorC e m)
ErrorC e m a
Applicative (ErrorC e m)
-> (forall a. ErrorC e m a)
-> (forall a. ErrorC e m a -> ErrorC e m a -> ErrorC e m a)
-> (forall a. ErrorC e m a -> ErrorC e m [a])
-> (forall a. ErrorC e m a -> ErrorC e m [a])
-> Alternative (ErrorC e m)
ErrorC e m a -> ErrorC e m a -> ErrorC e m a
ErrorC e m a -> ErrorC e m [a]
ErrorC e m a -> ErrorC e m [a]
forall a. ErrorC e m a
forall a. ErrorC e m a -> ErrorC e m [a]
forall a. ErrorC e m a -> ErrorC e m a -> ErrorC e m a
forall e (m :: * -> *).
(Monad m, Monoid e) =>
Applicative (ErrorC e m)
forall e (m :: * -> *) a. (Monad m, Monoid e) => ErrorC e m a
forall e (m :: * -> *) a.
(Monad m, Monoid e) =>
ErrorC e m a -> ErrorC e m [a]
forall e (m :: * -> *) a.
(Monad m, Monoid e) =>
ErrorC e m a -> ErrorC e m a -> ErrorC e 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 :: ErrorC e m a -> ErrorC e m [a]
$cmany :: forall e (m :: * -> *) a.
(Monad m, Monoid e) =>
ErrorC e m a -> ErrorC e m [a]
some :: ErrorC e m a -> ErrorC e m [a]
$csome :: forall e (m :: * -> *) a.
(Monad m, Monoid e) =>
ErrorC e m a -> ErrorC e m [a]
<|> :: ErrorC e m a -> ErrorC e m a -> ErrorC e m a
$c<|> :: forall e (m :: * -> *) a.
(Monad m, Monoid e) =>
ErrorC e m a -> ErrorC e m a -> ErrorC e m a
empty :: ErrorC e m a
$cempty :: forall e (m :: * -> *) a. (Monad m, Monoid e) => ErrorC e m a
$cp1Alternative :: forall e (m :: * -> *).
(Monad m, Monoid e) =>
Applicative (ErrorC e m)
Alternative, Monad (ErrorC e m)
Alternative (ErrorC e m)
ErrorC e m a
Alternative (ErrorC e m)
-> Monad (ErrorC e m)
-> (forall a. ErrorC e m a)
-> (forall a. ErrorC e m a -> ErrorC e m a -> ErrorC e m a)
-> MonadPlus (ErrorC e m)
ErrorC e m a -> ErrorC e m a -> ErrorC e m a
forall a. ErrorC e m a
forall a. ErrorC e m a -> ErrorC e m a -> ErrorC e m a
forall e (m :: * -> *). (Monad m, Monoid e) => Monad (ErrorC e m)
forall e (m :: * -> *).
(Monad m, Monoid e) =>
Alternative (ErrorC e m)
forall e (m :: * -> *) a. (Monad m, Monoid e) => ErrorC e m a
forall e (m :: * -> *) a.
(Monad m, Monoid e) =>
ErrorC e m a -> ErrorC e m a -> ErrorC e m a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
mplus :: ErrorC e m a -> ErrorC e m a -> ErrorC e m a
$cmplus :: forall e (m :: * -> *) a.
(Monad m, Monoid e) =>
ErrorC e m a -> ErrorC e m a -> ErrorC e m a
mzero :: ErrorC e m a
$cmzero :: forall e (m :: * -> *) a. (Monad m, Monoid e) => ErrorC e m a
$cp2MonadPlus :: forall e (m :: * -> *). (Monad m, Monoid e) => Monad (ErrorC e m)
$cp1MonadPlus :: forall e (m :: * -> *).
(Monad m, Monoid e) =>
Alternative (ErrorC e m)
MonadPlus
, Monad (ErrorC e m)
Monad (ErrorC e m)
-> (forall a. (a -> ErrorC e m a) -> ErrorC e m a)
-> MonadFix (ErrorC e m)
(a -> ErrorC e m a) -> ErrorC e m a
forall a. (a -> ErrorC e m a) -> ErrorC e m a
forall e (m :: * -> *). MonadFix m => Monad (ErrorC e m)
forall e (m :: * -> *) a.
MonadFix m =>
(a -> ErrorC e m a) -> ErrorC e m a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
mfix :: (a -> ErrorC e m a) -> ErrorC e m a
$cmfix :: forall e (m :: * -> *) a.
MonadFix m =>
(a -> ErrorC e m a) -> ErrorC e m a
$cp1MonadFix :: forall e (m :: * -> *). MonadFix m => Monad (ErrorC e m)
MonadFix, Monad (ErrorC e m)
Monad (ErrorC e m)
-> (forall a. String -> ErrorC e m a) -> MonadFail (ErrorC e m)
String -> ErrorC e m a
forall a. String -> ErrorC e m a
forall e (m :: * -> *). MonadFail m => Monad (ErrorC e m)
forall e (m :: * -> *) a. MonadFail m => String -> ErrorC e m a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
fail :: String -> ErrorC e m a
$cfail :: forall e (m :: * -> *) a. MonadFail m => String -> ErrorC e m a
$cp1MonadFail :: forall e (m :: * -> *). MonadFail m => Monad (ErrorC e m)
MonadFail, Monad (ErrorC e m)
Monad (ErrorC e m)
-> (forall a. IO a -> ErrorC e m a) -> MonadIO (ErrorC e m)
IO a -> ErrorC e m a
forall a. IO a -> ErrorC e m a
forall e (m :: * -> *). MonadIO m => Monad (ErrorC e m)
forall e (m :: * -> *) a. MonadIO m => IO a -> ErrorC e m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> ErrorC e m a
$cliftIO :: forall e (m :: * -> *) a. MonadIO m => IO a -> ErrorC e m a
$cp1MonadIO :: forall e (m :: * -> *). MonadIO m => Monad (ErrorC e m)
MonadIO
, Monad (ErrorC e m)
e -> ErrorC e m a
Monad (ErrorC e m)
-> (forall e a. Exception e => e -> ErrorC e m a)
-> MonadThrow (ErrorC e m)
forall e a. Exception e => e -> ErrorC e m a
forall e (m :: * -> *). MonadThrow m => Monad (ErrorC e m)
forall e (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> ErrorC e m a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: e -> ErrorC e m a
$cthrowM :: forall e (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> ErrorC e m a
$cp1MonadThrow :: forall e (m :: * -> *). MonadThrow m => Monad (ErrorC e m)
MonadThrow, MonadThrow (ErrorC e m)
MonadThrow (ErrorC e m)
-> (forall e a.
Exception e =>
ErrorC e m a -> (e -> ErrorC e m a) -> ErrorC e m a)
-> MonadCatch (ErrorC e m)
ErrorC e m a -> (e -> ErrorC e m a) -> ErrorC e m a
forall e a.
Exception e =>
ErrorC e m a -> (e -> ErrorC e m a) -> ErrorC e m a
forall e (m :: * -> *). MonadCatch m => MonadThrow (ErrorC e m)
forall e (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
ErrorC e m a -> (e -> ErrorC e m a) -> ErrorC e m a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
catch :: ErrorC e m a -> (e -> ErrorC e m a) -> ErrorC e m a
$ccatch :: forall e (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
ErrorC e m a -> (e -> ErrorC e m a) -> ErrorC e m a
$cp1MonadCatch :: forall e (m :: * -> *). MonadCatch m => MonadThrow (ErrorC e m)
MonadCatch, MonadCatch (ErrorC e m)
MonadCatch (ErrorC e m)
-> (forall b.
((forall a. ErrorC e m a -> ErrorC e m a) -> ErrorC e m b)
-> ErrorC e m b)
-> (forall b.
((forall a. ErrorC e m a -> ErrorC e m a) -> ErrorC e m b)
-> ErrorC e m b)
-> (forall a b c.
ErrorC e m a
-> (a -> ExitCase b -> ErrorC e m c)
-> (a -> ErrorC e m b)
-> ErrorC e m (b, c))
-> MonadMask (ErrorC e m)
ErrorC e m a
-> (a -> ExitCase b -> ErrorC e m c)
-> (a -> ErrorC e m b)
-> ErrorC e m (b, c)
((forall a. ErrorC e m a -> ErrorC e m a) -> ErrorC e m b)
-> ErrorC e m b
((forall a. ErrorC e m a -> ErrorC e m a) -> ErrorC e m b)
-> ErrorC e m b
forall b.
((forall a. ErrorC e m a -> ErrorC e m a) -> ErrorC e m b)
-> ErrorC e m b
forall a b c.
ErrorC e m a
-> (a -> ExitCase b -> ErrorC e m c)
-> (a -> ErrorC e m b)
-> ErrorC e m (b, c)
forall e (m :: * -> *). MonadMask m => MonadCatch (ErrorC e m)
forall e (m :: * -> *) b.
MonadMask m =>
((forall a. ErrorC e m a -> ErrorC e m a) -> ErrorC e m b)
-> ErrorC e m b
forall e (m :: * -> *) a b c.
MonadMask m =>
ErrorC e m a
-> (a -> ExitCase b -> ErrorC e m c)
-> (a -> ErrorC e m b)
-> ErrorC e 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 :: ErrorC e m a
-> (a -> ExitCase b -> ErrorC e m c)
-> (a -> ErrorC e m b)
-> ErrorC e m (b, c)
$cgeneralBracket :: forall e (m :: * -> *) a b c.
MonadMask m =>
ErrorC e m a
-> (a -> ExitCase b -> ErrorC e m c)
-> (a -> ErrorC e m b)
-> ErrorC e m (b, c)
uninterruptibleMask :: ((forall a. ErrorC e m a -> ErrorC e m a) -> ErrorC e m b)
-> ErrorC e m b
$cuninterruptibleMask :: forall e (m :: * -> *) b.
MonadMask m =>
((forall a. ErrorC e m a -> ErrorC e m a) -> ErrorC e m b)
-> ErrorC e m b
mask :: ((forall a. ErrorC e m a -> ErrorC e m a) -> ErrorC e m b)
-> ErrorC e m b
$cmask :: forall e (m :: * -> *) b.
MonadMask m =>
((forall a. ErrorC e m a -> ErrorC e m a) -> ErrorC e m b)
-> ErrorC e m b
$cp1MonadMask :: forall e (m :: * -> *). MonadMask m => MonadCatch (ErrorC e m)
MonadMask
, MonadBase b, MonadBaseControl b
)
deriving (m a -> ErrorC e m a
(forall (m :: * -> *) a. Monad m => m a -> ErrorC e m a)
-> MonadTrans (ErrorC e)
forall e (m :: * -> *) a. Monad m => m a -> ErrorC e m a
forall (m :: * -> *) a. Monad m => m a -> ErrorC e m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> ErrorC e m a
$clift :: forall e (m :: * -> *) a. Monad m => m a -> ErrorC e m a
MonadTrans, MonadTrans (ErrorC e)
m (StT (ErrorC e) a) -> ErrorC e m a
MonadTrans (ErrorC e)
-> (forall (m :: * -> *) a.
Monad m =>
(Run (ErrorC e) -> m a) -> ErrorC e m a)
-> (forall (m :: * -> *) a.
Monad m =>
m (StT (ErrorC e) a) -> ErrorC e m a)
-> MonadTransControl (ErrorC e)
(Run (ErrorC e) -> m a) -> ErrorC e m a
forall e. MonadTrans (ErrorC e)
forall e (m :: * -> *) a.
Monad m =>
m (StT (ErrorC e) a) -> ErrorC e m a
forall e (m :: * -> *) a.
Monad m =>
(Run (ErrorC e) -> m a) -> ErrorC e m a
forall (m :: * -> *) a.
Monad m =>
m (StT (ErrorC e) a) -> ErrorC e m a
forall (m :: * -> *) a.
Monad m =>
(Run (ErrorC e) -> m a) -> ErrorC e m a
forall (t :: (* -> *) -> * -> *).
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 (ErrorC e) a) -> ErrorC e m a
$crestoreT :: forall e (m :: * -> *) a.
Monad m =>
m (StT (ErrorC e) a) -> ErrorC e m a
liftWith :: (Run (ErrorC e) -> m a) -> ErrorC e m a
$cliftWith :: forall e (m :: * -> *) a.
Monad m =>
(Run (ErrorC e) -> m a) -> ErrorC e m a
$cp1MonadTransControl :: forall e. MonadTrans (ErrorC e)
MonadTransControl)
instance ( Carrier m
, Threads (ExceptT e) (Prims m)
)
=> Carrier (ThrowC e m) where
type Derivs (ThrowC e m) = Throw e ': Derivs m
type Prims (ThrowC e m) = Prims m
algPrims :: Algebra' (Prims (ThrowC e m)) (ThrowC e m) a
algPrims = (Union (Prims m) (ExceptT e m) a -> ExceptT e m a)
-> Algebra' (Prims m) (ThrowC e m) a
coerce (Algebra (Prims m) m -> Algebra (Prims m) (ExceptT e m)
forall (t :: (* -> *) -> * -> *) (p :: [(* -> *) -> * -> *])
(m :: * -> *).
(Threads t p, Monad m) =>
Algebra p m -> Algebra p (t m)
thread @(ExceptT e) (Carrier m => Algebra (Prims m) m
forall (m :: * -> *) a. Carrier m => Algebra' (Prims m) m a
algPrims @m))
{-# INLINEABLE algPrims #-}
reformulate :: Reformulation'
(Derivs (ThrowC e m)) (Prims (ThrowC e m)) (ThrowC e m) z a
reformulate forall x. ThrowC e m x -> z x
n Algebra (Prims (ThrowC e m)) z
alg = Algebra' (Derivs m) z a
-> (Throw e z a -> z a) -> Algebra' (Throw e : Derivs m) z a
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *])
(m :: * -> *) a.
RepresentationalEff e =>
Algebra' r m a -> (e m 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 (ThrowC e m x -> z x
forall x. ThrowC e m x -> z x
n (ThrowC e m x -> z x) -> (m x -> ThrowC e m x) -> m x -> z x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m x -> ThrowC e m x
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift) forall x. Union (Prims m) z x -> z x
Algebra (Prims (ThrowC e m)) z
alg) ((Throw e z a -> z a) -> Algebra' (Throw e : Derivs m) z a)
-> (Throw e z a -> z a) -> Algebra' (Throw e : Derivs m) z a
forall a b. (a -> b) -> a -> b
$ \case
Throw e
e -> ThrowC e m a -> z a
forall x. ThrowC e m x -> z x
n (ExceptT e m a -> ThrowC e m a
forall e (m :: * -> *) a. ExceptT e m a -> ThrowC e m a
ThrowC (e -> ExceptT e m a
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE e
e))
{-# INLINEABLE reformulate #-}
instance ( Carrier m
, Threads (ExceptT e) (Prims m)
)
=> Carrier (ErrorC e m) where
type Derivs (ErrorC e m) = Catch e ': Throw e ': Derivs m
type Prims (ErrorC e m) = Optional ((->) e) ': Prims m
algPrims :: Algebra' (Prims (ErrorC e m)) (ErrorC e m) a
algPrims = Algebra' (Prims m) (ErrorC e m) a
-> (Optional ((->) e) (ErrorC e m) a -> ErrorC e m a)
-> Algebra' (Optional ((->) e) : Prims m) (ErrorC e m) a
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *])
(m :: * -> *) a.
RepresentationalEff e =>
Algebra' r m a -> (e m a -> m a) -> Algebra' (e : r) m a
powerAlg (Algebra' (Prims m) (ThrowC e m) a
-> Algebra' (Prims m) (ErrorC e m) a
coerce (forall a.
Carrier (ThrowC e m) =>
Algebra' (Prims (ThrowC e m)) (ThrowC e m) a
forall (m :: * -> *) a. Carrier m => Algebra' (Prims m) m a
algPrims @(ThrowC e m))) ((Optional ((->) e) (ErrorC e m) a -> ErrorC e m a)
-> Algebra' (Optional ((->) e) : Prims m) (ErrorC e m) a)
-> (Optional ((->) e) (ErrorC e m) a -> ErrorC e m a)
-> Algebra' (Optional ((->) e) : Prims m) (ErrorC e m) a
forall a b. (a -> b) -> a -> b
$ \case
Optionally e -> a
h ErrorC e m a
m -> ExceptT e m a -> ErrorC e m a
forall e (m :: * -> *) a. ExceptT e m a -> ErrorC e m a
ErrorC (ErrorC e m a -> ExceptT e m a
forall e (m :: * -> *) a. ErrorC e m a -> ExceptT e m a
unErrorC ErrorC e m a
m ExceptT e m a -> (e -> ExceptT e m a) -> ExceptT e m a
forall (m :: * -> *) e a e'.
Monad m =>
ExceptT e m a -> (e -> ExceptT e' m a) -> ExceptT e' m a
`catchE` (a -> ExceptT e m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> ExceptT e m a) -> (e -> a) -> e -> ExceptT e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> a
h))
{-# INLINEABLE algPrims #-}
reformulate :: Reformulation'
(Derivs (ErrorC e m)) (Prims (ErrorC e m)) (ErrorC e m) z a
reformulate forall x. ErrorC e m x -> z x
n Algebra (Prims (ErrorC e m)) z
alg =
Algebra' (Throw e : Derivs m) z a
-> (Catch e z a -> z a)
-> Algebra' (Catch e : Throw e : Derivs m) z a
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *])
(m :: * -> *) a.
RepresentationalEff e =>
Algebra' r m a -> (e m a -> m a) -> Algebra' (e : r) m a
powerAlg (
Reformulation' (Throw e : Derivs m) (Prims m) (ThrowC e m) z a
-> Reformulation' (Throw e : Derivs m) (Prims m) (ErrorC e m) z a
forall (m :: * -> *) (n :: * -> *) (r :: [(* -> *) -> * -> *])
(p :: [(* -> *) -> * -> *]) (z :: * -> *) a.
Coercible m n =>
Reformulation' r p m z a -> Reformulation' r p n z a
coerceReform (forall (z :: * -> *) a.
(Carrier (ThrowC e m), Monad z) =>
Reformulation'
(Derivs (ThrowC e m)) (Prims (ThrowC e m)) (ThrowC e m) z a
forall (m :: * -> *) (z :: * -> *) a.
(Carrier m, Monad z) =>
Reformulation' (Derivs m) (Prims m) m z a
reformulate @(ThrowC e m)) forall x. ErrorC e m x -> z x
n (Algebra' (Optional ((->) e) : Prims m) z x
-> Algebra' (Prims m) z x
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *])
(m :: * -> *) a.
Algebra' (e : r) m a -> Algebra' r m a
weakenAlg Algebra' (Optional ((->) e) : Prims m) z x
Algebra (Prims (ErrorC e m)) z
alg)
) ((Catch e z a -> z a)
-> Algebra' (Catch e : Throw e : Derivs m) z a)
-> (Catch e z a -> z a)
-> Algebra' (Catch e : Throw e : Derivs m) z a
forall a b. (a -> b) -> a -> b
$ \case
Catch z a
m e -> z a
h -> z (z a) -> z a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (z (z a) -> z a) -> z (z a) -> z a
forall a b. (a -> b) -> a -> b
$ (Union (Optional ((->) e) : Prims m) z (z a) -> z (z a)
Algebra (Prims (ErrorC e m)) z
alg (Union (Optional ((->) e) : Prims m) z (z a) -> z (z a))
-> (Optional ((->) e) z (z a)
-> Union (Optional ((->) e) : Prims m) z (z a))
-> Optional ((->) e) z (z a)
-> z (z a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optional ((->) e) z (z a)
-> Union (Optional ((->) e) : Prims m) z (z a)
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *])
(m :: * -> *) a.
Member e r =>
e m a -> Union r m a
inj) (Optional ((->) e) z (z a) -> z (z a))
-> Optional ((->) e) z (z a) -> z (z a)
forall a b. (a -> b) -> a -> b
$ (e -> z a) -> z (z a) -> Optional ((->) e) z (z a)
forall (s :: * -> *) a (m :: * -> *). s a -> m a -> Optional s m a
Optionally e -> z a
h ((a -> z a) -> z a -> z (z a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> z a
forall (f :: * -> *) a. Applicative f => a -> f a
pure z a
m)
{-# INLINEABLE reformulate #-}
class ( forall e. Threads (ExceptT e) p
) => ErrorThreads p
instance ( forall e. Threads (ExceptT e) p
) => ErrorThreads p
type ReifiesErrorHandler s s' e m =
( ReifiesHandler s (Catch e) (InterpretC (ViaReifiedH s') (Throw e) m)
, ReifiesHandler s' (Throw e) m
)
newtype InterpretErrorC' s s' e m a = InterpretErrorC' {
InterpretErrorC' s s' e m a
-> InterpretC
(ViaReifiedH s)
(Catch e)
(InterpretC (ViaReifiedH s') (Throw e) m)
a
unInterpretErrorC' ::
InterpretC (ViaReifiedH s) (Catch e)
( InterpretC (ViaReifiedH s') (Throw e)
( m
)) a
} deriving ( a -> InterpretErrorC' s s' e m b -> InterpretErrorC' s s' e m a
(a -> b)
-> InterpretErrorC' s s' e m a -> InterpretErrorC' s s' e m b
(forall a b.
(a -> b)
-> InterpretErrorC' s s' e m a -> InterpretErrorC' s s' e m b)
-> (forall a b.
a -> InterpretErrorC' s s' e m b -> InterpretErrorC' s s' e m a)
-> Functor (InterpretErrorC' s s' e m)
forall a b.
a -> InterpretErrorC' s s' e m b -> InterpretErrorC' s s' e m a
forall a b.
(a -> b)
-> InterpretErrorC' s s' e m a -> InterpretErrorC' s s' e m b
forall s s' e (m :: * -> *) a b.
Functor m =>
a -> InterpretErrorC' s s' e m b -> InterpretErrorC' s s' e m a
forall s s' e (m :: * -> *) a b.
Functor m =>
(a -> b)
-> InterpretErrorC' s s' e m a -> InterpretErrorC' s s' e m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> InterpretErrorC' s s' e m b -> InterpretErrorC' s s' e m a
$c<$ :: forall s s' e (m :: * -> *) a b.
Functor m =>
a -> InterpretErrorC' s s' e m b -> InterpretErrorC' s s' e m a
fmap :: (a -> b)
-> InterpretErrorC' s s' e m a -> InterpretErrorC' s s' e m b
$cfmap :: forall s s' e (m :: * -> *) a b.
Functor m =>
(a -> b)
-> InterpretErrorC' s s' e m a -> InterpretErrorC' s s' e m b
Functor, Functor (InterpretErrorC' s s' e m)
a -> InterpretErrorC' s s' e m a
Functor (InterpretErrorC' s s' e m)
-> (forall a. a -> InterpretErrorC' s s' e m a)
-> (forall a b.
InterpretErrorC' s s' e m (a -> b)
-> InterpretErrorC' s s' e m a -> InterpretErrorC' s s' e m b)
-> (forall a b c.
(a -> b -> c)
-> InterpretErrorC' s s' e m a
-> InterpretErrorC' s s' e m b
-> InterpretErrorC' s s' e m c)
-> (forall a b.
InterpretErrorC' s s' e m a
-> InterpretErrorC' s s' e m b -> InterpretErrorC' s s' e m b)
-> (forall a b.
InterpretErrorC' s s' e m a
-> InterpretErrorC' s s' e m b -> InterpretErrorC' s s' e m a)
-> Applicative (InterpretErrorC' s s' e m)
InterpretErrorC' s s' e m a
-> InterpretErrorC' s s' e m b -> InterpretErrorC' s s' e m b
InterpretErrorC' s s' e m a
-> InterpretErrorC' s s' e m b -> InterpretErrorC' s s' e m a
InterpretErrorC' s s' e m (a -> b)
-> InterpretErrorC' s s' e m a -> InterpretErrorC' s s' e m b
(a -> b -> c)
-> InterpretErrorC' s s' e m a
-> InterpretErrorC' s s' e m b
-> InterpretErrorC' s s' e m c
forall a. a -> InterpretErrorC' s s' e m a
forall a b.
InterpretErrorC' s s' e m a
-> InterpretErrorC' s s' e m b -> InterpretErrorC' s s' e m a
forall a b.
InterpretErrorC' s s' e m a
-> InterpretErrorC' s s' e m b -> InterpretErrorC' s s' e m b
forall a b.
InterpretErrorC' s s' e m (a -> b)
-> InterpretErrorC' s s' e m a -> InterpretErrorC' s s' e m b
forall a b c.
(a -> b -> c)
-> InterpretErrorC' s s' e m a
-> InterpretErrorC' s s' e m b
-> InterpretErrorC' s s' e m c
forall s s' e (m :: * -> *).
Applicative m =>
Functor (InterpretErrorC' s s' e m)
forall s s' e (m :: * -> *) a.
Applicative m =>
a -> InterpretErrorC' s s' e m a
forall s s' e (m :: * -> *) a b.
Applicative m =>
InterpretErrorC' s s' e m a
-> InterpretErrorC' s s' e m b -> InterpretErrorC' s s' e m a
forall s s' e (m :: * -> *) a b.
Applicative m =>
InterpretErrorC' s s' e m a
-> InterpretErrorC' s s' e m b -> InterpretErrorC' s s' e m b
forall s s' e (m :: * -> *) a b.
Applicative m =>
InterpretErrorC' s s' e m (a -> b)
-> InterpretErrorC' s s' e m a -> InterpretErrorC' s s' e m b
forall s s' e (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> InterpretErrorC' s s' e m a
-> InterpretErrorC' s s' e m b
-> InterpretErrorC' s s' e 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
<* :: InterpretErrorC' s s' e m a
-> InterpretErrorC' s s' e m b -> InterpretErrorC' s s' e m a
$c<* :: forall s s' e (m :: * -> *) a b.
Applicative m =>
InterpretErrorC' s s' e m a
-> InterpretErrorC' s s' e m b -> InterpretErrorC' s s' e m a
*> :: InterpretErrorC' s s' e m a
-> InterpretErrorC' s s' e m b -> InterpretErrorC' s s' e m b
$c*> :: forall s s' e (m :: * -> *) a b.
Applicative m =>
InterpretErrorC' s s' e m a
-> InterpretErrorC' s s' e m b -> InterpretErrorC' s s' e m b
liftA2 :: (a -> b -> c)
-> InterpretErrorC' s s' e m a
-> InterpretErrorC' s s' e m b
-> InterpretErrorC' s s' e m c
$cliftA2 :: forall s s' e (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> InterpretErrorC' s s' e m a
-> InterpretErrorC' s s' e m b
-> InterpretErrorC' s s' e m c
<*> :: InterpretErrorC' s s' e m (a -> b)
-> InterpretErrorC' s s' e m a -> InterpretErrorC' s s' e m b
$c<*> :: forall s s' e (m :: * -> *) a b.
Applicative m =>
InterpretErrorC' s s' e m (a -> b)
-> InterpretErrorC' s s' e m a -> InterpretErrorC' s s' e m b
pure :: a -> InterpretErrorC' s s' e m a
$cpure :: forall s s' e (m :: * -> *) a.
Applicative m =>
a -> InterpretErrorC' s s' e m a
$cp1Applicative :: forall s s' e (m :: * -> *).
Applicative m =>
Functor (InterpretErrorC' s s' e m)
Applicative, Applicative (InterpretErrorC' s s' e m)
a -> InterpretErrorC' s s' e m a
Applicative (InterpretErrorC' s s' e m)
-> (forall a b.
InterpretErrorC' s s' e m a
-> (a -> InterpretErrorC' s s' e m b)
-> InterpretErrorC' s s' e m b)
-> (forall a b.
InterpretErrorC' s s' e m a
-> InterpretErrorC' s s' e m b -> InterpretErrorC' s s' e m b)
-> (forall a. a -> InterpretErrorC' s s' e m a)
-> Monad (InterpretErrorC' s s' e m)
InterpretErrorC' s s' e m a
-> (a -> InterpretErrorC' s s' e m b)
-> InterpretErrorC' s s' e m b
InterpretErrorC' s s' e m a
-> InterpretErrorC' s s' e m b -> InterpretErrorC' s s' e m b
forall a. a -> InterpretErrorC' s s' e m a
forall a b.
InterpretErrorC' s s' e m a
-> InterpretErrorC' s s' e m b -> InterpretErrorC' s s' e m b
forall a b.
InterpretErrorC' s s' e m a
-> (a -> InterpretErrorC' s s' e m b)
-> InterpretErrorC' s s' e m b
forall s s' e (m :: * -> *).
Monad m =>
Applicative (InterpretErrorC' s s' e m)
forall s s' e (m :: * -> *) a.
Monad m =>
a -> InterpretErrorC' s s' e m a
forall s s' e (m :: * -> *) a b.
Monad m =>
InterpretErrorC' s s' e m a
-> InterpretErrorC' s s' e m b -> InterpretErrorC' s s' e m b
forall s s' e (m :: * -> *) a b.
Monad m =>
InterpretErrorC' s s' e m a
-> (a -> InterpretErrorC' s s' e m b)
-> InterpretErrorC' s s' e 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 -> InterpretErrorC' s s' e m a
$creturn :: forall s s' e (m :: * -> *) a.
Monad m =>
a -> InterpretErrorC' s s' e m a
>> :: InterpretErrorC' s s' e m a
-> InterpretErrorC' s s' e m b -> InterpretErrorC' s s' e m b
$c>> :: forall s s' e (m :: * -> *) a b.
Monad m =>
InterpretErrorC' s s' e m a
-> InterpretErrorC' s s' e m b -> InterpretErrorC' s s' e m b
>>= :: InterpretErrorC' s s' e m a
-> (a -> InterpretErrorC' s s' e m b)
-> InterpretErrorC' s s' e m b
$c>>= :: forall s s' e (m :: * -> *) a b.
Monad m =>
InterpretErrorC' s s' e m a
-> (a -> InterpretErrorC' s s' e m b)
-> InterpretErrorC' s s' e m b
$cp1Monad :: forall s s' e (m :: * -> *).
Monad m =>
Applicative (InterpretErrorC' s s' e m)
Monad
, Applicative (InterpretErrorC' s s' e m)
InterpretErrorC' s s' e m a
Applicative (InterpretErrorC' s s' e m)
-> (forall a. InterpretErrorC' s s' e m a)
-> (forall a.
InterpretErrorC' s s' e m a
-> InterpretErrorC' s s' e m a -> InterpretErrorC' s s' e m a)
-> (forall a.
InterpretErrorC' s s' e m a -> InterpretErrorC' s s' e m [a])
-> (forall a.
InterpretErrorC' s s' e m a -> InterpretErrorC' s s' e m [a])
-> Alternative (InterpretErrorC' s s' e m)
InterpretErrorC' s s' e m a
-> InterpretErrorC' s s' e m a -> InterpretErrorC' s s' e m a
InterpretErrorC' s s' e m a -> InterpretErrorC' s s' e m [a]
InterpretErrorC' s s' e m a -> InterpretErrorC' s s' e m [a]
forall a. InterpretErrorC' s s' e m a
forall a.
InterpretErrorC' s s' e m a -> InterpretErrorC' s s' e m [a]
forall a.
InterpretErrorC' s s' e m a
-> InterpretErrorC' s s' e m a -> InterpretErrorC' s s' e m a
forall s s' e (m :: * -> *).
Alternative m =>
Applicative (InterpretErrorC' s s' e m)
forall s s' e (m :: * -> *) a.
Alternative m =>
InterpretErrorC' s s' e m a
forall s s' e (m :: * -> *) a.
Alternative m =>
InterpretErrorC' s s' e m a -> InterpretErrorC' s s' e m [a]
forall s s' e (m :: * -> *) a.
Alternative m =>
InterpretErrorC' s s' e m a
-> InterpretErrorC' s s' e m a -> InterpretErrorC' s s' e 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 :: InterpretErrorC' s s' e m a -> InterpretErrorC' s s' e m [a]
$cmany :: forall s s' e (m :: * -> *) a.
Alternative m =>
InterpretErrorC' s s' e m a -> InterpretErrorC' s s' e m [a]
some :: InterpretErrorC' s s' e m a -> InterpretErrorC' s s' e m [a]
$csome :: forall s s' e (m :: * -> *) a.
Alternative m =>
InterpretErrorC' s s' e m a -> InterpretErrorC' s s' e m [a]
<|> :: InterpretErrorC' s s' e m a
-> InterpretErrorC' s s' e m a -> InterpretErrorC' s s' e m a
$c<|> :: forall s s' e (m :: * -> *) a.
Alternative m =>
InterpretErrorC' s s' e m a
-> InterpretErrorC' s s' e m a -> InterpretErrorC' s s' e m a
empty :: InterpretErrorC' s s' e m a
$cempty :: forall s s' e (m :: * -> *) a.
Alternative m =>
InterpretErrorC' s s' e m a
$cp1Alternative :: forall s s' e (m :: * -> *).
Alternative m =>
Applicative (InterpretErrorC' s s' e m)
Alternative, Monad (InterpretErrorC' s s' e m)
Alternative (InterpretErrorC' s s' e m)
InterpretErrorC' s s' e m a
Alternative (InterpretErrorC' s s' e m)
-> Monad (InterpretErrorC' s s' e m)
-> (forall a. InterpretErrorC' s s' e m a)
-> (forall a.
InterpretErrorC' s s' e m a
-> InterpretErrorC' s s' e m a -> InterpretErrorC' s s' e m a)
-> MonadPlus (InterpretErrorC' s s' e m)
InterpretErrorC' s s' e m a
-> InterpretErrorC' s s' e m a -> InterpretErrorC' s s' e m a
forall a. InterpretErrorC' s s' e m a
forall a.
InterpretErrorC' s s' e m a
-> InterpretErrorC' s s' e m a -> InterpretErrorC' s s' e m a
forall s s' e (m :: * -> *).
MonadPlus m =>
Monad (InterpretErrorC' s s' e m)
forall s s' e (m :: * -> *).
MonadPlus m =>
Alternative (InterpretErrorC' s s' e m)
forall s s' e (m :: * -> *) a.
MonadPlus m =>
InterpretErrorC' s s' e m a
forall s s' e (m :: * -> *) a.
MonadPlus m =>
InterpretErrorC' s s' e m a
-> InterpretErrorC' s s' e m a -> InterpretErrorC' s s' e m a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
mplus :: InterpretErrorC' s s' e m a
-> InterpretErrorC' s s' e m a -> InterpretErrorC' s s' e m a
$cmplus :: forall s s' e (m :: * -> *) a.
MonadPlus m =>
InterpretErrorC' s s' e m a
-> InterpretErrorC' s s' e m a -> InterpretErrorC' s s' e m a
mzero :: InterpretErrorC' s s' e m a
$cmzero :: forall s s' e (m :: * -> *) a.
MonadPlus m =>
InterpretErrorC' s s' e m a
$cp2MonadPlus :: forall s s' e (m :: * -> *).
MonadPlus m =>
Monad (InterpretErrorC' s s' e m)
$cp1MonadPlus :: forall s s' e (m :: * -> *).
MonadPlus m =>
Alternative (InterpretErrorC' s s' e m)
MonadPlus
, Monad (InterpretErrorC' s s' e m)
Monad (InterpretErrorC' s s' e m)
-> (forall a.
(a -> InterpretErrorC' s s' e m a) -> InterpretErrorC' s s' e m a)
-> MonadFix (InterpretErrorC' s s' e m)
(a -> InterpretErrorC' s s' e m a) -> InterpretErrorC' s s' e m a
forall a.
(a -> InterpretErrorC' s s' e m a) -> InterpretErrorC' s s' e m a
forall s s' e (m :: * -> *).
MonadFix m =>
Monad (InterpretErrorC' s s' e m)
forall s s' e (m :: * -> *) a.
MonadFix m =>
(a -> InterpretErrorC' s s' e m a) -> InterpretErrorC' s s' e m a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
mfix :: (a -> InterpretErrorC' s s' e m a) -> InterpretErrorC' s s' e m a
$cmfix :: forall s s' e (m :: * -> *) a.
MonadFix m =>
(a -> InterpretErrorC' s s' e m a) -> InterpretErrorC' s s' e m a
$cp1MonadFix :: forall s s' e (m :: * -> *).
MonadFix m =>
Monad (InterpretErrorC' s s' e m)
MonadFix, Monad (InterpretErrorC' s s' e m)
Monad (InterpretErrorC' s s' e m)
-> (forall a. String -> InterpretErrorC' s s' e m a)
-> MonadFail (InterpretErrorC' s s' e m)
String -> InterpretErrorC' s s' e m a
forall a. String -> InterpretErrorC' s s' e m a
forall s s' e (m :: * -> *).
MonadFail m =>
Monad (InterpretErrorC' s s' e m)
forall s s' e (m :: * -> *) a.
MonadFail m =>
String -> InterpretErrorC' s s' e m a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
fail :: String -> InterpretErrorC' s s' e m a
$cfail :: forall s s' e (m :: * -> *) a.
MonadFail m =>
String -> InterpretErrorC' s s' e m a
$cp1MonadFail :: forall s s' e (m :: * -> *).
MonadFail m =>
Monad (InterpretErrorC' s s' e m)
MonadFail, Monad (InterpretErrorC' s s' e m)
Monad (InterpretErrorC' s s' e m)
-> (forall a. IO a -> InterpretErrorC' s s' e m a)
-> MonadIO (InterpretErrorC' s s' e m)
IO a -> InterpretErrorC' s s' e m a
forall a. IO a -> InterpretErrorC' s s' e m a
forall s s' e (m :: * -> *).
MonadIO m =>
Monad (InterpretErrorC' s s' e m)
forall s s' e (m :: * -> *) a.
MonadIO m =>
IO a -> InterpretErrorC' s s' e m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> InterpretErrorC' s s' e m a
$cliftIO :: forall s s' e (m :: * -> *) a.
MonadIO m =>
IO a -> InterpretErrorC' s s' e m a
$cp1MonadIO :: forall s s' e (m :: * -> *).
MonadIO m =>
Monad (InterpretErrorC' s s' e m)
MonadIO
, Monad (InterpretErrorC' s s' e m)
e -> InterpretErrorC' s s' e m a
Monad (InterpretErrorC' s s' e m)
-> (forall e a. Exception e => e -> InterpretErrorC' s s' e m a)
-> MonadThrow (InterpretErrorC' s s' e m)
forall e a. Exception e => e -> InterpretErrorC' s s' e m a
forall s s' e (m :: * -> *).
MonadThrow m =>
Monad (InterpretErrorC' s s' e m)
forall s s' e (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> InterpretErrorC' s s' e m a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: e -> InterpretErrorC' s s' e m a
$cthrowM :: forall s s' e (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> InterpretErrorC' s s' e m a
$cp1MonadThrow :: forall s s' e (m :: * -> *).
MonadThrow m =>
Monad (InterpretErrorC' s s' e m)
MonadThrow, MonadThrow (InterpretErrorC' s s' e m)
MonadThrow (InterpretErrorC' s s' e m)
-> (forall e a.
Exception e =>
InterpretErrorC' s s' e m a
-> (e -> InterpretErrorC' s s' e m a)
-> InterpretErrorC' s s' e m a)
-> MonadCatch (InterpretErrorC' s s' e m)
InterpretErrorC' s s' e m a
-> (e -> InterpretErrorC' s s' e m a)
-> InterpretErrorC' s s' e m a
forall e a.
Exception e =>
InterpretErrorC' s s' e m a
-> (e -> InterpretErrorC' s s' e m a)
-> InterpretErrorC' s s' e m a
forall s s' e (m :: * -> *).
MonadCatch m =>
MonadThrow (InterpretErrorC' s s' e m)
forall s s' e (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
InterpretErrorC' s s' e m a
-> (e -> InterpretErrorC' s s' e m a)
-> InterpretErrorC' s s' e m a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
catch :: InterpretErrorC' s s' e m a
-> (e -> InterpretErrorC' s s' e m a)
-> InterpretErrorC' s s' e m a
$ccatch :: forall s s' e (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
InterpretErrorC' s s' e m a
-> (e -> InterpretErrorC' s s' e m a)
-> InterpretErrorC' s s' e m a
$cp1MonadCatch :: forall s s' e (m :: * -> *).
MonadCatch m =>
MonadThrow (InterpretErrorC' s s' e m)
MonadCatch, MonadCatch (InterpretErrorC' s s' e m)
MonadCatch (InterpretErrorC' s s' e m)
-> (forall b.
((forall a.
InterpretErrorC' s s' e m a -> InterpretErrorC' s s' e m a)
-> InterpretErrorC' s s' e m b)
-> InterpretErrorC' s s' e m b)
-> (forall b.
((forall a.
InterpretErrorC' s s' e m a -> InterpretErrorC' s s' e m a)
-> InterpretErrorC' s s' e m b)
-> InterpretErrorC' s s' e m b)
-> (forall a b c.
InterpretErrorC' s s' e m a
-> (a -> ExitCase b -> InterpretErrorC' s s' e m c)
-> (a -> InterpretErrorC' s s' e m b)
-> InterpretErrorC' s s' e m (b, c))
-> MonadMask (InterpretErrorC' s s' e m)
InterpretErrorC' s s' e m a
-> (a -> ExitCase b -> InterpretErrorC' s s' e m c)
-> (a -> InterpretErrorC' s s' e m b)
-> InterpretErrorC' s s' e m (b, c)
((forall a.
InterpretErrorC' s s' e m a -> InterpretErrorC' s s' e m a)
-> InterpretErrorC' s s' e m b)
-> InterpretErrorC' s s' e m b
((forall a.
InterpretErrorC' s s' e m a -> InterpretErrorC' s s' e m a)
-> InterpretErrorC' s s' e m b)
-> InterpretErrorC' s s' e m b
forall b.
((forall a.
InterpretErrorC' s s' e m a -> InterpretErrorC' s s' e m a)
-> InterpretErrorC' s s' e m b)
-> InterpretErrorC' s s' e m b
forall a b c.
InterpretErrorC' s s' e m a
-> (a -> ExitCase b -> InterpretErrorC' s s' e m c)
-> (a -> InterpretErrorC' s s' e m b)
-> InterpretErrorC' s s' e m (b, c)
forall s s' e (m :: * -> *).
MonadMask m =>
MonadCatch (InterpretErrorC' s s' e m)
forall s s' e (m :: * -> *) b.
MonadMask m =>
((forall a.
InterpretErrorC' s s' e m a -> InterpretErrorC' s s' e m a)
-> InterpretErrorC' s s' e m b)
-> InterpretErrorC' s s' e m b
forall s s' e (m :: * -> *) a b c.
MonadMask m =>
InterpretErrorC' s s' e m a
-> (a -> ExitCase b -> InterpretErrorC' s s' e m c)
-> (a -> InterpretErrorC' s s' e m b)
-> InterpretErrorC' s s' e 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 :: InterpretErrorC' s s' e m a
-> (a -> ExitCase b -> InterpretErrorC' s s' e m c)
-> (a -> InterpretErrorC' s s' e m b)
-> InterpretErrorC' s s' e m (b, c)
$cgeneralBracket :: forall s s' e (m :: * -> *) a b c.
MonadMask m =>
InterpretErrorC' s s' e m a
-> (a -> ExitCase b -> InterpretErrorC' s s' e m c)
-> (a -> InterpretErrorC' s s' e m b)
-> InterpretErrorC' s s' e m (b, c)
uninterruptibleMask :: ((forall a.
InterpretErrorC' s s' e m a -> InterpretErrorC' s s' e m a)
-> InterpretErrorC' s s' e m b)
-> InterpretErrorC' s s' e m b
$cuninterruptibleMask :: forall s s' e (m :: * -> *) b.
MonadMask m =>
((forall a.
InterpretErrorC' s s' e m a -> InterpretErrorC' s s' e m a)
-> InterpretErrorC' s s' e m b)
-> InterpretErrorC' s s' e m b
mask :: ((forall a.
InterpretErrorC' s s' e m a -> InterpretErrorC' s s' e m a)
-> InterpretErrorC' s s' e m b)
-> InterpretErrorC' s s' e m b
$cmask :: forall s s' e (m :: * -> *) b.
MonadMask m =>
((forall a.
InterpretErrorC' s s' e m a -> InterpretErrorC' s s' e m a)
-> InterpretErrorC' s s' e m b)
-> InterpretErrorC' s s' e m b
$cp1MonadMask :: forall s s' e (m :: * -> *).
MonadMask m =>
MonadCatch (InterpretErrorC' s s' e m)
MonadMask
, MonadBase b, MonadBaseControl b
)
deriving (m a -> InterpretErrorC' s s' e m a
(forall (m :: * -> *) a.
Monad m =>
m a -> InterpretErrorC' s s' e m a)
-> MonadTrans (InterpretErrorC' s s' e)
forall s s' e (m :: * -> *) a.
Monad m =>
m a -> InterpretErrorC' s s' e m a
forall (m :: * -> *) a.
Monad m =>
m a -> InterpretErrorC' s s' e m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> InterpretErrorC' s s' e m a
$clift :: forall s s' e (m :: * -> *) a.
Monad m =>
m a -> InterpretErrorC' s s' e m a
MonadTrans, MonadTrans (InterpretErrorC' s s' e)
m (StT (InterpretErrorC' s s' e) a) -> InterpretErrorC' s s' e m a
MonadTrans (InterpretErrorC' s s' e)
-> (forall (m :: * -> *) a.
Monad m =>
(Run (InterpretErrorC' s s' e) -> m a)
-> InterpretErrorC' s s' e m a)
-> (forall (m :: * -> *) a.
Monad m =>
m (StT (InterpretErrorC' s s' e) a) -> InterpretErrorC' s s' e m a)
-> MonadTransControl (InterpretErrorC' s s' e)
(Run (InterpretErrorC' s s' e) -> m a)
-> InterpretErrorC' s s' e m a
forall s s' e. MonadTrans (InterpretErrorC' s s' e)
forall s s' e (m :: * -> *) a.
Monad m =>
m (StT (InterpretErrorC' s s' e) a) -> InterpretErrorC' s s' e m a
forall s s' e (m :: * -> *) a.
Monad m =>
(Run (InterpretErrorC' s s' e) -> m a)
-> InterpretErrorC' s s' e m a
forall (m :: * -> *) a.
Monad m =>
m (StT (InterpretErrorC' s s' e) a) -> InterpretErrorC' s s' e m a
forall (m :: * -> *) a.
Monad m =>
(Run (InterpretErrorC' s s' e) -> m a)
-> InterpretErrorC' s s' e m a
forall (t :: (* -> *) -> * -> *).
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 (InterpretErrorC' s s' e) a) -> InterpretErrorC' s s' e m a
$crestoreT :: forall s s' e (m :: * -> *) a.
Monad m =>
m (StT (InterpretErrorC' s s' e) a) -> InterpretErrorC' s s' e m a
liftWith :: (Run (InterpretErrorC' s s' e) -> m a)
-> InterpretErrorC' s s' e m a
$cliftWith :: forall s s' e (m :: * -> *) a.
Monad m =>
(Run (InterpretErrorC' s s' e) -> m a)
-> InterpretErrorC' s s' e m a
$cp1MonadTransControl :: forall s s' e. MonadTrans (InterpretErrorC' s s' e)
MonadTransControl)
via CompositionBaseT
'[ InterpretC (ViaReifiedH s) (Catch e)
, InterpretC (ViaReifiedH s') (Throw e)
]
deriving instance (Carrier m, ReifiesErrorHandler s s' e m)
=> Carrier (InterpretErrorC' s s' e m)
type InterpretErrorC e m a =
forall s s'
. ReifiesErrorHandler s s' e m
=> InterpretErrorC' s s' e m a
newtype ErrorToIOC' s s' e m a = ErrorToIOC' {
ErrorToIOC' s s' e m a
-> IntroC
'[Catch e, Throw e]
'[ErrorIO]
(InterpretErrorC' s s' e (ErrorIOToIOC m))
a
unErrorToIOC' ::
IntroC '[Catch e, Throw e] '[ErrorIO]
( InterpretErrorC' s s' e
( ErrorIOToIOC
( m
))) a
} deriving ( a -> ErrorToIOC' s s' e m b -> ErrorToIOC' s s' e m a
(a -> b) -> ErrorToIOC' s s' e m a -> ErrorToIOC' s s' e m b
(forall a b.
(a -> b) -> ErrorToIOC' s s' e m a -> ErrorToIOC' s s' e m b)
-> (forall a b.
a -> ErrorToIOC' s s' e m b -> ErrorToIOC' s s' e m a)
-> Functor (ErrorToIOC' s s' e m)
forall a b. a -> ErrorToIOC' s s' e m b -> ErrorToIOC' s s' e m a
forall a b.
(a -> b) -> ErrorToIOC' s s' e m a -> ErrorToIOC' s s' e m b
forall s s' e (m :: * -> *) a b.
Functor m =>
a -> ErrorToIOC' s s' e m b -> ErrorToIOC' s s' e m a
forall s s' e (m :: * -> *) a b.
Functor m =>
(a -> b) -> ErrorToIOC' s s' e m a -> ErrorToIOC' s s' e m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ErrorToIOC' s s' e m b -> ErrorToIOC' s s' e m a
$c<$ :: forall s s' e (m :: * -> *) a b.
Functor m =>
a -> ErrorToIOC' s s' e m b -> ErrorToIOC' s s' e m a
fmap :: (a -> b) -> ErrorToIOC' s s' e m a -> ErrorToIOC' s s' e m b
$cfmap :: forall s s' e (m :: * -> *) a b.
Functor m =>
(a -> b) -> ErrorToIOC' s s' e m a -> ErrorToIOC' s s' e m b
Functor, Functor (ErrorToIOC' s s' e m)
a -> ErrorToIOC' s s' e m a
Functor (ErrorToIOC' s s' e m)
-> (forall a. a -> ErrorToIOC' s s' e m a)
-> (forall a b.
ErrorToIOC' s s' e m (a -> b)
-> ErrorToIOC' s s' e m a -> ErrorToIOC' s s' e m b)
-> (forall a b c.
(a -> b -> c)
-> ErrorToIOC' s s' e m a
-> ErrorToIOC' s s' e m b
-> ErrorToIOC' s s' e m c)
-> (forall a b.
ErrorToIOC' s s' e m a
-> ErrorToIOC' s s' e m b -> ErrorToIOC' s s' e m b)
-> (forall a b.
ErrorToIOC' s s' e m a
-> ErrorToIOC' s s' e m b -> ErrorToIOC' s s' e m a)
-> Applicative (ErrorToIOC' s s' e m)
ErrorToIOC' s s' e m a
-> ErrorToIOC' s s' e m b -> ErrorToIOC' s s' e m b
ErrorToIOC' s s' e m a
-> ErrorToIOC' s s' e m b -> ErrorToIOC' s s' e m a
ErrorToIOC' s s' e m (a -> b)
-> ErrorToIOC' s s' e m a -> ErrorToIOC' s s' e m b
(a -> b -> c)
-> ErrorToIOC' s s' e m a
-> ErrorToIOC' s s' e m b
-> ErrorToIOC' s s' e m c
forall a. a -> ErrorToIOC' s s' e m a
forall a b.
ErrorToIOC' s s' e m a
-> ErrorToIOC' s s' e m b -> ErrorToIOC' s s' e m a
forall a b.
ErrorToIOC' s s' e m a
-> ErrorToIOC' s s' e m b -> ErrorToIOC' s s' e m b
forall a b.
ErrorToIOC' s s' e m (a -> b)
-> ErrorToIOC' s s' e m a -> ErrorToIOC' s s' e m b
forall a b c.
(a -> b -> c)
-> ErrorToIOC' s s' e m a
-> ErrorToIOC' s s' e m b
-> ErrorToIOC' s s' e m c
forall s s' e (m :: * -> *).
Applicative m =>
Functor (ErrorToIOC' s s' e m)
forall s s' e (m :: * -> *) a.
Applicative m =>
a -> ErrorToIOC' s s' e m a
forall s s' e (m :: * -> *) a b.
Applicative m =>
ErrorToIOC' s s' e m a
-> ErrorToIOC' s s' e m b -> ErrorToIOC' s s' e m a
forall s s' e (m :: * -> *) a b.
Applicative m =>
ErrorToIOC' s s' e m a
-> ErrorToIOC' s s' e m b -> ErrorToIOC' s s' e m b
forall s s' e (m :: * -> *) a b.
Applicative m =>
ErrorToIOC' s s' e m (a -> b)
-> ErrorToIOC' s s' e m a -> ErrorToIOC' s s' e m b
forall s s' e (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> ErrorToIOC' s s' e m a
-> ErrorToIOC' s s' e m b
-> ErrorToIOC' s s' e 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
<* :: ErrorToIOC' s s' e m a
-> ErrorToIOC' s s' e m b -> ErrorToIOC' s s' e m a
$c<* :: forall s s' e (m :: * -> *) a b.
Applicative m =>
ErrorToIOC' s s' e m a
-> ErrorToIOC' s s' e m b -> ErrorToIOC' s s' e m a
*> :: ErrorToIOC' s s' e m a
-> ErrorToIOC' s s' e m b -> ErrorToIOC' s s' e m b
$c*> :: forall s s' e (m :: * -> *) a b.
Applicative m =>
ErrorToIOC' s s' e m a
-> ErrorToIOC' s s' e m b -> ErrorToIOC' s s' e m b
liftA2 :: (a -> b -> c)
-> ErrorToIOC' s s' e m a
-> ErrorToIOC' s s' e m b
-> ErrorToIOC' s s' e m c
$cliftA2 :: forall s s' e (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> ErrorToIOC' s s' e m a
-> ErrorToIOC' s s' e m b
-> ErrorToIOC' s s' e m c
<*> :: ErrorToIOC' s s' e m (a -> b)
-> ErrorToIOC' s s' e m a -> ErrorToIOC' s s' e m b
$c<*> :: forall s s' e (m :: * -> *) a b.
Applicative m =>
ErrorToIOC' s s' e m (a -> b)
-> ErrorToIOC' s s' e m a -> ErrorToIOC' s s' e m b
pure :: a -> ErrorToIOC' s s' e m a
$cpure :: forall s s' e (m :: * -> *) a.
Applicative m =>
a -> ErrorToIOC' s s' e m a
$cp1Applicative :: forall s s' e (m :: * -> *).
Applicative m =>
Functor (ErrorToIOC' s s' e m)
Applicative, Applicative (ErrorToIOC' s s' e m)
a -> ErrorToIOC' s s' e m a
Applicative (ErrorToIOC' s s' e m)
-> (forall a b.
ErrorToIOC' s s' e m a
-> (a -> ErrorToIOC' s s' e m b) -> ErrorToIOC' s s' e m b)
-> (forall a b.
ErrorToIOC' s s' e m a
-> ErrorToIOC' s s' e m b -> ErrorToIOC' s s' e m b)
-> (forall a. a -> ErrorToIOC' s s' e m a)
-> Monad (ErrorToIOC' s s' e m)
ErrorToIOC' s s' e m a
-> (a -> ErrorToIOC' s s' e m b) -> ErrorToIOC' s s' e m b
ErrorToIOC' s s' e m a
-> ErrorToIOC' s s' e m b -> ErrorToIOC' s s' e m b
forall a. a -> ErrorToIOC' s s' e m a
forall a b.
ErrorToIOC' s s' e m a
-> ErrorToIOC' s s' e m b -> ErrorToIOC' s s' e m b
forall a b.
ErrorToIOC' s s' e m a
-> (a -> ErrorToIOC' s s' e m b) -> ErrorToIOC' s s' e m b
forall s s' e (m :: * -> *).
Monad m =>
Applicative (ErrorToIOC' s s' e m)
forall s s' e (m :: * -> *) a.
Monad m =>
a -> ErrorToIOC' s s' e m a
forall s s' e (m :: * -> *) a b.
Monad m =>
ErrorToIOC' s s' e m a
-> ErrorToIOC' s s' e m b -> ErrorToIOC' s s' e m b
forall s s' e (m :: * -> *) a b.
Monad m =>
ErrorToIOC' s s' e m a
-> (a -> ErrorToIOC' s s' e m b) -> ErrorToIOC' s s' e 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 -> ErrorToIOC' s s' e m a
$creturn :: forall s s' e (m :: * -> *) a.
Monad m =>
a -> ErrorToIOC' s s' e m a
>> :: ErrorToIOC' s s' e m a
-> ErrorToIOC' s s' e m b -> ErrorToIOC' s s' e m b
$c>> :: forall s s' e (m :: * -> *) a b.
Monad m =>
ErrorToIOC' s s' e m a
-> ErrorToIOC' s s' e m b -> ErrorToIOC' s s' e m b
>>= :: ErrorToIOC' s s' e m a
-> (a -> ErrorToIOC' s s' e m b) -> ErrorToIOC' s s' e m b
$c>>= :: forall s s' e (m :: * -> *) a b.
Monad m =>
ErrorToIOC' s s' e m a
-> (a -> ErrorToIOC' s s' e m b) -> ErrorToIOC' s s' e m b
$cp1Monad :: forall s s' e (m :: * -> *).
Monad m =>
Applicative (ErrorToIOC' s s' e m)
Monad
, Applicative (ErrorToIOC' s s' e m)
ErrorToIOC' s s' e m a
Applicative (ErrorToIOC' s s' e m)
-> (forall a. ErrorToIOC' s s' e m a)
-> (forall a.
ErrorToIOC' s s' e m a
-> ErrorToIOC' s s' e m a -> ErrorToIOC' s s' e m a)
-> (forall a. ErrorToIOC' s s' e m a -> ErrorToIOC' s s' e m [a])
-> (forall a. ErrorToIOC' s s' e m a -> ErrorToIOC' s s' e m [a])
-> Alternative (ErrorToIOC' s s' e m)
ErrorToIOC' s s' e m a
-> ErrorToIOC' s s' e m a -> ErrorToIOC' s s' e m a
ErrorToIOC' s s' e m a -> ErrorToIOC' s s' e m [a]
ErrorToIOC' s s' e m a -> ErrorToIOC' s s' e m [a]
forall a. ErrorToIOC' s s' e m a
forall a. ErrorToIOC' s s' e m a -> ErrorToIOC' s s' e m [a]
forall a.
ErrorToIOC' s s' e m a
-> ErrorToIOC' s s' e m a -> ErrorToIOC' s s' e m a
forall s s' e (m :: * -> *).
Alternative m =>
Applicative (ErrorToIOC' s s' e m)
forall s s' e (m :: * -> *) a.
Alternative m =>
ErrorToIOC' s s' e m a
forall s s' e (m :: * -> *) a.
Alternative m =>
ErrorToIOC' s s' e m a -> ErrorToIOC' s s' e m [a]
forall s s' e (m :: * -> *) a.
Alternative m =>
ErrorToIOC' s s' e m a
-> ErrorToIOC' s s' e m a -> ErrorToIOC' s s' e 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 :: ErrorToIOC' s s' e m a -> ErrorToIOC' s s' e m [a]
$cmany :: forall s s' e (m :: * -> *) a.
Alternative m =>
ErrorToIOC' s s' e m a -> ErrorToIOC' s s' e m [a]
some :: ErrorToIOC' s s' e m a -> ErrorToIOC' s s' e m [a]
$csome :: forall s s' e (m :: * -> *) a.
Alternative m =>
ErrorToIOC' s s' e m a -> ErrorToIOC' s s' e m [a]
<|> :: ErrorToIOC' s s' e m a
-> ErrorToIOC' s s' e m a -> ErrorToIOC' s s' e m a
$c<|> :: forall s s' e (m :: * -> *) a.
Alternative m =>
ErrorToIOC' s s' e m a
-> ErrorToIOC' s s' e m a -> ErrorToIOC' s s' e m a
empty :: ErrorToIOC' s s' e m a
$cempty :: forall s s' e (m :: * -> *) a.
Alternative m =>
ErrorToIOC' s s' e m a
$cp1Alternative :: forall s s' e (m :: * -> *).
Alternative m =>
Applicative (ErrorToIOC' s s' e m)
Alternative, Monad (ErrorToIOC' s s' e m)
Alternative (ErrorToIOC' s s' e m)
ErrorToIOC' s s' e m a
Alternative (ErrorToIOC' s s' e m)
-> Monad (ErrorToIOC' s s' e m)
-> (forall a. ErrorToIOC' s s' e m a)
-> (forall a.
ErrorToIOC' s s' e m a
-> ErrorToIOC' s s' e m a -> ErrorToIOC' s s' e m a)
-> MonadPlus (ErrorToIOC' s s' e m)
ErrorToIOC' s s' e m a
-> ErrorToIOC' s s' e m a -> ErrorToIOC' s s' e m a
forall a. ErrorToIOC' s s' e m a
forall a.
ErrorToIOC' s s' e m a
-> ErrorToIOC' s s' e m a -> ErrorToIOC' s s' e m a
forall s s' e (m :: * -> *).
MonadPlus m =>
Monad (ErrorToIOC' s s' e m)
forall s s' e (m :: * -> *).
MonadPlus m =>
Alternative (ErrorToIOC' s s' e m)
forall s s' e (m :: * -> *) a.
MonadPlus m =>
ErrorToIOC' s s' e m a
forall s s' e (m :: * -> *) a.
MonadPlus m =>
ErrorToIOC' s s' e m a
-> ErrorToIOC' s s' e m a -> ErrorToIOC' s s' e m a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
mplus :: ErrorToIOC' s s' e m a
-> ErrorToIOC' s s' e m a -> ErrorToIOC' s s' e m a
$cmplus :: forall s s' e (m :: * -> *) a.
MonadPlus m =>
ErrorToIOC' s s' e m a
-> ErrorToIOC' s s' e m a -> ErrorToIOC' s s' e m a
mzero :: ErrorToIOC' s s' e m a
$cmzero :: forall s s' e (m :: * -> *) a.
MonadPlus m =>
ErrorToIOC' s s' e m a
$cp2MonadPlus :: forall s s' e (m :: * -> *).
MonadPlus m =>
Monad (ErrorToIOC' s s' e m)
$cp1MonadPlus :: forall s s' e (m :: * -> *).
MonadPlus m =>
Alternative (ErrorToIOC' s s' e m)
MonadPlus
, Monad (ErrorToIOC' s s' e m)
Monad (ErrorToIOC' s s' e m)
-> (forall a.
(a -> ErrorToIOC' s s' e m a) -> ErrorToIOC' s s' e m a)
-> MonadFix (ErrorToIOC' s s' e m)
(a -> ErrorToIOC' s s' e m a) -> ErrorToIOC' s s' e m a
forall a. (a -> ErrorToIOC' s s' e m a) -> ErrorToIOC' s s' e m a
forall s s' e (m :: * -> *).
MonadFix m =>
Monad (ErrorToIOC' s s' e m)
forall s s' e (m :: * -> *) a.
MonadFix m =>
(a -> ErrorToIOC' s s' e m a) -> ErrorToIOC' s s' e m a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
mfix :: (a -> ErrorToIOC' s s' e m a) -> ErrorToIOC' s s' e m a
$cmfix :: forall s s' e (m :: * -> *) a.
MonadFix m =>
(a -> ErrorToIOC' s s' e m a) -> ErrorToIOC' s s' e m a
$cp1MonadFix :: forall s s' e (m :: * -> *).
MonadFix m =>
Monad (ErrorToIOC' s s' e m)
MonadFix, Monad (ErrorToIOC' s s' e m)
Monad (ErrorToIOC' s s' e m)
-> (forall a. String -> ErrorToIOC' s s' e m a)
-> MonadFail (ErrorToIOC' s s' e m)
String -> ErrorToIOC' s s' e m a
forall a. String -> ErrorToIOC' s s' e m a
forall s s' e (m :: * -> *).
MonadFail m =>
Monad (ErrorToIOC' s s' e m)
forall s s' e (m :: * -> *) a.
MonadFail m =>
String -> ErrorToIOC' s s' e m a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
fail :: String -> ErrorToIOC' s s' e m a
$cfail :: forall s s' e (m :: * -> *) a.
MonadFail m =>
String -> ErrorToIOC' s s' e m a
$cp1MonadFail :: forall s s' e (m :: * -> *).
MonadFail m =>
Monad (ErrorToIOC' s s' e m)
MonadFail, Monad (ErrorToIOC' s s' e m)
Monad (ErrorToIOC' s s' e m)
-> (forall a. IO a -> ErrorToIOC' s s' e m a)
-> MonadIO (ErrorToIOC' s s' e m)
IO a -> ErrorToIOC' s s' e m a
forall a. IO a -> ErrorToIOC' s s' e m a
forall s s' e (m :: * -> *).
MonadIO m =>
Monad (ErrorToIOC' s s' e m)
forall s s' e (m :: * -> *) a.
MonadIO m =>
IO a -> ErrorToIOC' s s' e m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> ErrorToIOC' s s' e m a
$cliftIO :: forall s s' e (m :: * -> *) a.
MonadIO m =>
IO a -> ErrorToIOC' s s' e m a
$cp1MonadIO :: forall s s' e (m :: * -> *).
MonadIO m =>
Monad (ErrorToIOC' s s' e m)
MonadIO
, Monad (ErrorToIOC' s s' e m)
e -> ErrorToIOC' s s' e m a
Monad (ErrorToIOC' s s' e m)
-> (forall e a. Exception e => e -> ErrorToIOC' s s' e m a)
-> MonadThrow (ErrorToIOC' s s' e m)
forall e a. Exception e => e -> ErrorToIOC' s s' e m a
forall s s' e (m :: * -> *).
MonadThrow m =>
Monad (ErrorToIOC' s s' e m)
forall s s' e (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> ErrorToIOC' s s' e m a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: e -> ErrorToIOC' s s' e m a
$cthrowM :: forall s s' e (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> ErrorToIOC' s s' e m a
$cp1MonadThrow :: forall s s' e (m :: * -> *).
MonadThrow m =>
Monad (ErrorToIOC' s s' e m)
MonadThrow, MonadThrow (ErrorToIOC' s s' e m)
MonadThrow (ErrorToIOC' s s' e m)
-> (forall e a.
Exception e =>
ErrorToIOC' s s' e m a
-> (e -> ErrorToIOC' s s' e m a) -> ErrorToIOC' s s' e m a)
-> MonadCatch (ErrorToIOC' s s' e m)
ErrorToIOC' s s' e m a
-> (e -> ErrorToIOC' s s' e m a) -> ErrorToIOC' s s' e m a
forall e a.
Exception e =>
ErrorToIOC' s s' e m a
-> (e -> ErrorToIOC' s s' e m a) -> ErrorToIOC' s s' e m a
forall s s' e (m :: * -> *).
MonadCatch m =>
MonadThrow (ErrorToIOC' s s' e m)
forall s s' e (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
ErrorToIOC' s s' e m a
-> (e -> ErrorToIOC' s s' e m a) -> ErrorToIOC' s s' e m a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
catch :: ErrorToIOC' s s' e m a
-> (e -> ErrorToIOC' s s' e m a) -> ErrorToIOC' s s' e m a
$ccatch :: forall s s' e (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
ErrorToIOC' s s' e m a
-> (e -> ErrorToIOC' s s' e m a) -> ErrorToIOC' s s' e m a
$cp1MonadCatch :: forall s s' e (m :: * -> *).
MonadCatch m =>
MonadThrow (ErrorToIOC' s s' e m)
MonadCatch, MonadCatch (ErrorToIOC' s s' e m)
MonadCatch (ErrorToIOC' s s' e m)
-> (forall b.
((forall a. ErrorToIOC' s s' e m a -> ErrorToIOC' s s' e m a)
-> ErrorToIOC' s s' e m b)
-> ErrorToIOC' s s' e m b)
-> (forall b.
((forall a. ErrorToIOC' s s' e m a -> ErrorToIOC' s s' e m a)
-> ErrorToIOC' s s' e m b)
-> ErrorToIOC' s s' e m b)
-> (forall a b c.
ErrorToIOC' s s' e m a
-> (a -> ExitCase b -> ErrorToIOC' s s' e m c)
-> (a -> ErrorToIOC' s s' e m b)
-> ErrorToIOC' s s' e m (b, c))
-> MonadMask (ErrorToIOC' s s' e m)
ErrorToIOC' s s' e m a
-> (a -> ExitCase b -> ErrorToIOC' s s' e m c)
-> (a -> ErrorToIOC' s s' e m b)
-> ErrorToIOC' s s' e m (b, c)
((forall a. ErrorToIOC' s s' e m a -> ErrorToIOC' s s' e m a)
-> ErrorToIOC' s s' e m b)
-> ErrorToIOC' s s' e m b
((forall a. ErrorToIOC' s s' e m a -> ErrorToIOC' s s' e m a)
-> ErrorToIOC' s s' e m b)
-> ErrorToIOC' s s' e m b
forall b.
((forall a. ErrorToIOC' s s' e m a -> ErrorToIOC' s s' e m a)
-> ErrorToIOC' s s' e m b)
-> ErrorToIOC' s s' e m b
forall a b c.
ErrorToIOC' s s' e m a
-> (a -> ExitCase b -> ErrorToIOC' s s' e m c)
-> (a -> ErrorToIOC' s s' e m b)
-> ErrorToIOC' s s' e m (b, c)
forall s s' e (m :: * -> *).
MonadMask m =>
MonadCatch (ErrorToIOC' s s' e m)
forall s s' e (m :: * -> *) b.
MonadMask m =>
((forall a. ErrorToIOC' s s' e m a -> ErrorToIOC' s s' e m a)
-> ErrorToIOC' s s' e m b)
-> ErrorToIOC' s s' e m b
forall s s' e (m :: * -> *) a b c.
MonadMask m =>
ErrorToIOC' s s' e m a
-> (a -> ExitCase b -> ErrorToIOC' s s' e m c)
-> (a -> ErrorToIOC' s s' e m b)
-> ErrorToIOC' s s' e 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 :: ErrorToIOC' s s' e m a
-> (a -> ExitCase b -> ErrorToIOC' s s' e m c)
-> (a -> ErrorToIOC' s s' e m b)
-> ErrorToIOC' s s' e m (b, c)
$cgeneralBracket :: forall s s' e (m :: * -> *) a b c.
MonadMask m =>
ErrorToIOC' s s' e m a
-> (a -> ExitCase b -> ErrorToIOC' s s' e m c)
-> (a -> ErrorToIOC' s s' e m b)
-> ErrorToIOC' s s' e m (b, c)
uninterruptibleMask :: ((forall a. ErrorToIOC' s s' e m a -> ErrorToIOC' s s' e m a)
-> ErrorToIOC' s s' e m b)
-> ErrorToIOC' s s' e m b
$cuninterruptibleMask :: forall s s' e (m :: * -> *) b.
MonadMask m =>
((forall a. ErrorToIOC' s s' e m a -> ErrorToIOC' s s' e m a)
-> ErrorToIOC' s s' e m b)
-> ErrorToIOC' s s' e m b
mask :: ((forall a. ErrorToIOC' s s' e m a -> ErrorToIOC' s s' e m a)
-> ErrorToIOC' s s' e m b)
-> ErrorToIOC' s s' e m b
$cmask :: forall s s' e (m :: * -> *) b.
MonadMask m =>
((forall a. ErrorToIOC' s s' e m a -> ErrorToIOC' s s' e m a)
-> ErrorToIOC' s s' e m b)
-> ErrorToIOC' s s' e m b
$cp1MonadMask :: forall s s' e (m :: * -> *).
MonadMask m =>
MonadCatch (ErrorToIOC' s s' e m)
MonadMask
, MonadBase b, MonadBaseControl b
)
deriving (m a -> ErrorToIOC' s s' e m a
(forall (m :: * -> *) a. Monad m => m a -> ErrorToIOC' s s' e m a)
-> MonadTrans (ErrorToIOC' s s' e)
forall s s' e (m :: * -> *) a.
Monad m =>
m a -> ErrorToIOC' s s' e m a
forall (m :: * -> *) a. Monad m => m a -> ErrorToIOC' s s' e m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> ErrorToIOC' s s' e m a
$clift :: forall s s' e (m :: * -> *) a.
Monad m =>
m a -> ErrorToIOC' s s' e m a
MonadTrans, MonadTrans (ErrorToIOC' s s' e)
m (StT (ErrorToIOC' s s' e) a) -> ErrorToIOC' s s' e m a
MonadTrans (ErrorToIOC' s s' e)
-> (forall (m :: * -> *) a.
Monad m =>
(Run (ErrorToIOC' s s' e) -> m a) -> ErrorToIOC' s s' e m a)
-> (forall (m :: * -> *) a.
Monad m =>
m (StT (ErrorToIOC' s s' e) a) -> ErrorToIOC' s s' e m a)
-> MonadTransControl (ErrorToIOC' s s' e)
(Run (ErrorToIOC' s s' e) -> m a) -> ErrorToIOC' s s' e m a
forall s s' e. MonadTrans (ErrorToIOC' s s' e)
forall s s' e (m :: * -> *) a.
Monad m =>
m (StT (ErrorToIOC' s s' e) a) -> ErrorToIOC' s s' e m a
forall s s' e (m :: * -> *) a.
Monad m =>
(Run (ErrorToIOC' s s' e) -> m a) -> ErrorToIOC' s s' e m a
forall (m :: * -> *) a.
Monad m =>
m (StT (ErrorToIOC' s s' e) a) -> ErrorToIOC' s s' e m a
forall (m :: * -> *) a.
Monad m =>
(Run (ErrorToIOC' s s' e) -> m a) -> ErrorToIOC' s s' e m a
forall (t :: (* -> *) -> * -> *).
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 (ErrorToIOC' s s' e) a) -> ErrorToIOC' s s' e m a
$crestoreT :: forall s s' e (m :: * -> *) a.
Monad m =>
m (StT (ErrorToIOC' s s' e) a) -> ErrorToIOC' s s' e m a
liftWith :: (Run (ErrorToIOC' s s' e) -> m a) -> ErrorToIOC' s s' e m a
$cliftWith :: forall s s' e (m :: * -> *) a.
Monad m =>
(Run (ErrorToIOC' s s' e) -> m a) -> ErrorToIOC' s s' e m a
$cp1MonadTransControl :: forall s s' e. MonadTrans (ErrorToIOC' s s' e)
MonadTransControl)
via CompositionBaseT
'[ IntroC '[Catch e, Throw e] '[ErrorIO]
, InterpretErrorC' s s' e
, ErrorIOToIOC
]
deriving instance ( Carrier m, C.MonadCatch m
, ReifiesErrorHandler s s' e (ErrorIOToIOC m)
)
=> Carrier (ErrorToIOC' s s' e m)
type ErrorToIOC e m a =
forall s s'
. ReifiesErrorHandler s s' e (ErrorIOToIOC m)
=> ErrorToIOC' s s' e m a
data OpaqueExc = OpaqueExc Unique Any
instance Show OpaqueExc where
showsPrec :: Int -> OpaqueExc -> ShowS
showsPrec Int
_ (OpaqueExc Unique
uniq Any
_) =
String -> ShowS
showString String
"errorToIO/errorToErrorIO: Escaped opaque exception. \
\Unique hash is: " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Show a => a -> ShowS
shows (Unique -> Int
hashUnique Unique
uniq) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
". \
\This should only happen if the computation that threw the \
\exception was somehow invoked outside of the argument of \
\'errorToIO'; for example, if you 'async' an exceptional \
\computation inside of the argument provided to 'errorToIO', \
\and then 'await' on it *outside* of the argument provided to \
\'errorToIO'. \
\If that or any similar shenanigans seems unlikely, then \
\please open an issue on the GitHub repository."
instance X.Exception OpaqueExc
errorToErrorIO :: forall e m a
. Effs '[ErrorIO, Embed IO] m
=> InterpretErrorC e m a
-> m (Either e a)
errorToErrorIO :: InterpretErrorC e m a -> m (Either e a)
errorToErrorIO InterpretErrorC e m a
main = do
!Unique
uniq <- IO Unique -> m Unique
forall (b :: * -> *) (m :: * -> *) a. Eff (Embed b) m => b a -> m a
embed IO Unique
newUnique
let
main' :: m a
main' =
EffHandler (Throw e) m -> InterpretReifiedC (Throw e) m a -> m a
forall (e :: (* -> *) -> * -> *) (m :: * -> *) a.
(RepresentationalEff e, Carrier m) =>
EffHandler e m -> InterpretReifiedC e m a -> m a
interpret \case
Throw e -> OpaqueExc -> Effly z x
forall e (m :: * -> *) a. (Exception e, Eff ErrorIO m) => e -> m a
throwIO (Unique -> Any -> OpaqueExc
OpaqueExc Unique
uniq (e -> Any
forall a b. a -> b
unsafeCoerce e
e))
(InterpretReifiedC (Throw e) m a -> m a)
-> InterpretReifiedC (Throw e) m a -> m a
forall a b. (a -> b) -> a -> b
$ EffHandler (Catch e) (InterpretC (ViaReifiedH s) (Throw e) m)
-> InterpretReifiedC
(Catch e) (InterpretC (ViaReifiedH s) (Throw e) m) a
-> InterpretC (ViaReifiedH s) (Throw e) m a
forall (e :: (* -> *) -> * -> *) (m :: * -> *) a.
(RepresentationalEff e, Carrier m) =>
EffHandler e m -> InterpretReifiedC e m a -> m a
interpret \case
Catch m h -> Effly z x
m Effly z x -> (OpaqueExc -> Effly z x) -> Effly z x
forall e (m :: * -> *) a.
(Exception e, Eff ErrorIO m) =>
m a -> (e -> m a) -> m a
`catchIO` \exc :: OpaqueExc
exc@(OpaqueExc Unique
uniq' Any
e) ->
if Unique
uniq Unique -> Unique -> Bool
forall a. Eq a => a -> a -> Bool
== Unique
uniq' then
e -> Effly z x
h (Any -> e
forall a b. a -> b
unsafeCoerce Any
e)
else
OpaqueExc -> Effly z x
forall e (m :: * -> *) a. (Exception e, Eff ErrorIO m) => e -> m a
throwIO OpaqueExc
exc
(InterpretReifiedC
(Catch e) (InterpretC (ViaReifiedH s) (Throw e) m) a
-> InterpretC (ViaReifiedH s) (Throw e) m a)
-> InterpretReifiedC
(Catch e) (InterpretC (ViaReifiedH s) (Throw e) m) a
-> InterpretC (ViaReifiedH s) (Throw e) m a
forall a b. (a -> b) -> a -> b
$ InterpretErrorC' s s e m a
-> InterpretC
(ViaReifiedH s)
(Catch e)
(InterpretC (ViaReifiedH s) (Throw e) m)
a
forall s s' e (m :: * -> *) a.
InterpretErrorC' s s' e m a
-> InterpretC
(ViaReifiedH s)
(Catch e)
(InterpretC (ViaReifiedH s') (Throw e) m)
a
unInterpretErrorC'
(InterpretErrorC' s s e m a
-> InterpretC
(ViaReifiedH s)
(Catch e)
(InterpretC (ViaReifiedH s) (Throw e) m)
a)
-> InterpretErrorC' s s e m a
-> InterpretC
(ViaReifiedH s)
(Catch e)
(InterpretC (ViaReifiedH s) (Throw e) m)
a
forall a b. (a -> b) -> a -> b
$ InterpretErrorC' s s e m a
InterpretErrorC e m a
main
(a -> Either e a) -> m a -> m (Either e a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Either e a
forall a b. b -> Either a b
Right m a
main' m (Either e a) -> (OpaqueExc -> m (Either e a)) -> m (Either e a)
forall e (m :: * -> *) a.
(Exception e, Eff ErrorIO m) =>
m a -> (e -> m a) -> m a
`catchIO` \exc :: OpaqueExc
exc@(OpaqueExc Unique
uniq' Any
e) ->
if Unique
uniq Unique -> Unique -> Bool
forall a. Eq a => a -> a -> Bool
== Unique
uniq' then
Either e a -> m (Either e a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either e a -> m (Either e a)) -> Either e a -> m (Either e a)
forall a b. (a -> b) -> a -> b
$ e -> Either e a
forall a b. a -> Either a b
Left (Any -> e
forall a b. a -> b
unsafeCoerce Any
e)
else
OpaqueExc -> m (Either e a)
forall e (m :: * -> *) a. (Exception e, Eff ErrorIO m) => e -> m a
throwIO OpaqueExc
exc
data ErrorToErrorIOAsExcH
instance (Eff ErrorIO m, Exception e)
=> Handler ErrorToErrorIOAsExcH (Throw e) m where
effHandler :: Throw e (Effly z) x -> Effly z x
effHandler (Throw e
e) = e -> Effly z x
forall e (m :: * -> *) a. (Exception e, Eff ErrorIO m) => e -> m a
throwIO e
e
instance (Eff ErrorIO m, Exception e)
=> Handler ErrorToErrorIOAsExcH (Catch e) m where
effHandler :: Catch e (Effly z) x -> Effly z x
effHandler (Catch Effly z x
m e -> Effly z x
f) = Effly z x
m Effly z x -> (e -> Effly z x) -> Effly z x
forall e (m :: * -> *) a.
(Exception e, Eff ErrorIO m) =>
m a -> (e -> m a) -> m a
`catchIO` e -> Effly z x
f
newtype ErrorToErrorIOAsExcC e m a = ErrorToErrorIOAsExcC {
ErrorToErrorIOAsExcC e m a
-> InterpretC
ErrorToErrorIOAsExcH
(Catch e)
(InterpretC ErrorToErrorIOAsExcH (Throw e) m)
a
unErrorToErrorIOAsExcC ::
InterpretC ErrorToErrorIOAsExcH (Catch e)
( InterpretC ErrorToErrorIOAsExcH (Throw e)
( m
)) a
} deriving ( a -> ErrorToErrorIOAsExcC e m b -> ErrorToErrorIOAsExcC e m a
(a -> b)
-> ErrorToErrorIOAsExcC e m a -> ErrorToErrorIOAsExcC e m b
(forall a b.
(a -> b)
-> ErrorToErrorIOAsExcC e m a -> ErrorToErrorIOAsExcC e m b)
-> (forall a b.
a -> ErrorToErrorIOAsExcC e m b -> ErrorToErrorIOAsExcC e m a)
-> Functor (ErrorToErrorIOAsExcC e m)
forall a b.
a -> ErrorToErrorIOAsExcC e m b -> ErrorToErrorIOAsExcC e m a
forall a b.
(a -> b)
-> ErrorToErrorIOAsExcC e m a -> ErrorToErrorIOAsExcC e m b
forall e (m :: * -> *) a b.
Functor m =>
a -> ErrorToErrorIOAsExcC e m b -> ErrorToErrorIOAsExcC e m a
forall e (m :: * -> *) a b.
Functor m =>
(a -> b)
-> ErrorToErrorIOAsExcC e m a -> ErrorToErrorIOAsExcC e m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ErrorToErrorIOAsExcC e m b -> ErrorToErrorIOAsExcC e m a
$c<$ :: forall e (m :: * -> *) a b.
Functor m =>
a -> ErrorToErrorIOAsExcC e m b -> ErrorToErrorIOAsExcC e m a
fmap :: (a -> b)
-> ErrorToErrorIOAsExcC e m a -> ErrorToErrorIOAsExcC e m b
$cfmap :: forall e (m :: * -> *) a b.
Functor m =>
(a -> b)
-> ErrorToErrorIOAsExcC e m a -> ErrorToErrorIOAsExcC e m b
Functor, Functor (ErrorToErrorIOAsExcC e m)
a -> ErrorToErrorIOAsExcC e m a
Functor (ErrorToErrorIOAsExcC e m)
-> (forall a. a -> ErrorToErrorIOAsExcC e m a)
-> (forall a b.
ErrorToErrorIOAsExcC e m (a -> b)
-> ErrorToErrorIOAsExcC e m a -> ErrorToErrorIOAsExcC e m b)
-> (forall a b c.
(a -> b -> c)
-> ErrorToErrorIOAsExcC e m a
-> ErrorToErrorIOAsExcC e m b
-> ErrorToErrorIOAsExcC e m c)
-> (forall a b.
ErrorToErrorIOAsExcC e m a
-> ErrorToErrorIOAsExcC e m b -> ErrorToErrorIOAsExcC e m b)
-> (forall a b.
ErrorToErrorIOAsExcC e m a
-> ErrorToErrorIOAsExcC e m b -> ErrorToErrorIOAsExcC e m a)
-> Applicative (ErrorToErrorIOAsExcC e m)
ErrorToErrorIOAsExcC e m a
-> ErrorToErrorIOAsExcC e m b -> ErrorToErrorIOAsExcC e m b
ErrorToErrorIOAsExcC e m a
-> ErrorToErrorIOAsExcC e m b -> ErrorToErrorIOAsExcC e m a
ErrorToErrorIOAsExcC e m (a -> b)
-> ErrorToErrorIOAsExcC e m a -> ErrorToErrorIOAsExcC e m b
(a -> b -> c)
-> ErrorToErrorIOAsExcC e m a
-> ErrorToErrorIOAsExcC e m b
-> ErrorToErrorIOAsExcC e m c
forall a. a -> ErrorToErrorIOAsExcC e m a
forall a b.
ErrorToErrorIOAsExcC e m a
-> ErrorToErrorIOAsExcC e m b -> ErrorToErrorIOAsExcC e m a
forall a b.
ErrorToErrorIOAsExcC e m a
-> ErrorToErrorIOAsExcC e m b -> ErrorToErrorIOAsExcC e m b
forall a b.
ErrorToErrorIOAsExcC e m (a -> b)
-> ErrorToErrorIOAsExcC e m a -> ErrorToErrorIOAsExcC e m b
forall a b c.
(a -> b -> c)
-> ErrorToErrorIOAsExcC e m a
-> ErrorToErrorIOAsExcC e m b
-> ErrorToErrorIOAsExcC e m c
forall e (m :: * -> *).
Applicative m =>
Functor (ErrorToErrorIOAsExcC e m)
forall e (m :: * -> *) a.
Applicative m =>
a -> ErrorToErrorIOAsExcC e m a
forall e (m :: * -> *) a b.
Applicative m =>
ErrorToErrorIOAsExcC e m a
-> ErrorToErrorIOAsExcC e m b -> ErrorToErrorIOAsExcC e m a
forall e (m :: * -> *) a b.
Applicative m =>
ErrorToErrorIOAsExcC e m a
-> ErrorToErrorIOAsExcC e m b -> ErrorToErrorIOAsExcC e m b
forall e (m :: * -> *) a b.
Applicative m =>
ErrorToErrorIOAsExcC e m (a -> b)
-> ErrorToErrorIOAsExcC e m a -> ErrorToErrorIOAsExcC e m b
forall e (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> ErrorToErrorIOAsExcC e m a
-> ErrorToErrorIOAsExcC e m b
-> ErrorToErrorIOAsExcC e 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
<* :: ErrorToErrorIOAsExcC e m a
-> ErrorToErrorIOAsExcC e m b -> ErrorToErrorIOAsExcC e m a
$c<* :: forall e (m :: * -> *) a b.
Applicative m =>
ErrorToErrorIOAsExcC e m a
-> ErrorToErrorIOAsExcC e m b -> ErrorToErrorIOAsExcC e m a
*> :: ErrorToErrorIOAsExcC e m a
-> ErrorToErrorIOAsExcC e m b -> ErrorToErrorIOAsExcC e m b
$c*> :: forall e (m :: * -> *) a b.
Applicative m =>
ErrorToErrorIOAsExcC e m a
-> ErrorToErrorIOAsExcC e m b -> ErrorToErrorIOAsExcC e m b
liftA2 :: (a -> b -> c)
-> ErrorToErrorIOAsExcC e m a
-> ErrorToErrorIOAsExcC e m b
-> ErrorToErrorIOAsExcC e m c
$cliftA2 :: forall e (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> ErrorToErrorIOAsExcC e m a
-> ErrorToErrorIOAsExcC e m b
-> ErrorToErrorIOAsExcC e m c
<*> :: ErrorToErrorIOAsExcC e m (a -> b)
-> ErrorToErrorIOAsExcC e m a -> ErrorToErrorIOAsExcC e m b
$c<*> :: forall e (m :: * -> *) a b.
Applicative m =>
ErrorToErrorIOAsExcC e m (a -> b)
-> ErrorToErrorIOAsExcC e m a -> ErrorToErrorIOAsExcC e m b
pure :: a -> ErrorToErrorIOAsExcC e m a
$cpure :: forall e (m :: * -> *) a.
Applicative m =>
a -> ErrorToErrorIOAsExcC e m a
$cp1Applicative :: forall e (m :: * -> *).
Applicative m =>
Functor (ErrorToErrorIOAsExcC e m)
Applicative, Applicative (ErrorToErrorIOAsExcC e m)
a -> ErrorToErrorIOAsExcC e m a
Applicative (ErrorToErrorIOAsExcC e m)
-> (forall a b.
ErrorToErrorIOAsExcC e m a
-> (a -> ErrorToErrorIOAsExcC e m b) -> ErrorToErrorIOAsExcC e m b)
-> (forall a b.
ErrorToErrorIOAsExcC e m a
-> ErrorToErrorIOAsExcC e m b -> ErrorToErrorIOAsExcC e m b)
-> (forall a. a -> ErrorToErrorIOAsExcC e m a)
-> Monad (ErrorToErrorIOAsExcC e m)
ErrorToErrorIOAsExcC e m a
-> (a -> ErrorToErrorIOAsExcC e m b) -> ErrorToErrorIOAsExcC e m b
ErrorToErrorIOAsExcC e m a
-> ErrorToErrorIOAsExcC e m b -> ErrorToErrorIOAsExcC e m b
forall a. a -> ErrorToErrorIOAsExcC e m a
forall a b.
ErrorToErrorIOAsExcC e m a
-> ErrorToErrorIOAsExcC e m b -> ErrorToErrorIOAsExcC e m b
forall a b.
ErrorToErrorIOAsExcC e m a
-> (a -> ErrorToErrorIOAsExcC e m b) -> ErrorToErrorIOAsExcC e m b
forall e (m :: * -> *).
Monad m =>
Applicative (ErrorToErrorIOAsExcC e m)
forall e (m :: * -> *) a.
Monad m =>
a -> ErrorToErrorIOAsExcC e m a
forall e (m :: * -> *) a b.
Monad m =>
ErrorToErrorIOAsExcC e m a
-> ErrorToErrorIOAsExcC e m b -> ErrorToErrorIOAsExcC e m b
forall e (m :: * -> *) a b.
Monad m =>
ErrorToErrorIOAsExcC e m a
-> (a -> ErrorToErrorIOAsExcC e m b) -> ErrorToErrorIOAsExcC e 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 -> ErrorToErrorIOAsExcC e m a
$creturn :: forall e (m :: * -> *) a.
Monad m =>
a -> ErrorToErrorIOAsExcC e m a
>> :: ErrorToErrorIOAsExcC e m a
-> ErrorToErrorIOAsExcC e m b -> ErrorToErrorIOAsExcC e m b
$c>> :: forall e (m :: * -> *) a b.
Monad m =>
ErrorToErrorIOAsExcC e m a
-> ErrorToErrorIOAsExcC e m b -> ErrorToErrorIOAsExcC e m b
>>= :: ErrorToErrorIOAsExcC e m a
-> (a -> ErrorToErrorIOAsExcC e m b) -> ErrorToErrorIOAsExcC e m b
$c>>= :: forall e (m :: * -> *) a b.
Monad m =>
ErrorToErrorIOAsExcC e m a
-> (a -> ErrorToErrorIOAsExcC e m b) -> ErrorToErrorIOAsExcC e m b
$cp1Monad :: forall e (m :: * -> *).
Monad m =>
Applicative (ErrorToErrorIOAsExcC e m)
Monad
, Applicative (ErrorToErrorIOAsExcC e m)
ErrorToErrorIOAsExcC e m a
Applicative (ErrorToErrorIOAsExcC e m)
-> (forall a. ErrorToErrorIOAsExcC e m a)
-> (forall a.
ErrorToErrorIOAsExcC e m a
-> ErrorToErrorIOAsExcC e m a -> ErrorToErrorIOAsExcC e m a)
-> (forall a.
ErrorToErrorIOAsExcC e m a -> ErrorToErrorIOAsExcC e m [a])
-> (forall a.
ErrorToErrorIOAsExcC e m a -> ErrorToErrorIOAsExcC e m [a])
-> Alternative (ErrorToErrorIOAsExcC e m)
ErrorToErrorIOAsExcC e m a
-> ErrorToErrorIOAsExcC e m a -> ErrorToErrorIOAsExcC e m a
ErrorToErrorIOAsExcC e m a -> ErrorToErrorIOAsExcC e m [a]
ErrorToErrorIOAsExcC e m a -> ErrorToErrorIOAsExcC e m [a]
forall a. ErrorToErrorIOAsExcC e m a
forall a.
ErrorToErrorIOAsExcC e m a -> ErrorToErrorIOAsExcC e m [a]
forall a.
ErrorToErrorIOAsExcC e m a
-> ErrorToErrorIOAsExcC e m a -> ErrorToErrorIOAsExcC e m a
forall e (m :: * -> *).
Alternative m =>
Applicative (ErrorToErrorIOAsExcC e m)
forall e (m :: * -> *) a.
Alternative m =>
ErrorToErrorIOAsExcC e m a
forall e (m :: * -> *) a.
Alternative m =>
ErrorToErrorIOAsExcC e m a -> ErrorToErrorIOAsExcC e m [a]
forall e (m :: * -> *) a.
Alternative m =>
ErrorToErrorIOAsExcC e m a
-> ErrorToErrorIOAsExcC e m a -> ErrorToErrorIOAsExcC e 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 :: ErrorToErrorIOAsExcC e m a -> ErrorToErrorIOAsExcC e m [a]
$cmany :: forall e (m :: * -> *) a.
Alternative m =>
ErrorToErrorIOAsExcC e m a -> ErrorToErrorIOAsExcC e m [a]
some :: ErrorToErrorIOAsExcC e m a -> ErrorToErrorIOAsExcC e m [a]
$csome :: forall e (m :: * -> *) a.
Alternative m =>
ErrorToErrorIOAsExcC e m a -> ErrorToErrorIOAsExcC e m [a]
<|> :: ErrorToErrorIOAsExcC e m a
-> ErrorToErrorIOAsExcC e m a -> ErrorToErrorIOAsExcC e m a
$c<|> :: forall e (m :: * -> *) a.
Alternative m =>
ErrorToErrorIOAsExcC e m a
-> ErrorToErrorIOAsExcC e m a -> ErrorToErrorIOAsExcC e m a
empty :: ErrorToErrorIOAsExcC e m a
$cempty :: forall e (m :: * -> *) a.
Alternative m =>
ErrorToErrorIOAsExcC e m a
$cp1Alternative :: forall e (m :: * -> *).
Alternative m =>
Applicative (ErrorToErrorIOAsExcC e m)
Alternative, Monad (ErrorToErrorIOAsExcC e m)
Alternative (ErrorToErrorIOAsExcC e m)
ErrorToErrorIOAsExcC e m a
Alternative (ErrorToErrorIOAsExcC e m)
-> Monad (ErrorToErrorIOAsExcC e m)
-> (forall a. ErrorToErrorIOAsExcC e m a)
-> (forall a.
ErrorToErrorIOAsExcC e m a
-> ErrorToErrorIOAsExcC e m a -> ErrorToErrorIOAsExcC e m a)
-> MonadPlus (ErrorToErrorIOAsExcC e m)
ErrorToErrorIOAsExcC e m a
-> ErrorToErrorIOAsExcC e m a -> ErrorToErrorIOAsExcC e m a
forall a. ErrorToErrorIOAsExcC e m a
forall a.
ErrorToErrorIOAsExcC e m a
-> ErrorToErrorIOAsExcC e m a -> ErrorToErrorIOAsExcC e m a
forall e (m :: * -> *).
MonadPlus m =>
Monad (ErrorToErrorIOAsExcC e m)
forall e (m :: * -> *).
MonadPlus m =>
Alternative (ErrorToErrorIOAsExcC e m)
forall e (m :: * -> *) a. MonadPlus m => ErrorToErrorIOAsExcC e m a
forall e (m :: * -> *) a.
MonadPlus m =>
ErrorToErrorIOAsExcC e m a
-> ErrorToErrorIOAsExcC e m a -> ErrorToErrorIOAsExcC e m a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
mplus :: ErrorToErrorIOAsExcC e m a
-> ErrorToErrorIOAsExcC e m a -> ErrorToErrorIOAsExcC e m a
$cmplus :: forall e (m :: * -> *) a.
MonadPlus m =>
ErrorToErrorIOAsExcC e m a
-> ErrorToErrorIOAsExcC e m a -> ErrorToErrorIOAsExcC e m a
mzero :: ErrorToErrorIOAsExcC e m a
$cmzero :: forall e (m :: * -> *) a. MonadPlus m => ErrorToErrorIOAsExcC e m a
$cp2MonadPlus :: forall e (m :: * -> *).
MonadPlus m =>
Monad (ErrorToErrorIOAsExcC e m)
$cp1MonadPlus :: forall e (m :: * -> *).
MonadPlus m =>
Alternative (ErrorToErrorIOAsExcC e m)
MonadPlus
, Monad (ErrorToErrorIOAsExcC e m)
Monad (ErrorToErrorIOAsExcC e m)
-> (forall a.
(a -> ErrorToErrorIOAsExcC e m a) -> ErrorToErrorIOAsExcC e m a)
-> MonadFix (ErrorToErrorIOAsExcC e m)
(a -> ErrorToErrorIOAsExcC e m a) -> ErrorToErrorIOAsExcC e m a
forall a.
(a -> ErrorToErrorIOAsExcC e m a) -> ErrorToErrorIOAsExcC e m a
forall e (m :: * -> *).
MonadFix m =>
Monad (ErrorToErrorIOAsExcC e m)
forall e (m :: * -> *) a.
MonadFix m =>
(a -> ErrorToErrorIOAsExcC e m a) -> ErrorToErrorIOAsExcC e m a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
mfix :: (a -> ErrorToErrorIOAsExcC e m a) -> ErrorToErrorIOAsExcC e m a
$cmfix :: forall e (m :: * -> *) a.
MonadFix m =>
(a -> ErrorToErrorIOAsExcC e m a) -> ErrorToErrorIOAsExcC e m a
$cp1MonadFix :: forall e (m :: * -> *).
MonadFix m =>
Monad (ErrorToErrorIOAsExcC e m)
MonadFix, Monad (ErrorToErrorIOAsExcC e m)
Monad (ErrorToErrorIOAsExcC e m)
-> (forall a. String -> ErrorToErrorIOAsExcC e m a)
-> MonadFail (ErrorToErrorIOAsExcC e m)
String -> ErrorToErrorIOAsExcC e m a
forall a. String -> ErrorToErrorIOAsExcC e m a
forall e (m :: * -> *).
MonadFail m =>
Monad (ErrorToErrorIOAsExcC e m)
forall e (m :: * -> *) a.
MonadFail m =>
String -> ErrorToErrorIOAsExcC e m a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
fail :: String -> ErrorToErrorIOAsExcC e m a
$cfail :: forall e (m :: * -> *) a.
MonadFail m =>
String -> ErrorToErrorIOAsExcC e m a
$cp1MonadFail :: forall e (m :: * -> *).
MonadFail m =>
Monad (ErrorToErrorIOAsExcC e m)
MonadFail, Monad (ErrorToErrorIOAsExcC e m)
Monad (ErrorToErrorIOAsExcC e m)
-> (forall a. IO a -> ErrorToErrorIOAsExcC e m a)
-> MonadIO (ErrorToErrorIOAsExcC e m)
IO a -> ErrorToErrorIOAsExcC e m a
forall a. IO a -> ErrorToErrorIOAsExcC e m a
forall e (m :: * -> *).
MonadIO m =>
Monad (ErrorToErrorIOAsExcC e m)
forall e (m :: * -> *) a.
MonadIO m =>
IO a -> ErrorToErrorIOAsExcC e m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> ErrorToErrorIOAsExcC e m a
$cliftIO :: forall e (m :: * -> *) a.
MonadIO m =>
IO a -> ErrorToErrorIOAsExcC e m a
$cp1MonadIO :: forall e (m :: * -> *).
MonadIO m =>
Monad (ErrorToErrorIOAsExcC e m)
MonadIO
, Monad (ErrorToErrorIOAsExcC e m)
e -> ErrorToErrorIOAsExcC e m a
Monad (ErrorToErrorIOAsExcC e m)
-> (forall e a. Exception e => e -> ErrorToErrorIOAsExcC e m a)
-> MonadThrow (ErrorToErrorIOAsExcC e m)
forall e a. Exception e => e -> ErrorToErrorIOAsExcC e m a
forall e (m :: * -> *).
MonadThrow m =>
Monad (ErrorToErrorIOAsExcC e m)
forall e (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> ErrorToErrorIOAsExcC e m a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: e -> ErrorToErrorIOAsExcC e m a
$cthrowM :: forall e (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> ErrorToErrorIOAsExcC e m a
$cp1MonadThrow :: forall e (m :: * -> *).
MonadThrow m =>
Monad (ErrorToErrorIOAsExcC e m)
MonadThrow, MonadThrow (ErrorToErrorIOAsExcC e m)
MonadThrow (ErrorToErrorIOAsExcC e m)
-> (forall e a.
Exception e =>
ErrorToErrorIOAsExcC e m a
-> (e -> ErrorToErrorIOAsExcC e m a) -> ErrorToErrorIOAsExcC e m a)
-> MonadCatch (ErrorToErrorIOAsExcC e m)
ErrorToErrorIOAsExcC e m a
-> (e -> ErrorToErrorIOAsExcC e m a) -> ErrorToErrorIOAsExcC e m a
forall e a.
Exception e =>
ErrorToErrorIOAsExcC e m a
-> (e -> ErrorToErrorIOAsExcC e m a) -> ErrorToErrorIOAsExcC e m a
forall e (m :: * -> *).
MonadCatch m =>
MonadThrow (ErrorToErrorIOAsExcC e m)
forall e (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
ErrorToErrorIOAsExcC e m a
-> (e -> ErrorToErrorIOAsExcC e m a) -> ErrorToErrorIOAsExcC e m a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
catch :: ErrorToErrorIOAsExcC e m a
-> (e -> ErrorToErrorIOAsExcC e m a) -> ErrorToErrorIOAsExcC e m a
$ccatch :: forall e (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
ErrorToErrorIOAsExcC e m a
-> (e -> ErrorToErrorIOAsExcC e m a) -> ErrorToErrorIOAsExcC e m a
$cp1MonadCatch :: forall e (m :: * -> *).
MonadCatch m =>
MonadThrow (ErrorToErrorIOAsExcC e m)
MonadCatch, MonadCatch (ErrorToErrorIOAsExcC e m)
MonadCatch (ErrorToErrorIOAsExcC e m)
-> (forall b.
((forall a.
ErrorToErrorIOAsExcC e m a -> ErrorToErrorIOAsExcC e m a)
-> ErrorToErrorIOAsExcC e m b)
-> ErrorToErrorIOAsExcC e m b)
-> (forall b.
((forall a.
ErrorToErrorIOAsExcC e m a -> ErrorToErrorIOAsExcC e m a)
-> ErrorToErrorIOAsExcC e m b)
-> ErrorToErrorIOAsExcC e m b)
-> (forall a b c.
ErrorToErrorIOAsExcC e m a
-> (a -> ExitCase b -> ErrorToErrorIOAsExcC e m c)
-> (a -> ErrorToErrorIOAsExcC e m b)
-> ErrorToErrorIOAsExcC e m (b, c))
-> MonadMask (ErrorToErrorIOAsExcC e m)
ErrorToErrorIOAsExcC e m a
-> (a -> ExitCase b -> ErrorToErrorIOAsExcC e m c)
-> (a -> ErrorToErrorIOAsExcC e m b)
-> ErrorToErrorIOAsExcC e m (b, c)
((forall a.
ErrorToErrorIOAsExcC e m a -> ErrorToErrorIOAsExcC e m a)
-> ErrorToErrorIOAsExcC e m b)
-> ErrorToErrorIOAsExcC e m b
((forall a.
ErrorToErrorIOAsExcC e m a -> ErrorToErrorIOAsExcC e m a)
-> ErrorToErrorIOAsExcC e m b)
-> ErrorToErrorIOAsExcC e m b
forall b.
((forall a.
ErrorToErrorIOAsExcC e m a -> ErrorToErrorIOAsExcC e m a)
-> ErrorToErrorIOAsExcC e m b)
-> ErrorToErrorIOAsExcC e m b
forall a b c.
ErrorToErrorIOAsExcC e m a
-> (a -> ExitCase b -> ErrorToErrorIOAsExcC e m c)
-> (a -> ErrorToErrorIOAsExcC e m b)
-> ErrorToErrorIOAsExcC e m (b, c)
forall e (m :: * -> *).
MonadMask m =>
MonadCatch (ErrorToErrorIOAsExcC e m)
forall e (m :: * -> *) b.
MonadMask m =>
((forall a.
ErrorToErrorIOAsExcC e m a -> ErrorToErrorIOAsExcC e m a)
-> ErrorToErrorIOAsExcC e m b)
-> ErrorToErrorIOAsExcC e m b
forall e (m :: * -> *) a b c.
MonadMask m =>
ErrorToErrorIOAsExcC e m a
-> (a -> ExitCase b -> ErrorToErrorIOAsExcC e m c)
-> (a -> ErrorToErrorIOAsExcC e m b)
-> ErrorToErrorIOAsExcC e 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 :: ErrorToErrorIOAsExcC e m a
-> (a -> ExitCase b -> ErrorToErrorIOAsExcC e m c)
-> (a -> ErrorToErrorIOAsExcC e m b)
-> ErrorToErrorIOAsExcC e m (b, c)
$cgeneralBracket :: forall e (m :: * -> *) a b c.
MonadMask m =>
ErrorToErrorIOAsExcC e m a
-> (a -> ExitCase b -> ErrorToErrorIOAsExcC e m c)
-> (a -> ErrorToErrorIOAsExcC e m b)
-> ErrorToErrorIOAsExcC e m (b, c)
uninterruptibleMask :: ((forall a.
ErrorToErrorIOAsExcC e m a -> ErrorToErrorIOAsExcC e m a)
-> ErrorToErrorIOAsExcC e m b)
-> ErrorToErrorIOAsExcC e m b
$cuninterruptibleMask :: forall e (m :: * -> *) b.
MonadMask m =>
((forall a.
ErrorToErrorIOAsExcC e m a -> ErrorToErrorIOAsExcC e m a)
-> ErrorToErrorIOAsExcC e m b)
-> ErrorToErrorIOAsExcC e m b
mask :: ((forall a.
ErrorToErrorIOAsExcC e m a -> ErrorToErrorIOAsExcC e m a)
-> ErrorToErrorIOAsExcC e m b)
-> ErrorToErrorIOAsExcC e m b
$cmask :: forall e (m :: * -> *) b.
MonadMask m =>
((forall a.
ErrorToErrorIOAsExcC e m a -> ErrorToErrorIOAsExcC e m a)
-> ErrorToErrorIOAsExcC e m b)
-> ErrorToErrorIOAsExcC e m b
$cp1MonadMask :: forall e (m :: * -> *).
MonadMask m =>
MonadCatch (ErrorToErrorIOAsExcC e m)
MonadMask
, MonadBase b, MonadBaseControl b
)
deriving (m a -> ErrorToErrorIOAsExcC e m a
(forall (m :: * -> *) a.
Monad m =>
m a -> ErrorToErrorIOAsExcC e m a)
-> MonadTrans (ErrorToErrorIOAsExcC e)
forall e (m :: * -> *) a.
Monad m =>
m a -> ErrorToErrorIOAsExcC e m a
forall (m :: * -> *) a.
Monad m =>
m a -> ErrorToErrorIOAsExcC e m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> ErrorToErrorIOAsExcC e m a
$clift :: forall e (m :: * -> *) a.
Monad m =>
m a -> ErrorToErrorIOAsExcC e m a
MonadTrans, MonadTrans (ErrorToErrorIOAsExcC e)
m (StT (ErrorToErrorIOAsExcC e) a) -> ErrorToErrorIOAsExcC e m a
MonadTrans (ErrorToErrorIOAsExcC e)
-> (forall (m :: * -> *) a.
Monad m =>
(Run (ErrorToErrorIOAsExcC e) -> m a)
-> ErrorToErrorIOAsExcC e m a)
-> (forall (m :: * -> *) a.
Monad m =>
m (StT (ErrorToErrorIOAsExcC e) a) -> ErrorToErrorIOAsExcC e m a)
-> MonadTransControl (ErrorToErrorIOAsExcC e)
(Run (ErrorToErrorIOAsExcC e) -> m a) -> ErrorToErrorIOAsExcC e m a
forall e. MonadTrans (ErrorToErrorIOAsExcC e)
forall e (m :: * -> *) a.
Monad m =>
m (StT (ErrorToErrorIOAsExcC e) a) -> ErrorToErrorIOAsExcC e m a
forall e (m :: * -> *) a.
Monad m =>
(Run (ErrorToErrorIOAsExcC e) -> m a) -> ErrorToErrorIOAsExcC e m a
forall (m :: * -> *) a.
Monad m =>
m (StT (ErrorToErrorIOAsExcC e) a) -> ErrorToErrorIOAsExcC e m a
forall (m :: * -> *) a.
Monad m =>
(Run (ErrorToErrorIOAsExcC e) -> m a) -> ErrorToErrorIOAsExcC e m a
forall (t :: (* -> *) -> * -> *).
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 (ErrorToErrorIOAsExcC e) a) -> ErrorToErrorIOAsExcC e m a
$crestoreT :: forall e (m :: * -> *) a.
Monad m =>
m (StT (ErrorToErrorIOAsExcC e) a) -> ErrorToErrorIOAsExcC e m a
liftWith :: (Run (ErrorToErrorIOAsExcC e) -> m a) -> ErrorToErrorIOAsExcC e m a
$cliftWith :: forall e (m :: * -> *) a.
Monad m =>
(Run (ErrorToErrorIOAsExcC e) -> m a) -> ErrorToErrorIOAsExcC e m a
$cp1MonadTransControl :: forall e. MonadTrans (ErrorToErrorIOAsExcC e)
MonadTransControl)
via CompositionBaseT
'[ InterpretC ErrorToErrorIOAsExcH (Catch e)
, InterpretC ErrorToErrorIOAsExcH (Throw e)
]
deriving instance (Eff ErrorIO m, Exception e)
=> Carrier (ErrorToErrorIOAsExcC e m)
errorToErrorIOAsExc
:: (Exception e, Eff ErrorIO m)
=> ErrorToErrorIOAsExcC e m a
-> m a
errorToErrorIOAsExc :: ErrorToErrorIOAsExcC e m a -> m a
errorToErrorIOAsExc =
InterpretC ErrorToErrorIOAsExcH (Throw e) m a -> m a
forall h (e :: (* -> *) -> * -> *) (m :: * -> *) a.
Handler h e m =>
InterpretC h e m a -> m a
interpretViaHandler
(InterpretC ErrorToErrorIOAsExcH (Throw e) m a -> m a)
-> (InterpretC
ErrorToErrorIOAsExcH
(Catch e)
(InterpretC ErrorToErrorIOAsExcH (Throw e) m)
a
-> InterpretC ErrorToErrorIOAsExcH (Throw e) m a)
-> InterpretC
ErrorToErrorIOAsExcH
(Catch e)
(InterpretC ErrorToErrorIOAsExcH (Throw e) m)
a
-> m a
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# InterpretC
ErrorToErrorIOAsExcH
(Catch e)
(InterpretC ErrorToErrorIOAsExcH (Throw e) m)
a
-> InterpretC ErrorToErrorIOAsExcH (Throw e) m a
forall h (e :: (* -> *) -> * -> *) (m :: * -> *) a.
Handler h e m =>
InterpretC h e m a -> m a
interpretViaHandler
(InterpretC
ErrorToErrorIOAsExcH
(Catch e)
(InterpretC ErrorToErrorIOAsExcH (Throw e) m)
a
-> m a)
-> (ErrorToErrorIOAsExcC e m a
-> InterpretC
ErrorToErrorIOAsExcH
(Catch e)
(InterpretC ErrorToErrorIOAsExcH (Throw e) m)
a)
-> ErrorToErrorIOAsExcC e m a
-> m a
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# ErrorToErrorIOAsExcC e m a
-> InterpretC
ErrorToErrorIOAsExcH
(Catch e)
(InterpretC ErrorToErrorIOAsExcH (Throw e) m)
a
forall e (m :: * -> *) a.
ErrorToErrorIOAsExcC e m a
-> InterpretC
ErrorToErrorIOAsExcH
(Catch e)
(InterpretC ErrorToErrorIOAsExcH (Throw e) m)
a
unErrorToErrorIOAsExcC
{-# INLINE errorToErrorIOAsExc #-}
errorToIO :: forall e m a
. ( C.MonadCatch m
, Eff (Embed IO) m
)
=> ErrorToIOC e m a
-> m (Either e a)
errorToIO :: ErrorToIOC e m a -> m (Either e a)
errorToIO ErrorToIOC e m a
m =
ErrorIOToIOC m (Either e a) -> m (Either e a)
forall (m :: * -> *) a.
(Carrier m, MonadCatch m) =>
ErrorIOToIOC m a -> m a
errorIOToIO
(ErrorIOToIOC m (Either e a) -> m (Either e a))
-> ErrorIOToIOC m (Either e a) -> m (Either e a)
forall a b. (a -> b) -> a -> b
$ InterpretErrorC e (ErrorIOToIOC m) a -> ErrorIOToIOC m (Either e a)
forall e (m :: * -> *) a.
Effs '[ErrorIO, Embed IO] m =>
InterpretErrorC e m a -> m (Either e a)
errorToErrorIO
(InterpretErrorC e (ErrorIOToIOC m) a
-> ErrorIOToIOC m (Either e a))
-> InterpretErrorC e (ErrorIOToIOC m) a
-> ErrorIOToIOC m (Either e a)
forall a b. (a -> b) -> a -> b
$ IntroUnderManyC
'[Catch e, Throw e]
'[ErrorIO]
(InterpretErrorC' s s' e (ErrorIOToIOC m))
a
-> InterpretErrorC' s s' e (ErrorIOToIOC m) a
forall (top :: [(* -> *) -> * -> *]) (new :: [(* -> *) -> * -> *])
(m :: * -> *) a.
(KnownList top, KnownList new, IntroConsistent top new m) =>
IntroUnderManyC top new m a -> m a
introUnderMany
(IntroUnderManyC
'[Catch e, Throw e]
'[ErrorIO]
(InterpretErrorC' s s' e (ErrorIOToIOC m))
a
-> InterpretErrorC' s s' e (ErrorIOToIOC m) a)
-> IntroUnderManyC
'[Catch e, Throw e]
'[ErrorIO]
(InterpretErrorC' s s' e (ErrorIOToIOC m))
a
-> InterpretErrorC' s s' e (ErrorIOToIOC m) a
forall a b. (a -> b) -> a -> b
$ ErrorToIOC' s s' e m a
-> IntroUnderManyC
'[Catch e, Throw e]
'[ErrorIO]
(InterpretErrorC' s s' e (ErrorIOToIOC m))
a
forall s s' e (m :: * -> *) a.
ErrorToIOC' s s' e m a
-> IntroC
'[Catch e, Throw e]
'[ErrorIO]
(InterpretErrorC' s s' e (ErrorIOToIOC m))
a
unErrorToIOC'
(ErrorToIOC' s s' e m a
-> IntroUnderManyC
'[Catch e, Throw e]
'[ErrorIO]
(InterpretErrorC' s s' e (ErrorIOToIOC m))
a)
-> ErrorToIOC' s s' e m a
-> IntroUnderManyC
'[Catch e, Throw e]
'[ErrorIO]
(InterpretErrorC' s s' e (ErrorIOToIOC m))
a
forall a b. (a -> b) -> a -> b
$ ErrorToIOC' s s' e m a
ErrorToIOC e m a
m
{-# INLINE errorToIO #-}
newtype ErrorToIOAsExcC e m a = ErrorToIOAsExcC {
ErrorToIOAsExcC e m a
-> IntroC
'[Catch e, Throw e]
'[ErrorIO]
(ErrorToErrorIOAsExcC e (ErrorIOToIOC m))
a
unErrorToIOAsExcC ::
IntroC '[Catch e, Throw e] '[ErrorIO]
( ErrorToErrorIOAsExcC e
( ErrorIOToIOC
m
)) a
} deriving ( a -> ErrorToIOAsExcC e m b -> ErrorToIOAsExcC e m a
(a -> b) -> ErrorToIOAsExcC e m a -> ErrorToIOAsExcC e m b
(forall a b.
(a -> b) -> ErrorToIOAsExcC e m a -> ErrorToIOAsExcC e m b)
-> (forall a b.
a -> ErrorToIOAsExcC e m b -> ErrorToIOAsExcC e m a)
-> Functor (ErrorToIOAsExcC e m)
forall a b. a -> ErrorToIOAsExcC e m b -> ErrorToIOAsExcC e m a
forall a b.
(a -> b) -> ErrorToIOAsExcC e m a -> ErrorToIOAsExcC e m b
forall e (m :: * -> *) a b.
Functor m =>
a -> ErrorToIOAsExcC e m b -> ErrorToIOAsExcC e m a
forall e (m :: * -> *) a b.
Functor m =>
(a -> b) -> ErrorToIOAsExcC e m a -> ErrorToIOAsExcC e m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ErrorToIOAsExcC e m b -> ErrorToIOAsExcC e m a
$c<$ :: forall e (m :: * -> *) a b.
Functor m =>
a -> ErrorToIOAsExcC e m b -> ErrorToIOAsExcC e m a
fmap :: (a -> b) -> ErrorToIOAsExcC e m a -> ErrorToIOAsExcC e m b
$cfmap :: forall e (m :: * -> *) a b.
Functor m =>
(a -> b) -> ErrorToIOAsExcC e m a -> ErrorToIOAsExcC e m b
Functor, Functor (ErrorToIOAsExcC e m)
a -> ErrorToIOAsExcC e m a
Functor (ErrorToIOAsExcC e m)
-> (forall a. a -> ErrorToIOAsExcC e m a)
-> (forall a b.
ErrorToIOAsExcC e m (a -> b)
-> ErrorToIOAsExcC e m a -> ErrorToIOAsExcC e m b)
-> (forall a b c.
(a -> b -> c)
-> ErrorToIOAsExcC e m a
-> ErrorToIOAsExcC e m b
-> ErrorToIOAsExcC e m c)
-> (forall a b.
ErrorToIOAsExcC e m a
-> ErrorToIOAsExcC e m b -> ErrorToIOAsExcC e m b)
-> (forall a b.
ErrorToIOAsExcC e m a
-> ErrorToIOAsExcC e m b -> ErrorToIOAsExcC e m a)
-> Applicative (ErrorToIOAsExcC e m)
ErrorToIOAsExcC e m a
-> ErrorToIOAsExcC e m b -> ErrorToIOAsExcC e m b
ErrorToIOAsExcC e m a
-> ErrorToIOAsExcC e m b -> ErrorToIOAsExcC e m a
ErrorToIOAsExcC e m (a -> b)
-> ErrorToIOAsExcC e m a -> ErrorToIOAsExcC e m b
(a -> b -> c)
-> ErrorToIOAsExcC e m a
-> ErrorToIOAsExcC e m b
-> ErrorToIOAsExcC e m c
forall a. a -> ErrorToIOAsExcC e m a
forall a b.
ErrorToIOAsExcC e m a
-> ErrorToIOAsExcC e m b -> ErrorToIOAsExcC e m a
forall a b.
ErrorToIOAsExcC e m a
-> ErrorToIOAsExcC e m b -> ErrorToIOAsExcC e m b
forall a b.
ErrorToIOAsExcC e m (a -> b)
-> ErrorToIOAsExcC e m a -> ErrorToIOAsExcC e m b
forall a b c.
(a -> b -> c)
-> ErrorToIOAsExcC e m a
-> ErrorToIOAsExcC e m b
-> ErrorToIOAsExcC e m c
forall e (m :: * -> *).
Applicative m =>
Functor (ErrorToIOAsExcC e m)
forall e (m :: * -> *) a.
Applicative m =>
a -> ErrorToIOAsExcC e m a
forall e (m :: * -> *) a b.
Applicative m =>
ErrorToIOAsExcC e m a
-> ErrorToIOAsExcC e m b -> ErrorToIOAsExcC e m a
forall e (m :: * -> *) a b.
Applicative m =>
ErrorToIOAsExcC e m a
-> ErrorToIOAsExcC e m b -> ErrorToIOAsExcC e m b
forall e (m :: * -> *) a b.
Applicative m =>
ErrorToIOAsExcC e m (a -> b)
-> ErrorToIOAsExcC e m a -> ErrorToIOAsExcC e m b
forall e (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> ErrorToIOAsExcC e m a
-> ErrorToIOAsExcC e m b
-> ErrorToIOAsExcC e 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
<* :: ErrorToIOAsExcC e m a
-> ErrorToIOAsExcC e m b -> ErrorToIOAsExcC e m a
$c<* :: forall e (m :: * -> *) a b.
Applicative m =>
ErrorToIOAsExcC e m a
-> ErrorToIOAsExcC e m b -> ErrorToIOAsExcC e m a
*> :: ErrorToIOAsExcC e m a
-> ErrorToIOAsExcC e m b -> ErrorToIOAsExcC e m b
$c*> :: forall e (m :: * -> *) a b.
Applicative m =>
ErrorToIOAsExcC e m a
-> ErrorToIOAsExcC e m b -> ErrorToIOAsExcC e m b
liftA2 :: (a -> b -> c)
-> ErrorToIOAsExcC e m a
-> ErrorToIOAsExcC e m b
-> ErrorToIOAsExcC e m c
$cliftA2 :: forall e (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> ErrorToIOAsExcC e m a
-> ErrorToIOAsExcC e m b
-> ErrorToIOAsExcC e m c
<*> :: ErrorToIOAsExcC e m (a -> b)
-> ErrorToIOAsExcC e m a -> ErrorToIOAsExcC e m b
$c<*> :: forall e (m :: * -> *) a b.
Applicative m =>
ErrorToIOAsExcC e m (a -> b)
-> ErrorToIOAsExcC e m a -> ErrorToIOAsExcC e m b
pure :: a -> ErrorToIOAsExcC e m a
$cpure :: forall e (m :: * -> *) a.
Applicative m =>
a -> ErrorToIOAsExcC e m a
$cp1Applicative :: forall e (m :: * -> *).
Applicative m =>
Functor (ErrorToIOAsExcC e m)
Applicative, Applicative (ErrorToIOAsExcC e m)
a -> ErrorToIOAsExcC e m a
Applicative (ErrorToIOAsExcC e m)
-> (forall a b.
ErrorToIOAsExcC e m a
-> (a -> ErrorToIOAsExcC e m b) -> ErrorToIOAsExcC e m b)
-> (forall a b.
ErrorToIOAsExcC e m a
-> ErrorToIOAsExcC e m b -> ErrorToIOAsExcC e m b)
-> (forall a. a -> ErrorToIOAsExcC e m a)
-> Monad (ErrorToIOAsExcC e m)
ErrorToIOAsExcC e m a
-> (a -> ErrorToIOAsExcC e m b) -> ErrorToIOAsExcC e m b
ErrorToIOAsExcC e m a
-> ErrorToIOAsExcC e m b -> ErrorToIOAsExcC e m b
forall a. a -> ErrorToIOAsExcC e m a
forall a b.
ErrorToIOAsExcC e m a
-> ErrorToIOAsExcC e m b -> ErrorToIOAsExcC e m b
forall a b.
ErrorToIOAsExcC e m a
-> (a -> ErrorToIOAsExcC e m b) -> ErrorToIOAsExcC e m b
forall e (m :: * -> *).
Monad m =>
Applicative (ErrorToIOAsExcC e m)
forall e (m :: * -> *) a. Monad m => a -> ErrorToIOAsExcC e m a
forall e (m :: * -> *) a b.
Monad m =>
ErrorToIOAsExcC e m a
-> ErrorToIOAsExcC e m b -> ErrorToIOAsExcC e m b
forall e (m :: * -> *) a b.
Monad m =>
ErrorToIOAsExcC e m a
-> (a -> ErrorToIOAsExcC e m b) -> ErrorToIOAsExcC e 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 -> ErrorToIOAsExcC e m a
$creturn :: forall e (m :: * -> *) a. Monad m => a -> ErrorToIOAsExcC e m a
>> :: ErrorToIOAsExcC e m a
-> ErrorToIOAsExcC e m b -> ErrorToIOAsExcC e m b
$c>> :: forall e (m :: * -> *) a b.
Monad m =>
ErrorToIOAsExcC e m a
-> ErrorToIOAsExcC e m b -> ErrorToIOAsExcC e m b
>>= :: ErrorToIOAsExcC e m a
-> (a -> ErrorToIOAsExcC e m b) -> ErrorToIOAsExcC e m b
$c>>= :: forall e (m :: * -> *) a b.
Monad m =>
ErrorToIOAsExcC e m a
-> (a -> ErrorToIOAsExcC e m b) -> ErrorToIOAsExcC e m b
$cp1Monad :: forall e (m :: * -> *).
Monad m =>
Applicative (ErrorToIOAsExcC e m)
Monad
, Applicative (ErrorToIOAsExcC e m)
ErrorToIOAsExcC e m a
Applicative (ErrorToIOAsExcC e m)
-> (forall a. ErrorToIOAsExcC e m a)
-> (forall a.
ErrorToIOAsExcC e m a
-> ErrorToIOAsExcC e m a -> ErrorToIOAsExcC e m a)
-> (forall a. ErrorToIOAsExcC e m a -> ErrorToIOAsExcC e m [a])
-> (forall a. ErrorToIOAsExcC e m a -> ErrorToIOAsExcC e m [a])
-> Alternative (ErrorToIOAsExcC e m)
ErrorToIOAsExcC e m a
-> ErrorToIOAsExcC e m a -> ErrorToIOAsExcC e m a
ErrorToIOAsExcC e m a -> ErrorToIOAsExcC e m [a]
ErrorToIOAsExcC e m a -> ErrorToIOAsExcC e m [a]
forall a. ErrorToIOAsExcC e m a
forall a. ErrorToIOAsExcC e m a -> ErrorToIOAsExcC e m [a]
forall a.
ErrorToIOAsExcC e m a
-> ErrorToIOAsExcC e m a -> ErrorToIOAsExcC e m a
forall e (m :: * -> *).
Alternative m =>
Applicative (ErrorToIOAsExcC e m)
forall e (m :: * -> *) a. Alternative m => ErrorToIOAsExcC e m a
forall e (m :: * -> *) a.
Alternative m =>
ErrorToIOAsExcC e m a -> ErrorToIOAsExcC e m [a]
forall e (m :: * -> *) a.
Alternative m =>
ErrorToIOAsExcC e m a
-> ErrorToIOAsExcC e m a -> ErrorToIOAsExcC e 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 :: ErrorToIOAsExcC e m a -> ErrorToIOAsExcC e m [a]
$cmany :: forall e (m :: * -> *) a.
Alternative m =>
ErrorToIOAsExcC e m a -> ErrorToIOAsExcC e m [a]
some :: ErrorToIOAsExcC e m a -> ErrorToIOAsExcC e m [a]
$csome :: forall e (m :: * -> *) a.
Alternative m =>
ErrorToIOAsExcC e m a -> ErrorToIOAsExcC e m [a]
<|> :: ErrorToIOAsExcC e m a
-> ErrorToIOAsExcC e m a -> ErrorToIOAsExcC e m a
$c<|> :: forall e (m :: * -> *) a.
Alternative m =>
ErrorToIOAsExcC e m a
-> ErrorToIOAsExcC e m a -> ErrorToIOAsExcC e m a
empty :: ErrorToIOAsExcC e m a
$cempty :: forall e (m :: * -> *) a. Alternative m => ErrorToIOAsExcC e m a
$cp1Alternative :: forall e (m :: * -> *).
Alternative m =>
Applicative (ErrorToIOAsExcC e m)
Alternative, Monad (ErrorToIOAsExcC e m)
Alternative (ErrorToIOAsExcC e m)
ErrorToIOAsExcC e m a
Alternative (ErrorToIOAsExcC e m)
-> Monad (ErrorToIOAsExcC e m)
-> (forall a. ErrorToIOAsExcC e m a)
-> (forall a.
ErrorToIOAsExcC e m a
-> ErrorToIOAsExcC e m a -> ErrorToIOAsExcC e m a)
-> MonadPlus (ErrorToIOAsExcC e m)
ErrorToIOAsExcC e m a
-> ErrorToIOAsExcC e m a -> ErrorToIOAsExcC e m a
forall a. ErrorToIOAsExcC e m a
forall a.
ErrorToIOAsExcC e m a
-> ErrorToIOAsExcC e m a -> ErrorToIOAsExcC e m a
forall e (m :: * -> *). MonadPlus m => Monad (ErrorToIOAsExcC e m)
forall e (m :: * -> *).
MonadPlus m =>
Alternative (ErrorToIOAsExcC e m)
forall e (m :: * -> *) a. MonadPlus m => ErrorToIOAsExcC e m a
forall e (m :: * -> *) a.
MonadPlus m =>
ErrorToIOAsExcC e m a
-> ErrorToIOAsExcC e m a -> ErrorToIOAsExcC e m a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
mplus :: ErrorToIOAsExcC e m a
-> ErrorToIOAsExcC e m a -> ErrorToIOAsExcC e m a
$cmplus :: forall e (m :: * -> *) a.
MonadPlus m =>
ErrorToIOAsExcC e m a
-> ErrorToIOAsExcC e m a -> ErrorToIOAsExcC e m a
mzero :: ErrorToIOAsExcC e m a
$cmzero :: forall e (m :: * -> *) a. MonadPlus m => ErrorToIOAsExcC e m a
$cp2MonadPlus :: forall e (m :: * -> *). MonadPlus m => Monad (ErrorToIOAsExcC e m)
$cp1MonadPlus :: forall e (m :: * -> *).
MonadPlus m =>
Alternative (ErrorToIOAsExcC e m)
MonadPlus
, Monad (ErrorToIOAsExcC e m)
Monad (ErrorToIOAsExcC e m)
-> (forall a.
(a -> ErrorToIOAsExcC e m a) -> ErrorToIOAsExcC e m a)
-> MonadFix (ErrorToIOAsExcC e m)
(a -> ErrorToIOAsExcC e m a) -> ErrorToIOAsExcC e m a
forall a. (a -> ErrorToIOAsExcC e m a) -> ErrorToIOAsExcC e m a
forall e (m :: * -> *). MonadFix m => Monad (ErrorToIOAsExcC e m)
forall e (m :: * -> *) a.
MonadFix m =>
(a -> ErrorToIOAsExcC e m a) -> ErrorToIOAsExcC e m a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
mfix :: (a -> ErrorToIOAsExcC e m a) -> ErrorToIOAsExcC e m a
$cmfix :: forall e (m :: * -> *) a.
MonadFix m =>
(a -> ErrorToIOAsExcC e m a) -> ErrorToIOAsExcC e m a
$cp1MonadFix :: forall e (m :: * -> *). MonadFix m => Monad (ErrorToIOAsExcC e m)
MonadFix, Monad (ErrorToIOAsExcC e m)
Monad (ErrorToIOAsExcC e m)
-> (forall a. String -> ErrorToIOAsExcC e m a)
-> MonadFail (ErrorToIOAsExcC e m)
String -> ErrorToIOAsExcC e m a
forall a. String -> ErrorToIOAsExcC e m a
forall e (m :: * -> *). MonadFail m => Monad (ErrorToIOAsExcC e m)
forall e (m :: * -> *) a.
MonadFail m =>
String -> ErrorToIOAsExcC e m a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
fail :: String -> ErrorToIOAsExcC e m a
$cfail :: forall e (m :: * -> *) a.
MonadFail m =>
String -> ErrorToIOAsExcC e m a
$cp1MonadFail :: forall e (m :: * -> *). MonadFail m => Monad (ErrorToIOAsExcC e m)
MonadFail, Monad (ErrorToIOAsExcC e m)
Monad (ErrorToIOAsExcC e m)
-> (forall a. IO a -> ErrorToIOAsExcC e m a)
-> MonadIO (ErrorToIOAsExcC e m)
IO a -> ErrorToIOAsExcC e m a
forall a. IO a -> ErrorToIOAsExcC e m a
forall e (m :: * -> *). MonadIO m => Monad (ErrorToIOAsExcC e m)
forall e (m :: * -> *) a.
MonadIO m =>
IO a -> ErrorToIOAsExcC e m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> ErrorToIOAsExcC e m a
$cliftIO :: forall e (m :: * -> *) a.
MonadIO m =>
IO a -> ErrorToIOAsExcC e m a
$cp1MonadIO :: forall e (m :: * -> *). MonadIO m => Monad (ErrorToIOAsExcC e m)
MonadIO
, Monad (ErrorToIOAsExcC e m)
e -> ErrorToIOAsExcC e m a
Monad (ErrorToIOAsExcC e m)
-> (forall e a. Exception e => e -> ErrorToIOAsExcC e m a)
-> MonadThrow (ErrorToIOAsExcC e m)
forall e a. Exception e => e -> ErrorToIOAsExcC e m a
forall e (m :: * -> *). MonadThrow m => Monad (ErrorToIOAsExcC e m)
forall e (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> ErrorToIOAsExcC e m a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: e -> ErrorToIOAsExcC e m a
$cthrowM :: forall e (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> ErrorToIOAsExcC e m a
$cp1MonadThrow :: forall e (m :: * -> *). MonadThrow m => Monad (ErrorToIOAsExcC e m)
MonadThrow, MonadThrow (ErrorToIOAsExcC e m)
MonadThrow (ErrorToIOAsExcC e m)
-> (forall e a.
Exception e =>
ErrorToIOAsExcC e m a
-> (e -> ErrorToIOAsExcC e m a) -> ErrorToIOAsExcC e m a)
-> MonadCatch (ErrorToIOAsExcC e m)
ErrorToIOAsExcC e m a
-> (e -> ErrorToIOAsExcC e m a) -> ErrorToIOAsExcC e m a
forall e a.
Exception e =>
ErrorToIOAsExcC e m a
-> (e -> ErrorToIOAsExcC e m a) -> ErrorToIOAsExcC e m a
forall e (m :: * -> *).
MonadCatch m =>
MonadThrow (ErrorToIOAsExcC e m)
forall e (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
ErrorToIOAsExcC e m a
-> (e -> ErrorToIOAsExcC e m a) -> ErrorToIOAsExcC e m a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
catch :: ErrorToIOAsExcC e m a
-> (e -> ErrorToIOAsExcC e m a) -> ErrorToIOAsExcC e m a
$ccatch :: forall e (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
ErrorToIOAsExcC e m a
-> (e -> ErrorToIOAsExcC e m a) -> ErrorToIOAsExcC e m a
$cp1MonadCatch :: forall e (m :: * -> *).
MonadCatch m =>
MonadThrow (ErrorToIOAsExcC e m)
MonadCatch, MonadCatch (ErrorToIOAsExcC e m)
MonadCatch (ErrorToIOAsExcC e m)
-> (forall b.
((forall a. ErrorToIOAsExcC e m a -> ErrorToIOAsExcC e m a)
-> ErrorToIOAsExcC e m b)
-> ErrorToIOAsExcC e m b)
-> (forall b.
((forall a. ErrorToIOAsExcC e m a -> ErrorToIOAsExcC e m a)
-> ErrorToIOAsExcC e m b)
-> ErrorToIOAsExcC e m b)
-> (forall a b c.
ErrorToIOAsExcC e m a
-> (a -> ExitCase b -> ErrorToIOAsExcC e m c)
-> (a -> ErrorToIOAsExcC e m b)
-> ErrorToIOAsExcC e m (b, c))
-> MonadMask (ErrorToIOAsExcC e m)
ErrorToIOAsExcC e m a
-> (a -> ExitCase b -> ErrorToIOAsExcC e m c)
-> (a -> ErrorToIOAsExcC e m b)
-> ErrorToIOAsExcC e m (b, c)
((forall a. ErrorToIOAsExcC e m a -> ErrorToIOAsExcC e m a)
-> ErrorToIOAsExcC e m b)
-> ErrorToIOAsExcC e m b
((forall a. ErrorToIOAsExcC e m a -> ErrorToIOAsExcC e m a)
-> ErrorToIOAsExcC e m b)
-> ErrorToIOAsExcC e m b
forall b.
((forall a. ErrorToIOAsExcC e m a -> ErrorToIOAsExcC e m a)
-> ErrorToIOAsExcC e m b)
-> ErrorToIOAsExcC e m b
forall a b c.
ErrorToIOAsExcC e m a
-> (a -> ExitCase b -> ErrorToIOAsExcC e m c)
-> (a -> ErrorToIOAsExcC e m b)
-> ErrorToIOAsExcC e m (b, c)
forall e (m :: * -> *).
MonadMask m =>
MonadCatch (ErrorToIOAsExcC e m)
forall e (m :: * -> *) b.
MonadMask m =>
((forall a. ErrorToIOAsExcC e m a -> ErrorToIOAsExcC e m a)
-> ErrorToIOAsExcC e m b)
-> ErrorToIOAsExcC e m b
forall e (m :: * -> *) a b c.
MonadMask m =>
ErrorToIOAsExcC e m a
-> (a -> ExitCase b -> ErrorToIOAsExcC e m c)
-> (a -> ErrorToIOAsExcC e m b)
-> ErrorToIOAsExcC e 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 :: ErrorToIOAsExcC e m a
-> (a -> ExitCase b -> ErrorToIOAsExcC e m c)
-> (a -> ErrorToIOAsExcC e m b)
-> ErrorToIOAsExcC e m (b, c)
$cgeneralBracket :: forall e (m :: * -> *) a b c.
MonadMask m =>
ErrorToIOAsExcC e m a
-> (a -> ExitCase b -> ErrorToIOAsExcC e m c)
-> (a -> ErrorToIOAsExcC e m b)
-> ErrorToIOAsExcC e m (b, c)
uninterruptibleMask :: ((forall a. ErrorToIOAsExcC e m a -> ErrorToIOAsExcC e m a)
-> ErrorToIOAsExcC e m b)
-> ErrorToIOAsExcC e m b
$cuninterruptibleMask :: forall e (m :: * -> *) b.
MonadMask m =>
((forall a. ErrorToIOAsExcC e m a -> ErrorToIOAsExcC e m a)
-> ErrorToIOAsExcC e m b)
-> ErrorToIOAsExcC e m b
mask :: ((forall a. ErrorToIOAsExcC e m a -> ErrorToIOAsExcC e m a)
-> ErrorToIOAsExcC e m b)
-> ErrorToIOAsExcC e m b
$cmask :: forall e (m :: * -> *) b.
MonadMask m =>
((forall a. ErrorToIOAsExcC e m a -> ErrorToIOAsExcC e m a)
-> ErrorToIOAsExcC e m b)
-> ErrorToIOAsExcC e m b
$cp1MonadMask :: forall e (m :: * -> *).
MonadMask m =>
MonadCatch (ErrorToIOAsExcC e m)
MonadMask
, MonadBase b, MonadBaseControl b
)
deriving (m a -> ErrorToIOAsExcC e m a
(forall (m :: * -> *) a. Monad m => m a -> ErrorToIOAsExcC e m a)
-> MonadTrans (ErrorToIOAsExcC e)
forall e (m :: * -> *) a. Monad m => m a -> ErrorToIOAsExcC e m a
forall (m :: * -> *) a. Monad m => m a -> ErrorToIOAsExcC e m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> ErrorToIOAsExcC e m a
$clift :: forall e (m :: * -> *) a. Monad m => m a -> ErrorToIOAsExcC e m a
MonadTrans, MonadTrans (ErrorToIOAsExcC e)
m (StT (ErrorToIOAsExcC e) a) -> ErrorToIOAsExcC e m a
MonadTrans (ErrorToIOAsExcC e)
-> (forall (m :: * -> *) a.
Monad m =>
(Run (ErrorToIOAsExcC e) -> m a) -> ErrorToIOAsExcC e m a)
-> (forall (m :: * -> *) a.
Monad m =>
m (StT (ErrorToIOAsExcC e) a) -> ErrorToIOAsExcC e m a)
-> MonadTransControl (ErrorToIOAsExcC e)
(Run (ErrorToIOAsExcC e) -> m a) -> ErrorToIOAsExcC e m a
forall e. MonadTrans (ErrorToIOAsExcC e)
forall e (m :: * -> *) a.
Monad m =>
m (StT (ErrorToIOAsExcC e) a) -> ErrorToIOAsExcC e m a
forall e (m :: * -> *) a.
Monad m =>
(Run (ErrorToIOAsExcC e) -> m a) -> ErrorToIOAsExcC e m a
forall (m :: * -> *) a.
Monad m =>
m (StT (ErrorToIOAsExcC e) a) -> ErrorToIOAsExcC e m a
forall (m :: * -> *) a.
Monad m =>
(Run (ErrorToIOAsExcC e) -> m a) -> ErrorToIOAsExcC e m a
forall (t :: (* -> *) -> * -> *).
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 (ErrorToIOAsExcC e) a) -> ErrorToIOAsExcC e m a
$crestoreT :: forall e (m :: * -> *) a.
Monad m =>
m (StT (ErrorToIOAsExcC e) a) -> ErrorToIOAsExcC e m a
liftWith :: (Run (ErrorToIOAsExcC e) -> m a) -> ErrorToIOAsExcC e m a
$cliftWith :: forall e (m :: * -> *) a.
Monad m =>
(Run (ErrorToIOAsExcC e) -> m a) -> ErrorToIOAsExcC e m a
$cp1MonadTransControl :: forall e. MonadTrans (ErrorToIOAsExcC e)
MonadTransControl)
via CompositionBaseT
'[ IntroC '[Catch e, Throw e] '[ErrorIO]
, ErrorToErrorIOAsExcC e
, ErrorIOToIOC
]
deriving instance (Exception e, C.MonadCatch m, Carrier m)
=> Carrier (ErrorToIOAsExcC e m)
errorToIOAsExc
:: ( Exception e
, C.MonadCatch m
, Carrier m
)
=> ErrorToIOAsExcC e m a
-> m a
errorToIOAsExc :: ErrorToIOAsExcC e m a -> m a
errorToIOAsExc =
ErrorIOToIOC m a -> m a
forall (m :: * -> *) a.
(Carrier m, MonadCatch m) =>
ErrorIOToIOC m a -> m a
errorIOToIO
(ErrorIOToIOC m a -> m a)
-> (ErrorToErrorIOAsExcC e (ErrorIOToIOC m) a -> ErrorIOToIOC m a)
-> ErrorToErrorIOAsExcC e (ErrorIOToIOC m) a
-> m a
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# ErrorToErrorIOAsExcC e (ErrorIOToIOC m) a -> ErrorIOToIOC m a
forall e (m :: * -> *) a.
(Exception e, Eff ErrorIO m) =>
ErrorToErrorIOAsExcC e m a -> m a
errorToErrorIOAsExc
(ErrorToErrorIOAsExcC e (ErrorIOToIOC m) a -> m a)
-> (IntroUnderManyC
'[Catch e, Throw e]
'[ErrorIO]
(ErrorToErrorIOAsExcC e (ErrorIOToIOC m))
a
-> ErrorToErrorIOAsExcC e (ErrorIOToIOC m) a)
-> IntroUnderManyC
'[Catch e, Throw e]
'[ErrorIO]
(ErrorToErrorIOAsExcC e (ErrorIOToIOC m))
a
-> m a
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# IntroUnderManyC
'[Catch e, Throw e]
'[ErrorIO]
(ErrorToErrorIOAsExcC e (ErrorIOToIOC m))
a
-> ErrorToErrorIOAsExcC e (ErrorIOToIOC m) a
forall (top :: [(* -> *) -> * -> *]) (new :: [(* -> *) -> * -> *])
(m :: * -> *) a.
(KnownList top, KnownList new, IntroConsistent top new m) =>
IntroUnderManyC top new m a -> m a
introUnderMany
(IntroUnderManyC
'[Catch e, Throw e]
'[ErrorIO]
(ErrorToErrorIOAsExcC e (ErrorIOToIOC m))
a
-> m a)
-> (ErrorToIOAsExcC e m a
-> IntroUnderManyC
'[Catch e, Throw e]
'[ErrorIO]
(ErrorToErrorIOAsExcC e (ErrorIOToIOC m))
a)
-> ErrorToIOAsExcC e m a
-> m a
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# ErrorToIOAsExcC e m a
-> IntroUnderManyC
'[Catch e, Throw e]
'[ErrorIO]
(ErrorToErrorIOAsExcC e (ErrorIOToIOC m))
a
forall e (m :: * -> *) a.
ErrorToIOAsExcC e m a
-> IntroC
'[Catch e, Throw e]
'[ErrorIO]
(ErrorToErrorIOAsExcC e (ErrorIOToIOC m))
a
unErrorToIOAsExcC
{-# INLINE errorToIOAsExc #-}
newtype InterpretErrorSimpleC e m a = InterpretErrorSimpleC {
InterpretErrorSimpleC e m a
-> InterpretSimpleC (Catch e) (InterpretSimpleC (Throw e) m) a
unInterpretErrorSimpleC ::
InterpretSimpleC (Catch e)
( InterpretSimpleC (Throw e)
( m
)) a
} deriving ( a -> InterpretErrorSimpleC e m b -> InterpretErrorSimpleC e m a
(a -> b)
-> InterpretErrorSimpleC e m a -> InterpretErrorSimpleC e m b
(forall a b.
(a -> b)
-> InterpretErrorSimpleC e m a -> InterpretErrorSimpleC e m b)
-> (forall a b.
a -> InterpretErrorSimpleC e m b -> InterpretErrorSimpleC e m a)
-> Functor (InterpretErrorSimpleC e m)
forall a b.
a -> InterpretErrorSimpleC e m b -> InterpretErrorSimpleC e m a
forall a b.
(a -> b)
-> InterpretErrorSimpleC e m a -> InterpretErrorSimpleC e m b
forall e (m :: * -> *) a b.
Functor m =>
a -> InterpretErrorSimpleC e m b -> InterpretErrorSimpleC e m a
forall e (m :: * -> *) a b.
Functor m =>
(a -> b)
-> InterpretErrorSimpleC e m a -> InterpretErrorSimpleC e m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> InterpretErrorSimpleC e m b -> InterpretErrorSimpleC e m a
$c<$ :: forall e (m :: * -> *) a b.
Functor m =>
a -> InterpretErrorSimpleC e m b -> InterpretErrorSimpleC e m a
fmap :: (a -> b)
-> InterpretErrorSimpleC e m a -> InterpretErrorSimpleC e m b
$cfmap :: forall e (m :: * -> *) a b.
Functor m =>
(a -> b)
-> InterpretErrorSimpleC e m a -> InterpretErrorSimpleC e m b
Functor, Functor (InterpretErrorSimpleC e m)
a -> InterpretErrorSimpleC e m a
Functor (InterpretErrorSimpleC e m)
-> (forall a. a -> InterpretErrorSimpleC e m a)
-> (forall a b.
InterpretErrorSimpleC e m (a -> b)
-> InterpretErrorSimpleC e m a -> InterpretErrorSimpleC e m b)
-> (forall a b c.
(a -> b -> c)
-> InterpretErrorSimpleC e m a
-> InterpretErrorSimpleC e m b
-> InterpretErrorSimpleC e m c)
-> (forall a b.
InterpretErrorSimpleC e m a
-> InterpretErrorSimpleC e m b -> InterpretErrorSimpleC e m b)
-> (forall a b.
InterpretErrorSimpleC e m a
-> InterpretErrorSimpleC e m b -> InterpretErrorSimpleC e m a)
-> Applicative (InterpretErrorSimpleC e m)
InterpretErrorSimpleC e m a
-> InterpretErrorSimpleC e m b -> InterpretErrorSimpleC e m b
InterpretErrorSimpleC e m a
-> InterpretErrorSimpleC e m b -> InterpretErrorSimpleC e m a
InterpretErrorSimpleC e m (a -> b)
-> InterpretErrorSimpleC e m a -> InterpretErrorSimpleC e m b
(a -> b -> c)
-> InterpretErrorSimpleC e m a
-> InterpretErrorSimpleC e m b
-> InterpretErrorSimpleC e m c
forall a. a -> InterpretErrorSimpleC e m a
forall a b.
InterpretErrorSimpleC e m a
-> InterpretErrorSimpleC e m b -> InterpretErrorSimpleC e m a
forall a b.
InterpretErrorSimpleC e m a
-> InterpretErrorSimpleC e m b -> InterpretErrorSimpleC e m b
forall a b.
InterpretErrorSimpleC e m (a -> b)
-> InterpretErrorSimpleC e m a -> InterpretErrorSimpleC e m b
forall a b c.
(a -> b -> c)
-> InterpretErrorSimpleC e m a
-> InterpretErrorSimpleC e m b
-> InterpretErrorSimpleC e m c
forall e (m :: * -> *).
Applicative m =>
Functor (InterpretErrorSimpleC e m)
forall e (m :: * -> *) a.
Applicative m =>
a -> InterpretErrorSimpleC e m a
forall e (m :: * -> *) a b.
Applicative m =>
InterpretErrorSimpleC e m a
-> InterpretErrorSimpleC e m b -> InterpretErrorSimpleC e m a
forall e (m :: * -> *) a b.
Applicative m =>
InterpretErrorSimpleC e m a
-> InterpretErrorSimpleC e m b -> InterpretErrorSimpleC e m b
forall e (m :: * -> *) a b.
Applicative m =>
InterpretErrorSimpleC e m (a -> b)
-> InterpretErrorSimpleC e m a -> InterpretErrorSimpleC e m b
forall e (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> InterpretErrorSimpleC e m a
-> InterpretErrorSimpleC e m b
-> InterpretErrorSimpleC e 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
<* :: InterpretErrorSimpleC e m a
-> InterpretErrorSimpleC e m b -> InterpretErrorSimpleC e m a
$c<* :: forall e (m :: * -> *) a b.
Applicative m =>
InterpretErrorSimpleC e m a
-> InterpretErrorSimpleC e m b -> InterpretErrorSimpleC e m a
*> :: InterpretErrorSimpleC e m a
-> InterpretErrorSimpleC e m b -> InterpretErrorSimpleC e m b
$c*> :: forall e (m :: * -> *) a b.
Applicative m =>
InterpretErrorSimpleC e m a
-> InterpretErrorSimpleC e m b -> InterpretErrorSimpleC e m b
liftA2 :: (a -> b -> c)
-> InterpretErrorSimpleC e m a
-> InterpretErrorSimpleC e m b
-> InterpretErrorSimpleC e m c
$cliftA2 :: forall e (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> InterpretErrorSimpleC e m a
-> InterpretErrorSimpleC e m b
-> InterpretErrorSimpleC e m c
<*> :: InterpretErrorSimpleC e m (a -> b)
-> InterpretErrorSimpleC e m a -> InterpretErrorSimpleC e m b
$c<*> :: forall e (m :: * -> *) a b.
Applicative m =>
InterpretErrorSimpleC e m (a -> b)
-> InterpretErrorSimpleC e m a -> InterpretErrorSimpleC e m b
pure :: a -> InterpretErrorSimpleC e m a
$cpure :: forall e (m :: * -> *) a.
Applicative m =>
a -> InterpretErrorSimpleC e m a
$cp1Applicative :: forall e (m :: * -> *).
Applicative m =>
Functor (InterpretErrorSimpleC e m)
Applicative, Applicative (InterpretErrorSimpleC e m)
a -> InterpretErrorSimpleC e m a
Applicative (InterpretErrorSimpleC e m)
-> (forall a b.
InterpretErrorSimpleC e m a
-> (a -> InterpretErrorSimpleC e m b)
-> InterpretErrorSimpleC e m b)
-> (forall a b.
InterpretErrorSimpleC e m a
-> InterpretErrorSimpleC e m b -> InterpretErrorSimpleC e m b)
-> (forall a. a -> InterpretErrorSimpleC e m a)
-> Monad (InterpretErrorSimpleC e m)
InterpretErrorSimpleC e m a
-> (a -> InterpretErrorSimpleC e m b)
-> InterpretErrorSimpleC e m b
InterpretErrorSimpleC e m a
-> InterpretErrorSimpleC e m b -> InterpretErrorSimpleC e m b
forall a. a -> InterpretErrorSimpleC e m a
forall a b.
InterpretErrorSimpleC e m a
-> InterpretErrorSimpleC e m b -> InterpretErrorSimpleC e m b
forall a b.
InterpretErrorSimpleC e m a
-> (a -> InterpretErrorSimpleC e m b)
-> InterpretErrorSimpleC e m b
forall e (m :: * -> *).
Monad m =>
Applicative (InterpretErrorSimpleC e m)
forall e (m :: * -> *) a.
Monad m =>
a -> InterpretErrorSimpleC e m a
forall e (m :: * -> *) a b.
Monad m =>
InterpretErrorSimpleC e m a
-> InterpretErrorSimpleC e m b -> InterpretErrorSimpleC e m b
forall e (m :: * -> *) a b.
Monad m =>
InterpretErrorSimpleC e m a
-> (a -> InterpretErrorSimpleC e m b)
-> InterpretErrorSimpleC e 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 -> InterpretErrorSimpleC e m a
$creturn :: forall e (m :: * -> *) a.
Monad m =>
a -> InterpretErrorSimpleC e m a
>> :: InterpretErrorSimpleC e m a
-> InterpretErrorSimpleC e m b -> InterpretErrorSimpleC e m b
$c>> :: forall e (m :: * -> *) a b.
Monad m =>
InterpretErrorSimpleC e m a
-> InterpretErrorSimpleC e m b -> InterpretErrorSimpleC e m b
>>= :: InterpretErrorSimpleC e m a
-> (a -> InterpretErrorSimpleC e m b)
-> InterpretErrorSimpleC e m b
$c>>= :: forall e (m :: * -> *) a b.
Monad m =>
InterpretErrorSimpleC e m a
-> (a -> InterpretErrorSimpleC e m b)
-> InterpretErrorSimpleC e m b
$cp1Monad :: forall e (m :: * -> *).
Monad m =>
Applicative (InterpretErrorSimpleC e m)
Monad
, Applicative (InterpretErrorSimpleC e m)
InterpretErrorSimpleC e m a
Applicative (InterpretErrorSimpleC e m)
-> (forall a. InterpretErrorSimpleC e m a)
-> (forall a.
InterpretErrorSimpleC e m a
-> InterpretErrorSimpleC e m a -> InterpretErrorSimpleC e m a)
-> (forall a.
InterpretErrorSimpleC e m a -> InterpretErrorSimpleC e m [a])
-> (forall a.
InterpretErrorSimpleC e m a -> InterpretErrorSimpleC e m [a])
-> Alternative (InterpretErrorSimpleC e m)
InterpretErrorSimpleC e m a
-> InterpretErrorSimpleC e m a -> InterpretErrorSimpleC e m a
InterpretErrorSimpleC e m a -> InterpretErrorSimpleC e m [a]
InterpretErrorSimpleC e m a -> InterpretErrorSimpleC e m [a]
forall a. InterpretErrorSimpleC e m a
forall a.
InterpretErrorSimpleC e m a -> InterpretErrorSimpleC e m [a]
forall a.
InterpretErrorSimpleC e m a
-> InterpretErrorSimpleC e m a -> InterpretErrorSimpleC e m a
forall e (m :: * -> *).
Alternative m =>
Applicative (InterpretErrorSimpleC e m)
forall e (m :: * -> *) a.
Alternative m =>
InterpretErrorSimpleC e m a
forall e (m :: * -> *) a.
Alternative m =>
InterpretErrorSimpleC e m a -> InterpretErrorSimpleC e m [a]
forall e (m :: * -> *) a.
Alternative m =>
InterpretErrorSimpleC e m a
-> InterpretErrorSimpleC e m a -> InterpretErrorSimpleC e 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 :: InterpretErrorSimpleC e m a -> InterpretErrorSimpleC e m [a]
$cmany :: forall e (m :: * -> *) a.
Alternative m =>
InterpretErrorSimpleC e m a -> InterpretErrorSimpleC e m [a]
some :: InterpretErrorSimpleC e m a -> InterpretErrorSimpleC e m [a]
$csome :: forall e (m :: * -> *) a.
Alternative m =>
InterpretErrorSimpleC e m a -> InterpretErrorSimpleC e m [a]
<|> :: InterpretErrorSimpleC e m a
-> InterpretErrorSimpleC e m a -> InterpretErrorSimpleC e m a
$c<|> :: forall e (m :: * -> *) a.
Alternative m =>
InterpretErrorSimpleC e m a
-> InterpretErrorSimpleC e m a -> InterpretErrorSimpleC e m a
empty :: InterpretErrorSimpleC e m a
$cempty :: forall e (m :: * -> *) a.
Alternative m =>
InterpretErrorSimpleC e m a
$cp1Alternative :: forall e (m :: * -> *).
Alternative m =>
Applicative (InterpretErrorSimpleC e m)
Alternative, Monad (InterpretErrorSimpleC e m)
Alternative (InterpretErrorSimpleC e m)
InterpretErrorSimpleC e m a
Alternative (InterpretErrorSimpleC e m)
-> Monad (InterpretErrorSimpleC e m)
-> (forall a. InterpretErrorSimpleC e m a)
-> (forall a.
InterpretErrorSimpleC e m a
-> InterpretErrorSimpleC e m a -> InterpretErrorSimpleC e m a)
-> MonadPlus (InterpretErrorSimpleC e m)
InterpretErrorSimpleC e m a
-> InterpretErrorSimpleC e m a -> InterpretErrorSimpleC e m a
forall a. InterpretErrorSimpleC e m a
forall a.
InterpretErrorSimpleC e m a
-> InterpretErrorSimpleC e m a -> InterpretErrorSimpleC e m a
forall e (m :: * -> *).
MonadPlus m =>
Monad (InterpretErrorSimpleC e m)
forall e (m :: * -> *).
MonadPlus m =>
Alternative (InterpretErrorSimpleC e m)
forall e (m :: * -> *) a.
MonadPlus m =>
InterpretErrorSimpleC e m a
forall e (m :: * -> *) a.
MonadPlus m =>
InterpretErrorSimpleC e m a
-> InterpretErrorSimpleC e m a -> InterpretErrorSimpleC e m a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
mplus :: InterpretErrorSimpleC e m a
-> InterpretErrorSimpleC e m a -> InterpretErrorSimpleC e m a
$cmplus :: forall e (m :: * -> *) a.
MonadPlus m =>
InterpretErrorSimpleC e m a
-> InterpretErrorSimpleC e m a -> InterpretErrorSimpleC e m a
mzero :: InterpretErrorSimpleC e m a
$cmzero :: forall e (m :: * -> *) a.
MonadPlus m =>
InterpretErrorSimpleC e m a
$cp2MonadPlus :: forall e (m :: * -> *).
MonadPlus m =>
Monad (InterpretErrorSimpleC e m)
$cp1MonadPlus :: forall e (m :: * -> *).
MonadPlus m =>
Alternative (InterpretErrorSimpleC e m)
MonadPlus
, Monad (InterpretErrorSimpleC e m)
Monad (InterpretErrorSimpleC e m)
-> (forall a.
(a -> InterpretErrorSimpleC e m a) -> InterpretErrorSimpleC e m a)
-> MonadFix (InterpretErrorSimpleC e m)
(a -> InterpretErrorSimpleC e m a) -> InterpretErrorSimpleC e m a
forall a.
(a -> InterpretErrorSimpleC e m a) -> InterpretErrorSimpleC e m a
forall e (m :: * -> *).
MonadFix m =>
Monad (InterpretErrorSimpleC e m)
forall e (m :: * -> *) a.
MonadFix m =>
(a -> InterpretErrorSimpleC e m a) -> InterpretErrorSimpleC e m a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
mfix :: (a -> InterpretErrorSimpleC e m a) -> InterpretErrorSimpleC e m a
$cmfix :: forall e (m :: * -> *) a.
MonadFix m =>
(a -> InterpretErrorSimpleC e m a) -> InterpretErrorSimpleC e m a
$cp1MonadFix :: forall e (m :: * -> *).
MonadFix m =>
Monad (InterpretErrorSimpleC e m)
MonadFix, Monad (InterpretErrorSimpleC e m)
Monad (InterpretErrorSimpleC e m)
-> (forall a. String -> InterpretErrorSimpleC e m a)
-> MonadFail (InterpretErrorSimpleC e m)
String -> InterpretErrorSimpleC e m a
forall a. String -> InterpretErrorSimpleC e m a
forall e (m :: * -> *).
MonadFail m =>
Monad (InterpretErrorSimpleC e m)
forall e (m :: * -> *) a.
MonadFail m =>
String -> InterpretErrorSimpleC e m a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
fail :: String -> InterpretErrorSimpleC e m a
$cfail :: forall e (m :: * -> *) a.
MonadFail m =>
String -> InterpretErrorSimpleC e m a
$cp1MonadFail :: forall e (m :: * -> *).
MonadFail m =>
Monad (InterpretErrorSimpleC e m)
MonadFail, Monad (InterpretErrorSimpleC e m)
Monad (InterpretErrorSimpleC e m)
-> (forall a. IO a -> InterpretErrorSimpleC e m a)
-> MonadIO (InterpretErrorSimpleC e m)
IO a -> InterpretErrorSimpleC e m a
forall a. IO a -> InterpretErrorSimpleC e m a
forall e (m :: * -> *).
MonadIO m =>
Monad (InterpretErrorSimpleC e m)
forall e (m :: * -> *) a.
MonadIO m =>
IO a -> InterpretErrorSimpleC e m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> InterpretErrorSimpleC e m a
$cliftIO :: forall e (m :: * -> *) a.
MonadIO m =>
IO a -> InterpretErrorSimpleC e m a
$cp1MonadIO :: forall e (m :: * -> *).
MonadIO m =>
Monad (InterpretErrorSimpleC e m)
MonadIO
, Monad (InterpretErrorSimpleC e m)
e -> InterpretErrorSimpleC e m a
Monad (InterpretErrorSimpleC e m)
-> (forall e a. Exception e => e -> InterpretErrorSimpleC e m a)
-> MonadThrow (InterpretErrorSimpleC e m)
forall e a. Exception e => e -> InterpretErrorSimpleC e m a
forall e (m :: * -> *).
MonadThrow m =>
Monad (InterpretErrorSimpleC e m)
forall e (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> InterpretErrorSimpleC e m a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: e -> InterpretErrorSimpleC e m a
$cthrowM :: forall e (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> InterpretErrorSimpleC e m a
$cp1MonadThrow :: forall e (m :: * -> *).
MonadThrow m =>
Monad (InterpretErrorSimpleC e m)
MonadThrow, MonadThrow (InterpretErrorSimpleC e m)
MonadThrow (InterpretErrorSimpleC e m)
-> (forall e a.
Exception e =>
InterpretErrorSimpleC e m a
-> (e -> InterpretErrorSimpleC e m a)
-> InterpretErrorSimpleC e m a)
-> MonadCatch (InterpretErrorSimpleC e m)
InterpretErrorSimpleC e m a
-> (e -> InterpretErrorSimpleC e m a)
-> InterpretErrorSimpleC e m a
forall e a.
Exception e =>
InterpretErrorSimpleC e m a
-> (e -> InterpretErrorSimpleC e m a)
-> InterpretErrorSimpleC e m a
forall e (m :: * -> *).
MonadCatch m =>
MonadThrow (InterpretErrorSimpleC e m)
forall e (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
InterpretErrorSimpleC e m a
-> (e -> InterpretErrorSimpleC e m a)
-> InterpretErrorSimpleC e m a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
catch :: InterpretErrorSimpleC e m a
-> (e -> InterpretErrorSimpleC e m a)
-> InterpretErrorSimpleC e m a
$ccatch :: forall e (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
InterpretErrorSimpleC e m a
-> (e -> InterpretErrorSimpleC e m a)
-> InterpretErrorSimpleC e m a
$cp1MonadCatch :: forall e (m :: * -> *).
MonadCatch m =>
MonadThrow (InterpretErrorSimpleC e m)
MonadCatch, MonadCatch (InterpretErrorSimpleC e m)
MonadCatch (InterpretErrorSimpleC e m)
-> (forall b.
((forall a.
InterpretErrorSimpleC e m a -> InterpretErrorSimpleC e m a)
-> InterpretErrorSimpleC e m b)
-> InterpretErrorSimpleC e m b)
-> (forall b.
((forall a.
InterpretErrorSimpleC e m a -> InterpretErrorSimpleC e m a)
-> InterpretErrorSimpleC e m b)
-> InterpretErrorSimpleC e m b)
-> (forall a b c.
InterpretErrorSimpleC e m a
-> (a -> ExitCase b -> InterpretErrorSimpleC e m c)
-> (a -> InterpretErrorSimpleC e m b)
-> InterpretErrorSimpleC e m (b, c))
-> MonadMask (InterpretErrorSimpleC e m)
InterpretErrorSimpleC e m a
-> (a -> ExitCase b -> InterpretErrorSimpleC e m c)
-> (a -> InterpretErrorSimpleC e m b)
-> InterpretErrorSimpleC e m (b, c)
((forall a.
InterpretErrorSimpleC e m a -> InterpretErrorSimpleC e m a)
-> InterpretErrorSimpleC e m b)
-> InterpretErrorSimpleC e m b
((forall a.
InterpretErrorSimpleC e m a -> InterpretErrorSimpleC e m a)
-> InterpretErrorSimpleC e m b)
-> InterpretErrorSimpleC e m b
forall b.
((forall a.
InterpretErrorSimpleC e m a -> InterpretErrorSimpleC e m a)
-> InterpretErrorSimpleC e m b)
-> InterpretErrorSimpleC e m b
forall a b c.
InterpretErrorSimpleC e m a
-> (a -> ExitCase b -> InterpretErrorSimpleC e m c)
-> (a -> InterpretErrorSimpleC e m b)
-> InterpretErrorSimpleC e m (b, c)
forall e (m :: * -> *).
MonadMask m =>
MonadCatch (InterpretErrorSimpleC e m)
forall e (m :: * -> *) b.
MonadMask m =>
((forall a.
InterpretErrorSimpleC e m a -> InterpretErrorSimpleC e m a)
-> InterpretErrorSimpleC e m b)
-> InterpretErrorSimpleC e m b
forall e (m :: * -> *) a b c.
MonadMask m =>
InterpretErrorSimpleC e m a
-> (a -> ExitCase b -> InterpretErrorSimpleC e m c)
-> (a -> InterpretErrorSimpleC e m b)
-> InterpretErrorSimpleC e 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 :: InterpretErrorSimpleC e m a
-> (a -> ExitCase b -> InterpretErrorSimpleC e m c)
-> (a -> InterpretErrorSimpleC e m b)
-> InterpretErrorSimpleC e m (b, c)
$cgeneralBracket :: forall e (m :: * -> *) a b c.
MonadMask m =>
InterpretErrorSimpleC e m a
-> (a -> ExitCase b -> InterpretErrorSimpleC e m c)
-> (a -> InterpretErrorSimpleC e m b)
-> InterpretErrorSimpleC e m (b, c)
uninterruptibleMask :: ((forall a.
InterpretErrorSimpleC e m a -> InterpretErrorSimpleC e m a)
-> InterpretErrorSimpleC e m b)
-> InterpretErrorSimpleC e m b
$cuninterruptibleMask :: forall e (m :: * -> *) b.
MonadMask m =>
((forall a.
InterpretErrorSimpleC e m a -> InterpretErrorSimpleC e m a)
-> InterpretErrorSimpleC e m b)
-> InterpretErrorSimpleC e m b
mask :: ((forall a.
InterpretErrorSimpleC e m a -> InterpretErrorSimpleC e m a)
-> InterpretErrorSimpleC e m b)
-> InterpretErrorSimpleC e m b
$cmask :: forall e (m :: * -> *) b.
MonadMask m =>
((forall a.
InterpretErrorSimpleC e m a -> InterpretErrorSimpleC e m a)
-> InterpretErrorSimpleC e m b)
-> InterpretErrorSimpleC e m b
$cp1MonadMask :: forall e (m :: * -> *).
MonadMask m =>
MonadCatch (InterpretErrorSimpleC e m)
MonadMask
, MonadBase b, MonadBaseControl b
)
deriving m a -> InterpretErrorSimpleC e m a
(forall (m :: * -> *) a.
Monad m =>
m a -> InterpretErrorSimpleC e m a)
-> MonadTrans (InterpretErrorSimpleC e)
forall e (m :: * -> *) a.
Monad m =>
m a -> InterpretErrorSimpleC e m a
forall (m :: * -> *) a.
Monad m =>
m a -> InterpretErrorSimpleC e m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> InterpretErrorSimpleC e m a
$clift :: forall e (m :: * -> *) a.
Monad m =>
m a -> InterpretErrorSimpleC e m a
MonadTrans
via CompositionBaseT
'[ InterpretSimpleC (Catch e)
, InterpretSimpleC (Throw e)
]
deriving instance (Carrier m, Threaders '[ReaderThreads] m p)
=> Carrier (InterpretErrorSimpleC e m)
newtype ErrorToIOSimpleC e m a = ErrorToIOSimpleC {
ErrorToIOSimpleC e m a
-> IntroC
'[Catch e, Throw e]
'[ErrorIO]
(InterpretErrorSimpleC e (ErrorIOToIOC m))
a
unErrorToIOSimpleC ::
IntroC '[Catch e, Throw e] '[ErrorIO]
( InterpretErrorSimpleC e
( ErrorIOToIOC
( m
))) a
} deriving ( a -> ErrorToIOSimpleC e m b -> ErrorToIOSimpleC e m a
(a -> b) -> ErrorToIOSimpleC e m a -> ErrorToIOSimpleC e m b
(forall a b.
(a -> b) -> ErrorToIOSimpleC e m a -> ErrorToIOSimpleC e m b)
-> (forall a b.
a -> ErrorToIOSimpleC e m b -> ErrorToIOSimpleC e m a)
-> Functor (ErrorToIOSimpleC e m)
forall a b. a -> ErrorToIOSimpleC e m b -> ErrorToIOSimpleC e m a
forall a b.
(a -> b) -> ErrorToIOSimpleC e m a -> ErrorToIOSimpleC e m b
forall e (m :: * -> *) a b.
Functor m =>
a -> ErrorToIOSimpleC e m b -> ErrorToIOSimpleC e m a
forall e (m :: * -> *) a b.
Functor m =>
(a -> b) -> ErrorToIOSimpleC e m a -> ErrorToIOSimpleC e m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ErrorToIOSimpleC e m b -> ErrorToIOSimpleC e m a
$c<$ :: forall e (m :: * -> *) a b.
Functor m =>
a -> ErrorToIOSimpleC e m b -> ErrorToIOSimpleC e m a
fmap :: (a -> b) -> ErrorToIOSimpleC e m a -> ErrorToIOSimpleC e m b
$cfmap :: forall e (m :: * -> *) a b.
Functor m =>
(a -> b) -> ErrorToIOSimpleC e m a -> ErrorToIOSimpleC e m b
Functor, Functor (ErrorToIOSimpleC e m)
a -> ErrorToIOSimpleC e m a
Functor (ErrorToIOSimpleC e m)
-> (forall a. a -> ErrorToIOSimpleC e m a)
-> (forall a b.
ErrorToIOSimpleC e m (a -> b)
-> ErrorToIOSimpleC e m a -> ErrorToIOSimpleC e m b)
-> (forall a b c.
(a -> b -> c)
-> ErrorToIOSimpleC e m a
-> ErrorToIOSimpleC e m b
-> ErrorToIOSimpleC e m c)
-> (forall a b.
ErrorToIOSimpleC e m a
-> ErrorToIOSimpleC e m b -> ErrorToIOSimpleC e m b)
-> (forall a b.
ErrorToIOSimpleC e m a
-> ErrorToIOSimpleC e m b -> ErrorToIOSimpleC e m a)
-> Applicative (ErrorToIOSimpleC e m)
ErrorToIOSimpleC e m a
-> ErrorToIOSimpleC e m b -> ErrorToIOSimpleC e m b
ErrorToIOSimpleC e m a
-> ErrorToIOSimpleC e m b -> ErrorToIOSimpleC e m a
ErrorToIOSimpleC e m (a -> b)
-> ErrorToIOSimpleC e m a -> ErrorToIOSimpleC e m b
(a -> b -> c)
-> ErrorToIOSimpleC e m a
-> ErrorToIOSimpleC e m b
-> ErrorToIOSimpleC e m c
forall a. a -> ErrorToIOSimpleC e m a
forall a b.
ErrorToIOSimpleC e m a
-> ErrorToIOSimpleC e m b -> ErrorToIOSimpleC e m a
forall a b.
ErrorToIOSimpleC e m a
-> ErrorToIOSimpleC e m b -> ErrorToIOSimpleC e m b
forall a b.
ErrorToIOSimpleC e m (a -> b)
-> ErrorToIOSimpleC e m a -> ErrorToIOSimpleC e m b
forall a b c.
(a -> b -> c)
-> ErrorToIOSimpleC e m a
-> ErrorToIOSimpleC e m b
-> ErrorToIOSimpleC e m c
forall e (m :: * -> *).
Applicative m =>
Functor (ErrorToIOSimpleC e m)
forall e (m :: * -> *) a.
Applicative m =>
a -> ErrorToIOSimpleC e m a
forall e (m :: * -> *) a b.
Applicative m =>
ErrorToIOSimpleC e m a
-> ErrorToIOSimpleC e m b -> ErrorToIOSimpleC e m a
forall e (m :: * -> *) a b.
Applicative m =>
ErrorToIOSimpleC e m a
-> ErrorToIOSimpleC e m b -> ErrorToIOSimpleC e m b
forall e (m :: * -> *) a b.
Applicative m =>
ErrorToIOSimpleC e m (a -> b)
-> ErrorToIOSimpleC e m a -> ErrorToIOSimpleC e m b
forall e (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> ErrorToIOSimpleC e m a
-> ErrorToIOSimpleC e m b
-> ErrorToIOSimpleC e 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
<* :: ErrorToIOSimpleC e m a
-> ErrorToIOSimpleC e m b -> ErrorToIOSimpleC e m a
$c<* :: forall e (m :: * -> *) a b.
Applicative m =>
ErrorToIOSimpleC e m a
-> ErrorToIOSimpleC e m b -> ErrorToIOSimpleC e m a
*> :: ErrorToIOSimpleC e m a
-> ErrorToIOSimpleC e m b -> ErrorToIOSimpleC e m b
$c*> :: forall e (m :: * -> *) a b.
Applicative m =>
ErrorToIOSimpleC e m a
-> ErrorToIOSimpleC e m b -> ErrorToIOSimpleC e m b
liftA2 :: (a -> b -> c)
-> ErrorToIOSimpleC e m a
-> ErrorToIOSimpleC e m b
-> ErrorToIOSimpleC e m c
$cliftA2 :: forall e (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> ErrorToIOSimpleC e m a
-> ErrorToIOSimpleC e m b
-> ErrorToIOSimpleC e m c
<*> :: ErrorToIOSimpleC e m (a -> b)
-> ErrorToIOSimpleC e m a -> ErrorToIOSimpleC e m b
$c<*> :: forall e (m :: * -> *) a b.
Applicative m =>
ErrorToIOSimpleC e m (a -> b)
-> ErrorToIOSimpleC e m a -> ErrorToIOSimpleC e m b
pure :: a -> ErrorToIOSimpleC e m a
$cpure :: forall e (m :: * -> *) a.
Applicative m =>
a -> ErrorToIOSimpleC e m a
$cp1Applicative :: forall e (m :: * -> *).
Applicative m =>
Functor (ErrorToIOSimpleC e m)
Applicative, Applicative (ErrorToIOSimpleC e m)
a -> ErrorToIOSimpleC e m a
Applicative (ErrorToIOSimpleC e m)
-> (forall a b.
ErrorToIOSimpleC e m a
-> (a -> ErrorToIOSimpleC e m b) -> ErrorToIOSimpleC e m b)
-> (forall a b.
ErrorToIOSimpleC e m a
-> ErrorToIOSimpleC e m b -> ErrorToIOSimpleC e m b)
-> (forall a. a -> ErrorToIOSimpleC e m a)
-> Monad (ErrorToIOSimpleC e m)
ErrorToIOSimpleC e m a
-> (a -> ErrorToIOSimpleC e m b) -> ErrorToIOSimpleC e m b
ErrorToIOSimpleC e m a
-> ErrorToIOSimpleC e m b -> ErrorToIOSimpleC e m b
forall a. a -> ErrorToIOSimpleC e m a
forall a b.
ErrorToIOSimpleC e m a
-> ErrorToIOSimpleC e m b -> ErrorToIOSimpleC e m b
forall a b.
ErrorToIOSimpleC e m a
-> (a -> ErrorToIOSimpleC e m b) -> ErrorToIOSimpleC e m b
forall e (m :: * -> *).
Monad m =>
Applicative (ErrorToIOSimpleC e m)
forall e (m :: * -> *) a. Monad m => a -> ErrorToIOSimpleC e m a
forall e (m :: * -> *) a b.
Monad m =>
ErrorToIOSimpleC e m a
-> ErrorToIOSimpleC e m b -> ErrorToIOSimpleC e m b
forall e (m :: * -> *) a b.
Monad m =>
ErrorToIOSimpleC e m a
-> (a -> ErrorToIOSimpleC e m b) -> ErrorToIOSimpleC e 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 -> ErrorToIOSimpleC e m a
$creturn :: forall e (m :: * -> *) a. Monad m => a -> ErrorToIOSimpleC e m a
>> :: ErrorToIOSimpleC e m a
-> ErrorToIOSimpleC e m b -> ErrorToIOSimpleC e m b
$c>> :: forall e (m :: * -> *) a b.
Monad m =>
ErrorToIOSimpleC e m a
-> ErrorToIOSimpleC e m b -> ErrorToIOSimpleC e m b
>>= :: ErrorToIOSimpleC e m a
-> (a -> ErrorToIOSimpleC e m b) -> ErrorToIOSimpleC e m b
$c>>= :: forall e (m :: * -> *) a b.
Monad m =>
ErrorToIOSimpleC e m a
-> (a -> ErrorToIOSimpleC e m b) -> ErrorToIOSimpleC e m b
$cp1Monad :: forall e (m :: * -> *).
Monad m =>
Applicative (ErrorToIOSimpleC e m)
Monad
, Applicative (ErrorToIOSimpleC e m)
ErrorToIOSimpleC e m a
Applicative (ErrorToIOSimpleC e m)
-> (forall a. ErrorToIOSimpleC e m a)
-> (forall a.
ErrorToIOSimpleC e m a
-> ErrorToIOSimpleC e m a -> ErrorToIOSimpleC e m a)
-> (forall a. ErrorToIOSimpleC e m a -> ErrorToIOSimpleC e m [a])
-> (forall a. ErrorToIOSimpleC e m a -> ErrorToIOSimpleC e m [a])
-> Alternative (ErrorToIOSimpleC e m)
ErrorToIOSimpleC e m a
-> ErrorToIOSimpleC e m a -> ErrorToIOSimpleC e m a
ErrorToIOSimpleC e m a -> ErrorToIOSimpleC e m [a]
ErrorToIOSimpleC e m a -> ErrorToIOSimpleC e m [a]
forall a. ErrorToIOSimpleC e m a
forall a. ErrorToIOSimpleC e m a -> ErrorToIOSimpleC e m [a]
forall a.
ErrorToIOSimpleC e m a
-> ErrorToIOSimpleC e m a -> ErrorToIOSimpleC e m a
forall e (m :: * -> *).
Alternative m =>
Applicative (ErrorToIOSimpleC e m)
forall e (m :: * -> *) a. Alternative m => ErrorToIOSimpleC e m a
forall e (m :: * -> *) a.
Alternative m =>
ErrorToIOSimpleC e m a -> ErrorToIOSimpleC e m [a]
forall e (m :: * -> *) a.
Alternative m =>
ErrorToIOSimpleC e m a
-> ErrorToIOSimpleC e m a -> ErrorToIOSimpleC e 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 :: ErrorToIOSimpleC e m a -> ErrorToIOSimpleC e m [a]
$cmany :: forall e (m :: * -> *) a.
Alternative m =>
ErrorToIOSimpleC e m a -> ErrorToIOSimpleC e m [a]
some :: ErrorToIOSimpleC e m a -> ErrorToIOSimpleC e m [a]
$csome :: forall e (m :: * -> *) a.
Alternative m =>
ErrorToIOSimpleC e m a -> ErrorToIOSimpleC e m [a]
<|> :: ErrorToIOSimpleC e m a
-> ErrorToIOSimpleC e m a -> ErrorToIOSimpleC e m a
$c<|> :: forall e (m :: * -> *) a.
Alternative m =>
ErrorToIOSimpleC e m a
-> ErrorToIOSimpleC e m a -> ErrorToIOSimpleC e m a
empty :: ErrorToIOSimpleC e m a
$cempty :: forall e (m :: * -> *) a. Alternative m => ErrorToIOSimpleC e m a
$cp1Alternative :: forall e (m :: * -> *).
Alternative m =>
Applicative (ErrorToIOSimpleC e m)
Alternative, Monad (ErrorToIOSimpleC e m)
Alternative (ErrorToIOSimpleC e m)
ErrorToIOSimpleC e m a
Alternative (ErrorToIOSimpleC e m)
-> Monad (ErrorToIOSimpleC e m)
-> (forall a. ErrorToIOSimpleC e m a)
-> (forall a.
ErrorToIOSimpleC e m a
-> ErrorToIOSimpleC e m a -> ErrorToIOSimpleC e m a)
-> MonadPlus (ErrorToIOSimpleC e m)
ErrorToIOSimpleC e m a
-> ErrorToIOSimpleC e m a -> ErrorToIOSimpleC e m a
forall a. ErrorToIOSimpleC e m a
forall a.
ErrorToIOSimpleC e m a
-> ErrorToIOSimpleC e m a -> ErrorToIOSimpleC e m a
forall e (m :: * -> *). MonadPlus m => Monad (ErrorToIOSimpleC e m)
forall e (m :: * -> *).
MonadPlus m =>
Alternative (ErrorToIOSimpleC e m)
forall e (m :: * -> *) a. MonadPlus m => ErrorToIOSimpleC e m a
forall e (m :: * -> *) a.
MonadPlus m =>
ErrorToIOSimpleC e m a
-> ErrorToIOSimpleC e m a -> ErrorToIOSimpleC e m a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
mplus :: ErrorToIOSimpleC e m a
-> ErrorToIOSimpleC e m a -> ErrorToIOSimpleC e m a
$cmplus :: forall e (m :: * -> *) a.
MonadPlus m =>
ErrorToIOSimpleC e m a
-> ErrorToIOSimpleC e m a -> ErrorToIOSimpleC e m a
mzero :: ErrorToIOSimpleC e m a
$cmzero :: forall e (m :: * -> *) a. MonadPlus m => ErrorToIOSimpleC e m a
$cp2MonadPlus :: forall e (m :: * -> *). MonadPlus m => Monad (ErrorToIOSimpleC e m)
$cp1MonadPlus :: forall e (m :: * -> *).
MonadPlus m =>
Alternative (ErrorToIOSimpleC e m)
MonadPlus
, Monad (ErrorToIOSimpleC e m)
Monad (ErrorToIOSimpleC e m)
-> (forall a.
(a -> ErrorToIOSimpleC e m a) -> ErrorToIOSimpleC e m a)
-> MonadFix (ErrorToIOSimpleC e m)
(a -> ErrorToIOSimpleC e m a) -> ErrorToIOSimpleC e m a
forall a. (a -> ErrorToIOSimpleC e m a) -> ErrorToIOSimpleC e m a
forall e (m :: * -> *). MonadFix m => Monad (ErrorToIOSimpleC e m)
forall e (m :: * -> *) a.
MonadFix m =>
(a -> ErrorToIOSimpleC e m a) -> ErrorToIOSimpleC e m a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
mfix :: (a -> ErrorToIOSimpleC e m a) -> ErrorToIOSimpleC e m a
$cmfix :: forall e (m :: * -> *) a.
MonadFix m =>
(a -> ErrorToIOSimpleC e m a) -> ErrorToIOSimpleC e m a
$cp1MonadFix :: forall e (m :: * -> *). MonadFix m => Monad (ErrorToIOSimpleC e m)
MonadFix, Monad (ErrorToIOSimpleC e m)
Monad (ErrorToIOSimpleC e m)
-> (forall a. String -> ErrorToIOSimpleC e m a)
-> MonadFail (ErrorToIOSimpleC e m)
String -> ErrorToIOSimpleC e m a
forall a. String -> ErrorToIOSimpleC e m a
forall e (m :: * -> *). MonadFail m => Monad (ErrorToIOSimpleC e m)
forall e (m :: * -> *) a.
MonadFail m =>
String -> ErrorToIOSimpleC e m a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
fail :: String -> ErrorToIOSimpleC e m a
$cfail :: forall e (m :: * -> *) a.
MonadFail m =>
String -> ErrorToIOSimpleC e m a
$cp1MonadFail :: forall e (m :: * -> *). MonadFail m => Monad (ErrorToIOSimpleC e m)
MonadFail, Monad (ErrorToIOSimpleC e m)
Monad (ErrorToIOSimpleC e m)
-> (forall a. IO a -> ErrorToIOSimpleC e m a)
-> MonadIO (ErrorToIOSimpleC e m)
IO a -> ErrorToIOSimpleC e m a
forall a. IO a -> ErrorToIOSimpleC e m a
forall e (m :: * -> *). MonadIO m => Monad (ErrorToIOSimpleC e m)
forall e (m :: * -> *) a.
MonadIO m =>
IO a -> ErrorToIOSimpleC e m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> ErrorToIOSimpleC e m a
$cliftIO :: forall e (m :: * -> *) a.
MonadIO m =>
IO a -> ErrorToIOSimpleC e m a
$cp1MonadIO :: forall e (m :: * -> *). MonadIO m => Monad (ErrorToIOSimpleC e m)
MonadIO
, Monad (ErrorToIOSimpleC e m)
e -> ErrorToIOSimpleC e m a
Monad (ErrorToIOSimpleC e m)
-> (forall e a. Exception e => e -> ErrorToIOSimpleC e m a)
-> MonadThrow (ErrorToIOSimpleC e m)
forall e a. Exception e => e -> ErrorToIOSimpleC e m a
forall e (m :: * -> *).
MonadThrow m =>
Monad (ErrorToIOSimpleC e m)
forall e (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> ErrorToIOSimpleC e m a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: e -> ErrorToIOSimpleC e m a
$cthrowM :: forall e (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> ErrorToIOSimpleC e m a
$cp1MonadThrow :: forall e (m :: * -> *).
MonadThrow m =>
Monad (ErrorToIOSimpleC e m)
MonadThrow, MonadThrow (ErrorToIOSimpleC e m)
MonadThrow (ErrorToIOSimpleC e m)
-> (forall e a.
Exception e =>
ErrorToIOSimpleC e m a
-> (e -> ErrorToIOSimpleC e m a) -> ErrorToIOSimpleC e m a)
-> MonadCatch (ErrorToIOSimpleC e m)
ErrorToIOSimpleC e m a
-> (e -> ErrorToIOSimpleC e m a) -> ErrorToIOSimpleC e m a
forall e a.
Exception e =>
ErrorToIOSimpleC e m a
-> (e -> ErrorToIOSimpleC e m a) -> ErrorToIOSimpleC e m a
forall e (m :: * -> *).
MonadCatch m =>
MonadThrow (ErrorToIOSimpleC e m)
forall e (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
ErrorToIOSimpleC e m a
-> (e -> ErrorToIOSimpleC e m a) -> ErrorToIOSimpleC e m a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
catch :: ErrorToIOSimpleC e m a
-> (e -> ErrorToIOSimpleC e m a) -> ErrorToIOSimpleC e m a
$ccatch :: forall e (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
ErrorToIOSimpleC e m a
-> (e -> ErrorToIOSimpleC e m a) -> ErrorToIOSimpleC e m a
$cp1MonadCatch :: forall e (m :: * -> *).
MonadCatch m =>
MonadThrow (ErrorToIOSimpleC e m)
MonadCatch, MonadCatch (ErrorToIOSimpleC e m)
MonadCatch (ErrorToIOSimpleC e m)
-> (forall b.
((forall a. ErrorToIOSimpleC e m a -> ErrorToIOSimpleC e m a)
-> ErrorToIOSimpleC e m b)
-> ErrorToIOSimpleC e m b)
-> (forall b.
((forall a. ErrorToIOSimpleC e m a -> ErrorToIOSimpleC e m a)
-> ErrorToIOSimpleC e m b)
-> ErrorToIOSimpleC e m b)
-> (forall a b c.
ErrorToIOSimpleC e m a
-> (a -> ExitCase b -> ErrorToIOSimpleC e m c)
-> (a -> ErrorToIOSimpleC e m b)
-> ErrorToIOSimpleC e m (b, c))
-> MonadMask (ErrorToIOSimpleC e m)
ErrorToIOSimpleC e m a
-> (a -> ExitCase b -> ErrorToIOSimpleC e m c)
-> (a -> ErrorToIOSimpleC e m b)
-> ErrorToIOSimpleC e m (b, c)
((forall a. ErrorToIOSimpleC e m a -> ErrorToIOSimpleC e m a)
-> ErrorToIOSimpleC e m b)
-> ErrorToIOSimpleC e m b
((forall a. ErrorToIOSimpleC e m a -> ErrorToIOSimpleC e m a)
-> ErrorToIOSimpleC e m b)
-> ErrorToIOSimpleC e m b
forall b.
((forall a. ErrorToIOSimpleC e m a -> ErrorToIOSimpleC e m a)
-> ErrorToIOSimpleC e m b)
-> ErrorToIOSimpleC e m b
forall a b c.
ErrorToIOSimpleC e m a
-> (a -> ExitCase b -> ErrorToIOSimpleC e m c)
-> (a -> ErrorToIOSimpleC e m b)
-> ErrorToIOSimpleC e m (b, c)
forall e (m :: * -> *).
MonadMask m =>
MonadCatch (ErrorToIOSimpleC e m)
forall e (m :: * -> *) b.
MonadMask m =>
((forall a. ErrorToIOSimpleC e m a -> ErrorToIOSimpleC e m a)
-> ErrorToIOSimpleC e m b)
-> ErrorToIOSimpleC e m b
forall e (m :: * -> *) a b c.
MonadMask m =>
ErrorToIOSimpleC e m a
-> (a -> ExitCase b -> ErrorToIOSimpleC e m c)
-> (a -> ErrorToIOSimpleC e m b)
-> ErrorToIOSimpleC e 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 :: ErrorToIOSimpleC e m a
-> (a -> ExitCase b -> ErrorToIOSimpleC e m c)
-> (a -> ErrorToIOSimpleC e m b)
-> ErrorToIOSimpleC e m (b, c)
$cgeneralBracket :: forall e (m :: * -> *) a b c.
MonadMask m =>
ErrorToIOSimpleC e m a
-> (a -> ExitCase b -> ErrorToIOSimpleC e m c)
-> (a -> ErrorToIOSimpleC e m b)
-> ErrorToIOSimpleC e m (b, c)
uninterruptibleMask :: ((forall a. ErrorToIOSimpleC e m a -> ErrorToIOSimpleC e m a)
-> ErrorToIOSimpleC e m b)
-> ErrorToIOSimpleC e m b
$cuninterruptibleMask :: forall e (m :: * -> *) b.
MonadMask m =>
((forall a. ErrorToIOSimpleC e m a -> ErrorToIOSimpleC e m a)
-> ErrorToIOSimpleC e m b)
-> ErrorToIOSimpleC e m b
mask :: ((forall a. ErrorToIOSimpleC e m a -> ErrorToIOSimpleC e m a)
-> ErrorToIOSimpleC e m b)
-> ErrorToIOSimpleC e m b
$cmask :: forall e (m :: * -> *) b.
MonadMask m =>
((forall a. ErrorToIOSimpleC e m a -> ErrorToIOSimpleC e m a)
-> ErrorToIOSimpleC e m b)
-> ErrorToIOSimpleC e m b
$cp1MonadMask :: forall e (m :: * -> *).
MonadMask m =>
MonadCatch (ErrorToIOSimpleC e m)
MonadMask
, MonadBase b, MonadBaseControl b
)
deriving m a -> ErrorToIOSimpleC e m a
(forall (m :: * -> *) a. Monad m => m a -> ErrorToIOSimpleC e m a)
-> MonadTrans (ErrorToIOSimpleC e)
forall e (m :: * -> *) a. Monad m => m a -> ErrorToIOSimpleC e m a
forall (m :: * -> *) a. Monad m => m a -> ErrorToIOSimpleC e m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> ErrorToIOSimpleC e m a
$clift :: forall e (m :: * -> *) a. Monad m => m a -> ErrorToIOSimpleC e m a
MonadTrans
via CompositionBaseT
'[ IntroC '[Catch e, Throw e] '[ErrorIO]
, InterpretErrorSimpleC e
, ErrorIOToIOC
]
deriving instance ( Eff (Embed IO) m, C.MonadCatch m
, Threaders '[ReaderThreads] m p
)
=> Carrier (ErrorToIOSimpleC e m)
errorToErrorIOSimple :: forall e m a p
. ( Effs '[ErrorIO, Embed IO] m
, Threaders '[ReaderThreads] m p
)
=> InterpretErrorSimpleC e m a
-> m (Either e a)
errorToErrorIOSimple :: InterpretErrorSimpleC e m a -> m (Either e a)
errorToErrorIOSimple InterpretErrorSimpleC e m a
main = do
!Unique
uniq <- IO Unique -> m Unique
forall (b :: * -> *) (m :: * -> *) a. Eff (Embed b) m => b a -> m a
embed IO Unique
newUnique
let
main' :: m a
main' =
EffHandler (Throw e) m -> InterpretSimpleC (Throw e) m a -> m a
forall (e :: (* -> *) -> * -> *) (m :: * -> *) a
(p :: [(* -> *) -> * -> *]).
(RepresentationalEff e, Threaders '[ReaderThreads] m p,
Carrier m) =>
EffHandler e m -> InterpretSimpleC e m a -> m a
interpretSimple \case
Throw e -> OpaqueExc -> Effly z x
forall e (m :: * -> *) a. (Exception e, Eff ErrorIO m) => e -> m a
throwIO (Unique -> Any -> OpaqueExc
OpaqueExc Unique
uniq (e -> Any
forall a b. a -> b
unsafeCoerce e
e))
(InterpretSimpleC (Throw e) m a -> m a)
-> InterpretSimpleC (Throw e) m a -> m a
forall a b. (a -> b) -> a -> b
$ EffHandler (Catch e) (InterpretSimpleC (Throw e) m)
-> InterpretSimpleC (Catch e) (InterpretSimpleC (Throw e) m) a
-> InterpretSimpleC (Throw e) m a
forall (e :: (* -> *) -> * -> *) (m :: * -> *) a
(p :: [(* -> *) -> * -> *]).
(RepresentationalEff e, Threaders '[ReaderThreads] m p,
Carrier m) =>
EffHandler e m -> InterpretSimpleC e m a -> m a
interpretSimple \case
Catch m h -> Effly z x
m Effly z x -> (OpaqueExc -> Effly z x) -> Effly z x
forall e (m :: * -> *) a.
(Exception e, Eff ErrorIO m) =>
m a -> (e -> m a) -> m a
`catchIO` \exc :: OpaqueExc
exc@(OpaqueExc Unique
uniq' Any
e) ->
if Unique
uniq Unique -> Unique -> Bool
forall a. Eq a => a -> a -> Bool
== Unique
uniq' then
e -> Effly z x
h (Any -> e
forall a b. a -> b
unsafeCoerce Any
e)
else
OpaqueExc -> Effly z x
forall e (m :: * -> *) a. (Exception e, Eff ErrorIO m) => e -> m a
throwIO OpaqueExc
exc
(InterpretSimpleC (Catch e) (InterpretSimpleC (Throw e) m) a
-> InterpretSimpleC (Throw e) m a)
-> InterpretSimpleC (Catch e) (InterpretSimpleC (Throw e) m) a
-> InterpretSimpleC (Throw e) m a
forall a b. (a -> b) -> a -> b
$ InterpretErrorSimpleC e m a
-> InterpretSimpleC (Catch e) (InterpretSimpleC (Throw e) m) a
forall e (m :: * -> *) a.
InterpretErrorSimpleC e m a
-> InterpretSimpleC (Catch e) (InterpretSimpleC (Throw e) m) a
unInterpretErrorSimpleC
(InterpretErrorSimpleC e m a
-> InterpretSimpleC (Catch e) (InterpretSimpleC (Throw e) m) a)
-> InterpretErrorSimpleC e m a
-> InterpretSimpleC (Catch e) (InterpretSimpleC (Throw e) m) a
forall a b. (a -> b) -> a -> b
$ InterpretErrorSimpleC e m a
main
(a -> Either e a) -> m a -> m (Either e a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Either e a
forall a b. b -> Either a b
Right m a
main' m (Either e a) -> (OpaqueExc -> m (Either e a)) -> m (Either e a)
forall e (m :: * -> *) a.
(Exception e, Eff ErrorIO m) =>
m a -> (e -> m a) -> m a
`catchIO` \exc :: OpaqueExc
exc@(OpaqueExc Unique
uniq' Any
e) ->
if Unique
uniq Unique -> Unique -> Bool
forall a. Eq a => a -> a -> Bool
== Unique
uniq' then
Either e a -> m (Either e a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either e a -> m (Either e a)) -> Either e a -> m (Either e a)
forall a b. (a -> b) -> a -> b
$ e -> Either e a
forall a b. a -> Either a b
Left (Any -> e
forall a b. a -> b
unsafeCoerce Any
e)
else
OpaqueExc -> m (Either e a)
forall e (m :: * -> *) a. (Exception e, Eff ErrorIO m) => e -> m a
throwIO OpaqueExc
exc
errorToIOSimple :: forall e m a p
. ( Eff (Embed IO) m
, MonadCatch m
, Threaders '[ReaderThreads] m p
)
=> ErrorToIOSimpleC e m a
-> m (Either e a)
errorToIOSimple :: ErrorToIOSimpleC e m a -> m (Either e a)
errorToIOSimple =
ErrorIOToIOC m (Either e a) -> m (Either e a)
forall (m :: * -> *) a.
(Carrier m, MonadCatch m) =>
ErrorIOToIOC m a -> m a
errorIOToIO
#. errorToErrorIOSimple
(InterpretErrorSimpleC e (ErrorIOToIOC m) a -> m (Either e a))
-> (IntroUnderManyC
'[Catch e, Throw e]
'[ErrorIO]
(InterpretErrorSimpleC e (ErrorIOToIOC m))
a
-> InterpretErrorSimpleC e (ErrorIOToIOC m) a)
-> IntroUnderManyC
'[Catch e, Throw e]
'[ErrorIO]
(InterpretErrorSimpleC e (ErrorIOToIOC m))
a
-> m (Either e a)
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# IntroUnderManyC
'[Catch e, Throw e]
'[ErrorIO]
(InterpretErrorSimpleC e (ErrorIOToIOC m))
a
-> InterpretErrorSimpleC e (ErrorIOToIOC m) a
forall (top :: [(* -> *) -> * -> *]) (new :: [(* -> *) -> * -> *])
(m :: * -> *) a.
(KnownList top, KnownList new, IntroConsistent top new m) =>
IntroUnderManyC top new m a -> m a
introUnderMany
(IntroUnderManyC
'[Catch e, Throw e]
'[ErrorIO]
(InterpretErrorSimpleC e (ErrorIOToIOC m))
a
-> m (Either e a))
-> (ErrorToIOSimpleC e m a
-> IntroUnderManyC
'[Catch e, Throw e]
'[ErrorIO]
(InterpretErrorSimpleC e (ErrorIOToIOC m))
a)
-> ErrorToIOSimpleC e m a
-> m (Either e a)
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# ErrorToIOSimpleC e m a
-> IntroUnderManyC
'[Catch e, Throw e]
'[ErrorIO]
(InterpretErrorSimpleC e (ErrorIOToIOC m))
a
forall e (m :: * -> *) a.
ErrorToIOSimpleC e m a
-> IntroC
'[Catch e, Throw e]
'[ErrorIO]
(InterpretErrorSimpleC e (ErrorIOToIOC m))
a
unErrorToIOSimpleC
{-# INLINE errorToIOSimple #-}