{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE TemplateHaskell     #-}
{-# OPTIONS_HADDOCK prune #-}

-- | Description: The effect 'Error' and its interpreters
module Polysemy.Error
  ( -- * Effect
    Error (..)

    -- * Actions
  , throw
  , catch
  , fromEither
  , fromEitherM
  , fromException
  , fromExceptionVia
  , fromExceptionSem
  , fromExceptionSemVia
  , note
  , try
  , tryJust
  , catchJust

    -- * Interpretations
  , runError
  , mapError
  , errorToIOFinal
  ) where

import qualified Control.Exception          as X
import           Control.Monad
import qualified Control.Monad.Trans.Except as E
import           Data.Unique                (Unique, hashUnique, newUnique)
import           GHC.Exts                   (Any)
import           Polysemy
import           Polysemy.Final
import           Polysemy.Internal
import           Polysemy.Internal.Union
import           Unsafe.Coerce              (unsafeCoerce)


------------------------------------------------------------------------------
-- | This effect abstracts the throwing and catching of errors, leaving
-- it up to the interpreter whether to use exceptions or monad transformers
-- like 'E.ExceptT' to perform the short-circuiting mechanism.
data Error e m a where
  -- | Short-circuit the current program using the given error value.
  Throw :: e -> Error e m a
  -- | Recover from an error that might have been thrown in the higher-order
  -- action given by the first argument by passing the error to the handler
  -- given by the second argument.
  Catch :: ∀ e m a. m a -> (e -> m a) -> Error e m a

makeSem ''Error


hush :: Either e a -> Maybe a
hush :: forall e a. Either e a -> Maybe a
hush (Right a
a) = forall a. a -> Maybe a
Just a
a
hush (Left e
_)  = forall a. Maybe a
Nothing


------------------------------------------------------------------------------
-- | Upgrade an 'Either' into an 'Error' effect.
--
-- @since 0.5.1.0
fromEither
    :: Member (Error e) r
    => Either e a
    -> Sem r a
fromEither :: forall e (r :: EffectRow) a.
Member (Error e) r =>
Either e a -> Sem r a
fromEither (Left e
e)  = forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw e
e
fromEither (Right a
a) = forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
{-# INLINABLE fromEither #-}

------------------------------------------------------------------------------
-- | A combinator doing 'embed' and 'fromEither' at the same time. Useful for
-- interoperating with 'IO'.
--
-- @since 0.5.1.0
fromEitherM
    :: forall e m r a
     . ( Member (Error e) r
       , Member (Embed m) r
       )
    => m (Either e a)
    -> Sem r a
fromEitherM :: forall e (m :: * -> *) (r :: EffectRow) a.
(Member (Error e) r, Member (Embed m) r) =>
m (Either e a) -> Sem r a
fromEitherM = forall e (r :: EffectRow) a.
Member (Error e) r =>
Either e a -> Sem r a
fromEither forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed
{-# INLINABLE fromEitherM #-}


------------------------------------------------------------------------------
-- | Lift an exception generated from an 'IO' action into an 'Error'.
fromException
    :: forall e r a
     . ( X.Exception e
       , Member (Error e) r
       , Member (Embed IO) r
       )
    => IO a
    -> Sem r a
fromException :: forall e (r :: EffectRow) a.
(Exception e, Member (Error e) r, Member (Embed IO) r) =>
IO a -> Sem r a
fromException = forall exc err (r :: EffectRow) a.
(Exception exc, Member (Error err) r, Member (Embed IO) r) =>
(exc -> err) -> IO a -> Sem r a
fromExceptionVia @e forall a. a -> a
id
{-# INLINABLE fromException #-}


------------------------------------------------------------------------------
-- | Like 'fromException', but with the ability to transform the exception
-- before turning it into an 'Error'.
fromExceptionVia
    :: ( X.Exception exc
       , Member (Error err) r
       , Member (Embed IO) r
       )
    => (exc -> err)
    -> IO a
    -> Sem r a
fromExceptionVia :: forall exc err (r :: EffectRow) a.
(Exception exc, Member (Error err) r, Member (Embed IO) r) =>
(exc -> err) -> IO a -> Sem r a
fromExceptionVia exc -> err
f IO a
m = do
  Either exc a
r <- forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => IO a -> IO (Either e a)
X.try IO a
m
  case Either exc a
r of
    Left exc
e  -> forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw forall a b. (a -> b) -> a -> b
$ exc -> err
f exc
e
    Right a
a -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
{-# INLINABLE fromExceptionVia #-}

------------------------------------------------------------------------------
-- | Run a @Sem r@ action, converting any 'IO' exception generated by it into an 'Error'.
fromExceptionSem
    :: forall e r a
     . ( X.Exception e
       , Member (Error e) r
       , Member (Final IO) r
       )
    => Sem r a
    -> Sem r a
fromExceptionSem :: forall e (r :: EffectRow) a.
(Exception e, Member (Error e) r, Member (Final IO) r) =>
Sem r a -> Sem r a
fromExceptionSem = forall exc err (r :: EffectRow) a.
(Exception exc, Member (Error err) r, Member (Final IO) r) =>
(exc -> err) -> Sem r a -> Sem r a
fromExceptionSemVia @e forall a. a -> a
id
{-# INLINABLE fromExceptionSem #-}

------------------------------------------------------------------------------
-- | Like 'fromExceptionSem', but with the ability to transform the exception
-- before turning it into an 'Error'.
fromExceptionSemVia
    :: ( X.Exception exc
       , Member (Error err) r
       , Member (Final IO) r
       )
    => (exc -> err)
    -> Sem r a
    -> Sem r a
fromExceptionSemVia :: forall exc err (r :: EffectRow) a.
(Exception exc, Member (Error err) r, Member (Final IO) r) =>
(exc -> err) -> Sem r a -> Sem r a
fromExceptionSemVia exc -> err
f Sem r a
m = do
  Either exc a
r <- forall (m :: * -> *) (r :: EffectRow) a.
Member (Final m) r =>
Strategic m (Sem r) a -> Sem r a
withStrategicToFinal forall a b. (a -> b) -> a -> b
$ do
    IO (f a)
m' <- forall (n :: * -> *) a (m :: * -> *) (f :: * -> *).
n a -> Sem (WithStrategy m f n) (m (f a))
runS Sem r a
m
    f ()
s  <- forall (m :: * -> *) (f :: * -> *) (n :: * -> *).
Sem (WithStrategy m f n) (f ())
getInitialStateS
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) forall a b. b -> Either a b
Right IO (f a)
m' forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`X.catch` \exc
e -> (forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left exc
e forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ f ()
s))
  case Either exc a
r of
    Left exc
e  -> forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw forall a b. (a -> b) -> a -> b
$ exc -> err
f exc
e
    Right a
a -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
{-# INLINABLE fromExceptionSemVia #-}

------------------------------------------------------------------------------
-- | Attempt to extract a @'Just' a@ from a @'Maybe' a@, throwing the
-- provided exception upon 'Nothing'.
note :: Member (Error e) r => e -> Maybe a -> Sem r a
note :: forall e (r :: EffectRow) a.
Member (Error e) r =>
e -> Maybe a -> Sem r a
note e
e Maybe a
Nothing  = forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw e
e
note e
_ (Just a
a) = forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
{-# INLINABLE note #-}

------------------------------------------------------------------------------
-- | Similar to @'catch'@, but returns an @'Either'@ result which is (@'Right' a@)
-- if no exception of type @e@ was @'throw'@n, or (@'Left' ex@) if an exception of type
-- @e@ was @'throw'@n and its value is @ex@.
try :: Member (Error e) r => Sem r a -> Sem r (Either e a)
try :: forall e (r :: EffectRow) a.
Member (Error e) r =>
Sem r a -> Sem r (Either e a)
try Sem r a
m = forall e (r :: EffectRow) a.
Member (Error e) r =>
Sem r a -> (e -> Sem r a) -> Sem r a
catch (forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sem r a
m) (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left)
{-# INLINABLE try #-}

------------------------------------------------------------------------------
-- | A variant of @'try'@ that takes an exception predicate to select which exceptions
-- are caught (c.f. @'catchJust'@). If the exception does not match the predicate,
-- it is re-@'throw'@n.
tryJust :: Member (Error e) r => (e -> Maybe b) -> Sem r a -> Sem r (Either b a)
tryJust :: forall e (r :: EffectRow) b a.
Member (Error e) r =>
(e -> Maybe b) -> Sem r a -> Sem r (Either b a)
tryJust e -> Maybe b
f Sem r a
m = do
    Either e a
r <- forall e (r :: EffectRow) a.
Member (Error e) r =>
Sem r a -> Sem r (Either e a)
try Sem r a
m
    case Either e a
r of
      Right a
v -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right a
v)
      Left e
e -> case e -> Maybe b
f e
e of
                  Maybe b
Nothing -> forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw e
e
                  Just b
b  -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left b
b
{-# INLINABLE tryJust #-}

------------------------------------------------------------------------------
-- | The function @'catchJust'@ is like @'catch'@, but it takes an extra argument
-- which is an exception predicate, a function which selects which type of exceptions
-- we're interested in.
catchJust :: Member (Error e) r
          => (e -> Maybe b) -- ^ Predicate to select exceptions
          -> Sem r a  -- ^ Computation to run
          -> (b -> Sem r a) -- ^ Handler
          -> Sem r a
catchJust :: forall e (r :: EffectRow) b a.
Member (Error e) r =>
(e -> Maybe b) -> Sem r a -> (b -> Sem r a) -> Sem r a
catchJust e -> Maybe b
ef Sem r a
m b -> Sem r a
bf = forall e (r :: EffectRow) a.
Member (Error e) r =>
Sem r a -> (e -> Sem r a) -> Sem r a
catch Sem r a
m e -> Sem r a
handler
  where
      handler :: e -> Sem r a
handler e
e = case e -> Maybe b
ef e
e of
                    Maybe b
Nothing -> forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw e
e
                    Just b
b  -> b -> Sem r a
bf b
b
{-# INLINABLE catchJust #-}

------------------------------------------------------------------------------
-- | Run an 'Error' effect in the style of
-- 'Control.Monad.Trans.Except.ExceptT'.
runError
    :: Sem (Error e ': r) a
    -> Sem r (Either e a)
runError :: forall e (r :: EffectRow) a.
Sem (Error e : r) a -> Sem r (Either e a)
runError (Sem forall (m :: * -> *).
Monad m =>
(forall x. Union (Error e : r) (Sem (Error e : r)) x -> m x) -> m a
m) = forall (r :: EffectRow) a.
(forall (m :: * -> *).
 Monad m =>
 (forall x. Union r (Sem r) x -> m x) -> m a)
-> Sem r a
Sem forall a b. (a -> b) -> a -> b
$ \forall x. Union r (Sem r) x -> m x
k -> forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
E.runExceptT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
Monad m =>
(forall x. Union (Error e : r) (Sem (Error e : r)) x -> m x) -> m a
m forall a b. (a -> b) -> a -> b
$ \Union (Error e : r) (Sem (Error e : r)) x
u ->
  case forall (e :: Effect) (r :: EffectRow) (m :: * -> *) a.
Union (e : r) m a -> Either (Union r m a) (Weaving e m a)
decomp Union (Error e : r) (Sem (Error e : r)) x
u of
    Left Union r (Sem (Error e : r)) x
x -> forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
E.ExceptT forall a b. (a -> b) -> a -> b
$ forall x. Union r (Sem r) x -> m x
k forall a b. (a -> b) -> a -> b
$
      forall (s :: * -> *) (n :: * -> *) (m :: * -> *) (r :: EffectRow)
       a.
(Functor s, Functor n) =>
s ()
-> (forall x. s (m x) -> n (s x))
-> (forall x. s x -> Maybe x)
-> Union r m a
-> Union r n (s a)
weave (forall a b. b -> Either a b
Right ())
            (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) forall e (r :: EffectRow) a.
Sem (Error e : r) a -> Sem r (Either e a)
runError)
            forall e a. Either e a -> Maybe a
hush
            Union r (Sem (Error e : r)) x
x
    Right (Weaving (Throw e
e) f ()
_ forall x. f (Sem rInitial x) -> Sem (Error e : r) (f x)
_ f a -> x
_ forall x. f x -> Maybe x
_) -> forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
E.throwE e
e
    Right (Weaving (Catch Sem rInitial a
main e -> Sem rInitial a
handle) f ()
s forall x. f (Sem rInitial x) -> Sem (Error e : r) (f x)
d f a -> x
y forall x. f x -> Maybe x
_) ->
      forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
E.ExceptT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (r :: EffectRow) a.
Monad m =>
(forall x. Union r (Sem r) x -> m x) -> Sem r a -> m a
usingSem forall x. Union r (Sem r) x -> m x
k forall a b. (a -> b) -> a -> b
$ do
        Either e (f a)
ma <- forall e (r :: EffectRow) a.
Sem (Error e : r) a -> Sem r (Either e a)
runError forall a b. (a -> b) -> a -> b
$ forall x. f (Sem rInitial x) -> Sem (Error e : r) (f x)
d forall a b. (a -> b) -> a -> b
$ Sem rInitial a
main forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ f ()
s
        case Either e (f a)
ma of
          Right f a
a -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ f a -> x
y f a
a
          Left e
e -> do
            Either e (f a)
ma' <- forall e (r :: EffectRow) a.
Sem (Error e : r) a -> Sem r (Either e a)
runError forall a b. (a -> b) -> a -> b
$ forall x. f (Sem rInitial x) -> Sem (Error e : r) (f x)
d forall a b. (a -> b) -> a -> b
$ (forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ f ()
s) forall a b. (a -> b) -> a -> b
$ e -> Sem rInitial a
handle e
e
            case Either e (f a)
ma' of
              Left e
e' -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left e
e'
              Right f a
a -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ f a -> x
y f a
a
{-# INLINE runError #-}

------------------------------------------------------------------------------
-- | Transform one 'Error' into another. This function can be used to aggregate
-- multiple errors into a single type.
--
-- @since 1.0.0.0
mapError
  :: forall e1 e2 r a
   . Member (Error e2) r
  => (e1 -> e2)
  -> Sem (Error e1 ': r) a
  -> Sem r a
mapError :: forall e1 e2 (r :: EffectRow) a.
Member (Error e2) r =>
(e1 -> e2) -> Sem (Error e1 : r) a -> Sem r a
mapError e1 -> e2
f = forall (e :: Effect) (r :: EffectRow) a.
(forall (rInitial :: EffectRow) x.
 e (Sem rInitial) x -> Tactical e (Sem rInitial) r x)
-> Sem (e : r) a -> Sem r a
interpretH forall a b. (a -> b) -> a -> b
$ \case
  Throw e1
e -> forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw forall a b. (a -> b) -> a -> b
$ e1 -> e2
f e1
e
  Catch Sem rInitial x
action e1 -> Sem rInitial x
handler -> do
    Sem (Error e1 : r) (f x)
a  <- forall (m :: * -> *) a (e :: Effect) (f :: * -> *)
       (r :: EffectRow).
m a -> Sem (WithTactics e f m r) (Sem (e : r) (f a))
runT Sem rInitial x
action
    f e1 -> Sem (Error e1 : r) (f x)
h  <- forall a (m :: * -> *) b (e :: Effect) (f :: * -> *)
       (r :: EffectRow).
(a -> m b) -> Sem (WithTactics e f m r) (f a -> Sem (e : r) (f b))
bindT e1 -> Sem rInitial x
handler

    Either e1 (f x)
mx <- forall (e :: Effect) (r :: EffectRow) a. Sem r a -> Sem (e : r) a
raise forall a b. (a -> b) -> a -> b
$ forall e (r :: EffectRow) a.
Sem (Error e : r) a -> Sem r (Either e a)
runError Sem (Error e1 : r) (f x)
a
    case Either e1 (f x)
mx of
      Right f x
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure f x
x
      Left e1
e -> do
        f ()
istate <- forall (f :: * -> *) (m :: * -> *) (r :: EffectRow) (e :: Effect).
Sem (WithTactics e f m r) (f ())
getInitialStateT
        Either e1 (f x)
mx' <- forall (e :: Effect) (r :: EffectRow) a. Sem r a -> Sem (e : r) a
raise forall a b. (a -> b) -> a -> b
$ forall e (r :: EffectRow) a.
Sem (Error e : r) a -> Sem r (Either e a)
runError forall a b. (a -> b) -> a -> b
$ f e1 -> Sem (Error e1 : r) (f x)
h forall a b. (a -> b) -> a -> b
$ e1
e forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ f ()
istate
        case Either e1 (f x)
mx' of
          Right f x
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure f x
x
          Left e1
e' -> forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw forall a b. (a -> b) -> a -> b
$ e1 -> e2
f e1
e'
{-# INLINE mapError #-}


data WrappedExc = WrappedExc !Unique Any

instance Show WrappedExc where
  show :: WrappedExc -> String
show (WrappedExc Unique
uid Any
_) =
    String
"errorToIOFinal: Escaped opaque exception. Unique hash is: " forall a. Semigroup a => a -> a -> a
<>
    forall a. Show a => a -> String
show (Unique -> Int
hashUnique Unique
uid) forall a. Semigroup a => a -> a -> a
<> String
"This should only happen if the computation that " forall a. Semigroup a => a -> a -> a
<>
    String
"threw the exception was somehow invoked outside of the argument of 'errorToIOFinal'; " forall a. Semigroup a => a -> a -> a
<>
    String
"for example, if you 'async' an exceptional computation inside of the argument " forall a. Semigroup a => a -> a -> a
<>
    String
"provided to 'errorToIOFinal', and then 'await' on it *outside* of the argument " forall a. Semigroup a => a -> a -> a
<>
    String
"provided to 'errorToIOFinal'. If that or any similar shenanigans seems unlikely, " forall a. Semigroup a => a -> a -> a
<>
    String
"please open an issue on the GitHub repository."

instance X.Exception WrappedExc

catchWithUid :: forall e a. Unique -> IO a -> (e -> IO a) -> IO a
catchWithUid :: forall e a. Unique -> IO a -> (e -> IO a) -> IO a
catchWithUid Unique
uid IO a
m e -> IO a
h = forall e a. Exception e => IO a -> (e -> IO a) -> IO a
X.catch IO a
m forall a b. (a -> b) -> a -> b
$ \exc :: WrappedExc
exc@(WrappedExc Unique
uid' Any
e) ->
  if Unique
uid forall a. Eq a => a -> a -> Bool
== Unique
uid' then e -> IO a
h (forall a b. a -> b
unsafeCoerce Any
e) else forall e a. Exception e => e -> IO a
X.throwIO WrappedExc
exc
{-# INLINE catchWithUid #-}

------------------------------------------------------------------------------
-- | Run an 'Error' effect as an 'IO' 'X.Exception' through final 'IO'. This
-- interpretation is significantly faster than 'runError'.
--
-- /Beware/: Effects that aren't interpreted in terms of 'IO'
-- will have local state semantics in regards to 'Error' effects
-- interpreted this way. See 'Final'.
--
-- @since 1.2.0.0
errorToIOFinal
    :: forall e r a
    .  ( Member (Final IO) r
       )
    => Sem (Error e ': r) a
    -> Sem r (Either e a)
errorToIOFinal :: forall e (r :: EffectRow) a.
Member (Final IO) r =>
Sem (Error e : r) a -> Sem r (Either e a)
errorToIOFinal Sem (Error e : r) a
sem = forall (m :: * -> *) (r :: EffectRow) a.
Member (Final m) r =>
Strategic m (Sem r) a -> Sem r a
withStrategicToFinal @IO forall a b. (a -> b) -> a -> b
$ do
  f Unique -> IO (f a)
m' <- forall a (n :: * -> *) b (m :: * -> *) (f :: * -> *).
(a -> n b) -> Sem (WithStrategy m f n) (f a -> m (f b))
bindS (forall e (r :: EffectRow) a.
Member (Final IO) r =>
Unique -> Sem (Error e : r) a -> Sem r a
`runErrorAsExcFinal` Sem (Error e : r) a
sem)
  f ()
s  <- forall (m :: * -> *) (f :: * -> *) (n :: * -> *).
Sem (WithStrategy m f n) (f ())
getInitialStateS
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ do
    Unique
uid <- IO Unique
newUnique
    forall e a. Unique -> IO a -> (e -> IO a) -> IO a
catchWithUid @e Unique
uid (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f Unique -> IO (f a)
m' (Unique
uid forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ f ()
s)) (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ f ()
s) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left)
{-# INLINE errorToIOFinal #-}

runErrorAsExcFinal
    :: forall e r a
    .  ( Member (Final IO) r
       )
    => Unique
    -> Sem (Error e ': r) a
    -> Sem r a
runErrorAsExcFinal :: forall e (r :: EffectRow) a.
Member (Final IO) r =>
Unique -> Sem (Error e : r) a -> Sem r a
runErrorAsExcFinal Unique
uid = forall (m :: * -> *) (e :: Effect) (r :: EffectRow) a.
Member (Final m) r =>
(forall x (rInitial :: EffectRow).
 e (Sem rInitial) x -> Strategic m (Sem rInitial) x)
-> Sem (e : r) a -> Sem r a
interpretFinal forall a b. (a -> b) -> a -> b
$ \case
  Throw e
e   -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => e -> IO a
X.throwIO forall a b. (a -> b) -> a -> b
$ Unique -> Any -> WrappedExc
WrappedExc Unique
uid (forall a b. a -> b
unsafeCoerce e
e)
  Catch Sem rInitial x
m e -> Sem rInitial x
h -> do
    IO (f x)
m' <- forall (n :: * -> *) a (m :: * -> *) (f :: * -> *).
n a -> Sem (WithStrategy m f n) (m (f a))
runS Sem rInitial x
m
    f e -> IO (f x)
h' <- forall a (n :: * -> *) b (m :: * -> *) (f :: * -> *).
(a -> n b) -> Sem (WithStrategy m f n) (f a -> m (f b))
bindS e -> Sem rInitial x
h
    f ()
s  <- forall (m :: * -> *) (f :: * -> *) (n :: * -> *).
Sem (WithStrategy m f n) (f ())
getInitialStateS
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall e a. Unique -> IO a -> (e -> IO a) -> IO a
catchWithUid Unique
uid IO (f x)
m' forall a b. (a -> b) -> a -> b
$ \e
e -> f e -> IO (f x)
h' (e
e forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ f ()
s)
{-# INLINE runErrorAsExcFinal #-}