{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

{- | A church-encoded carrier for 'Error'.

@since 1.1.0.0
-}
module Control.Carrier.Error.Church
( -- * Error carrier
  runError
, ErrorC(..)
  -- * Error effect
, module Control.Effect.Error
) where

import Control.Algebra
import Control.Applicative
import Control.Effect.Error
import Control.Monad (MonadPlus)
import Control.Monad.Fail as Fail
import Control.Monad.Fix
import Control.Monad.IO.Class
import Control.Monad.Trans.Class
import Data.Coerce (coerce)
import Data.Functor.Identity
import Prelude hiding (fail)

-- | Run an 'Error' effect, applying the first continuation to uncaught errors and the second continuation to successful computations’ results.
--
-- @
-- 'runError' j k ('pure' a) = k a
-- @
-- @
-- 'runError' j k ('throwError' e) = j e
-- @
-- @
-- 'runError' j k ('throwError' e \`'catchError'\` 'pure') = k e
-- @
--
-- @since 1.1.0.0
runError :: (e -> m b) -> (a -> m b) -> ErrorC e m a -> m b
runError :: forall e (m :: * -> *) b a.
(e -> m b) -> (a -> m b) -> ErrorC e m a -> m b
runError e -> m b
fail a -> m b
leaf ErrorC e m a
m = ErrorC e m a -> forall b. (e -> m b) -> (a -> m b) -> m b
forall e (m :: * -> *) a.
ErrorC e m a -> forall b. (e -> m b) -> (a -> m b) -> m b
runErrorC ErrorC e m a
m e -> m b
fail a -> m b
leaf
{-# INLINE runError #-}

-- | @since 1.1.0.0
newtype ErrorC e m a = ErrorC { forall e (m :: * -> *) a.
ErrorC e m a -> forall b. (e -> m b) -> (a -> m b) -> m b
runErrorC :: forall b . (e -> m b) -> (a -> m b) -> m b }
  deriving ((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. a -> ErrorC e m b -> ErrorC e m a
forall e (m :: * -> *) a b.
(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
$cfmap :: forall e (m :: * -> *) a b.
(a -> b) -> ErrorC e m a -> ErrorC e m b
fmap :: forall a b. (a -> b) -> ErrorC e m a -> ErrorC e m b
$c<$ :: forall e (m :: * -> *) a b. a -> ErrorC e m b -> ErrorC e m a
<$ :: forall a b. a -> ErrorC e m b -> ErrorC e m a
Functor)

instance Applicative (ErrorC e m) where
  pure :: forall a. a -> ErrorC e m a
pure a
a = (forall b. (e -> m b) -> (a -> m b) -> m b) -> ErrorC e m a
forall e (m :: * -> *) a.
(forall b. (e -> m b) -> (a -> m b) -> m b) -> ErrorC e m a
ErrorC ((forall b. (e -> m b) -> (a -> m b) -> m b) -> ErrorC e m a)
-> (forall b. (e -> m b) -> (a -> m b) -> m b) -> ErrorC e m a
forall a b. (a -> b) -> a -> b
$ \ e -> m b
_ a -> m b
leaf -> a -> m b
leaf a
a
  {-# INLINE pure #-}

  ErrorC forall b. (e -> m b) -> ((a -> b) -> m b) -> m b
f <*> :: forall a b. ErrorC e m (a -> b) -> ErrorC e m a -> ErrorC e m b
<*> ErrorC forall b. (e -> m b) -> (a -> m b) -> m b
a = (forall b. (e -> m b) -> (b -> m b) -> m b) -> ErrorC e m b
forall e (m :: * -> *) a.
(forall b. (e -> m b) -> (a -> m b) -> m b) -> ErrorC e m a
ErrorC ((forall b. (e -> m b) -> (b -> m b) -> m b) -> ErrorC e m b)
-> (forall b. (e -> m b) -> (b -> m b) -> m b) -> ErrorC e m b
forall a b. (a -> b) -> a -> b
$ \ e -> m b
fail b -> m b
leaf -> (e -> m b) -> ((a -> b) -> m b) -> m b
forall b. (e -> m b) -> ((a -> b) -> m b) -> m b
f e -> m b
fail (\ a -> b
f' -> (e -> m b) -> (a -> m b) -> m b
forall b. (e -> m b) -> (a -> m b) -> m b
a e -> m b
fail (b -> m b
leaf (b -> m b) -> (a -> b) -> a -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f'))
  {-# INLINE (<*>) #-}

  liftA2 :: forall a b c.
(a -> b -> c) -> ErrorC e m a -> ErrorC e m b -> ErrorC e m c
liftA2 a -> b -> c
f (ErrorC forall b. (e -> m b) -> (a -> m b) -> m b
a) (ErrorC forall b. (e -> m b) -> (b -> m b) -> m b
b) = (forall b. (e -> m b) -> (c -> m b) -> m b) -> ErrorC e m c
forall e (m :: * -> *) a.
(forall b. (e -> m b) -> (a -> m b) -> m b) -> ErrorC e m a
ErrorC ((forall b. (e -> m b) -> (c -> m b) -> m b) -> ErrorC e m c)
-> (forall b. (e -> m b) -> (c -> m b) -> m b) -> ErrorC e m c
forall a b. (a -> b) -> a -> b
$ \ e -> m b
fail c -> m b
leaf ->
    (e -> m b) -> (a -> m b) -> m b
forall b. (e -> m b) -> (a -> m b) -> m b
a e -> m b
fail (\ a
a' -> (e -> m b) -> (b -> m b) -> m b
forall b. (e -> m b) -> (b -> m b) -> m b
b e -> m b
fail (c -> m b
leaf (c -> m b) -> (b -> c) -> b -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b -> c
f a
a'))
  {-# INLINE liftA2 #-}

  ErrorC forall b. (e -> m b) -> (a -> m b) -> m b
a1 *> :: forall a b. ErrorC e m a -> ErrorC e m b -> ErrorC e m b
*> ErrorC forall b. (e -> m b) -> (b -> m b) -> m b
a2 = (forall b. (e -> m b) -> (b -> m b) -> m b) -> ErrorC e m b
forall e (m :: * -> *) a.
(forall b. (e -> m b) -> (a -> m b) -> m b) -> ErrorC e m a
ErrorC ((forall b. (e -> m b) -> (b -> m b) -> m b) -> ErrorC e m b)
-> (forall b. (e -> m b) -> (b -> m b) -> m b) -> ErrorC e m b
forall a b. (a -> b) -> a -> b
$ \ e -> m b
fail -> (e -> m b) -> (a -> m b) -> m b
forall b. (e -> m b) -> (a -> m b) -> m b
a1 e -> m b
fail ((a -> m b) -> m b)
-> ((b -> m b) -> a -> m b) -> (b -> m b) -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m b -> a -> m b
forall a b. a -> b -> a
const (m b -> a -> m b) -> ((b -> m b) -> m b) -> (b -> m b) -> a -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e -> m b) -> (b -> m b) -> m b
forall b. (e -> m b) -> (b -> m b) -> m b
a2 e -> m b
fail
  {-# INLINE (*>) #-}

  ErrorC forall b. (e -> m b) -> (a -> m b) -> m b
a1 <* :: forall a b. ErrorC e m a -> ErrorC e m b -> ErrorC e m a
<* ErrorC forall b. (e -> m b) -> (b -> m b) -> m b
a2 = (forall b. (e -> m b) -> (a -> m b) -> m b) -> ErrorC e m a
forall e (m :: * -> *) a.
(forall b. (e -> m b) -> (a -> m b) -> m b) -> ErrorC e m a
ErrorC ((forall b. (e -> m b) -> (a -> m b) -> m b) -> ErrorC e m a)
-> (forall b. (e -> m b) -> (a -> m b) -> m b) -> ErrorC e m a
forall a b. (a -> b) -> a -> b
$ \ e -> m b
fail a -> m b
leaf -> (e -> m b) -> (a -> m b) -> m b
forall b. (e -> m b) -> (a -> m b) -> m b
a1 e -> m b
fail ((e -> m b) -> (b -> m b) -> m b
forall b. (e -> m b) -> (b -> m b) -> m b
a2 e -> m b
fail ((b -> m b) -> m b) -> (a -> b -> m b) -> a -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m b -> b -> m b
forall a b. a -> b -> a
const (m b -> b -> m b) -> (a -> m b) -> a -> b -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m b
leaf)
  {-# INLINE (<*) #-}

instance Alternative m => Alternative (ErrorC e m) where
  empty :: forall a. ErrorC e m a
empty = (forall b. (e -> m b) -> (a -> m b) -> m b) -> ErrorC e m a
forall e (m :: * -> *) a.
(forall b. (e -> m b) -> (a -> m b) -> m b) -> ErrorC e m a
ErrorC ((forall b. (e -> m b) -> (a -> m b) -> m b) -> ErrorC e m a)
-> (forall b. (e -> m b) -> (a -> m b) -> m b) -> ErrorC e m a
forall a b. (a -> b) -> a -> b
$ \ e -> m b
_ a -> m b
_ -> m b
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty
  {-# INLINE empty #-}

  ErrorC forall b. (e -> m b) -> (a -> m b) -> m b
a <|> :: forall a. ErrorC e m a -> ErrorC e m a -> ErrorC e m a
<|> ErrorC forall b. (e -> m b) -> (a -> m b) -> m b
b = (forall b. (e -> m b) -> (a -> m b) -> m b) -> ErrorC e m a
forall e (m :: * -> *) a.
(forall b. (e -> m b) -> (a -> m b) -> m b) -> ErrorC e m a
ErrorC ((forall b. (e -> m b) -> (a -> m b) -> m b) -> ErrorC e m a)
-> (forall b. (e -> m b) -> (a -> m b) -> m b) -> ErrorC e m a
forall a b. (a -> b) -> a -> b
$ \ e -> m b
fail a -> m b
leaf -> (e -> m b) -> (a -> m b) -> m b
forall b. (e -> m b) -> (a -> m b) -> m b
a e -> m b
fail a -> m b
leaf m b -> m b -> m b
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (e -> m b) -> (a -> m b) -> m b
forall b. (e -> m b) -> (a -> m b) -> m b
b e -> m b
fail a -> m b
leaf
  {-# INLINE (<|>) #-}

instance Monad (ErrorC e m) where
  ErrorC forall b. (e -> m b) -> (a -> m b) -> m b
a >>= :: forall a b. ErrorC e m a -> (a -> ErrorC e m b) -> ErrorC e m b
>>= a -> ErrorC e m b
f = (forall b. (e -> m b) -> (b -> m b) -> m b) -> ErrorC e m b
forall e (m :: * -> *) a.
(forall b. (e -> m b) -> (a -> m b) -> m b) -> ErrorC e m a
ErrorC ((forall b. (e -> m b) -> (b -> m b) -> m b) -> ErrorC e m b)
-> (forall b. (e -> m b) -> (b -> m b) -> m b) -> ErrorC e m b
forall a b. (a -> b) -> a -> b
$ \ e -> m b
fail b -> m b
leaf -> (e -> m b) -> (a -> m b) -> m b
forall b. (e -> m b) -> (a -> m b) -> m b
a e -> m b
fail ((e -> m b) -> (b -> m b) -> ErrorC e m b -> m b
forall e (m :: * -> *) b a.
(e -> m b) -> (a -> m b) -> ErrorC e m a -> m b
runError e -> m b
fail b -> m b
leaf (ErrorC e m b -> m b) -> (a -> ErrorC e m b) -> a -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ErrorC e m b
f)
  {-# INLINE (>>=) #-}

instance Fail.MonadFail m => Fail.MonadFail (ErrorC e m) where
  fail :: forall a. String -> ErrorC e m a
fail = m a -> ErrorC e m a
forall (m :: * -> *) a. Monad m => m a -> ErrorC e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ErrorC e m a) -> (String -> m a) -> String -> ErrorC e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m a
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail
  {-# INLINE fail #-}

instance MonadFix m => MonadFix (ErrorC e m) where
  mfix :: forall a. (a -> ErrorC e m a) -> ErrorC e m a
mfix a -> ErrorC e m a
f = (forall b. (e -> m b) -> (a -> m b) -> m b) -> ErrorC e m a
forall e (m :: * -> *) a.
(forall b. (e -> m b) -> (a -> m b) -> m b) -> ErrorC e m a
ErrorC ((forall b. (e -> m b) -> (a -> m b) -> m b) -> ErrorC e m a)
-> (forall b. (e -> m b) -> (a -> m b) -> m b) -> ErrorC e m a
forall a b. (a -> b) -> a -> b
$ \ e -> m b
fail a -> m b
leaf ->
    (ErrorC e Identity a -> m (ErrorC e Identity a))
-> m (ErrorC e Identity a)
forall a. (a -> m a) -> m a
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix (ErrorC e m a -> m (ErrorC e Identity a)
forall {a}. ErrorC e m a -> m (ErrorC e Identity a)
toError (ErrorC e m a -> m (ErrorC e Identity a))
-> (ErrorC e Identity a -> ErrorC e m a)
-> ErrorC e Identity a
-> m (ErrorC e Identity a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ErrorC e m a
f (a -> ErrorC e m a)
-> (ErrorC e Identity a -> a)
-> ErrorC e Identity a
-> ErrorC e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity a -> a
forall a. Identity a -> a
run (Identity a -> a)
-> (ErrorC e Identity a -> Identity a) -> ErrorC e Identity a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorC e Identity a -> Identity a
forall {e} {b}. ErrorC e Identity b -> Identity b
fromError)
    m (ErrorC e Identity a) -> (ErrorC e Identity a -> m b) -> m b
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Identity (m b) -> m b
forall a. Identity a -> a
run (Identity (m b) -> m b)
-> (ErrorC e Identity a -> Identity (m b))
-> ErrorC e Identity a
-> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e -> Identity (m b))
-> (a -> Identity (m b)) -> ErrorC e Identity a -> Identity (m b)
forall e (m :: * -> *) b a.
(e -> m b) -> (a -> m b) -> ErrorC e m a -> m b
runError (m b -> Identity (m b)
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (m b -> Identity (m b)) -> (e -> m b) -> e -> Identity (m b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m b
fail) (m b -> Identity (m b)
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (m b -> Identity (m b)) -> (a -> m b) -> a -> Identity (m b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m b
leaf)
    where
    toError :: ErrorC e m a -> m (ErrorC e Identity a)
toError   = (e -> m (ErrorC e Identity a))
-> (a -> m (ErrorC e Identity a))
-> ErrorC e m a
-> m (ErrorC e Identity a)
forall e (m :: * -> *) b a.
(e -> m b) -> (a -> m b) -> ErrorC e m a -> m b
runError (ErrorC e Identity a -> m (ErrorC e Identity a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ErrorC e Identity a -> m (ErrorC e Identity a))
-> (e -> ErrorC e Identity a) -> e -> m (ErrorC e Identity a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> ErrorC e Identity a
forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
e -> m a
throwError) (ErrorC e Identity a -> m (ErrorC e Identity a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ErrorC e Identity a -> m (ErrorC e Identity a))
-> (a -> ErrorC e Identity a) -> a -> m (ErrorC e Identity a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ErrorC e Identity a
forall a. a -> ErrorC e Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure)
    fromError :: ErrorC e Identity b -> Identity b
fromError = (e -> Identity b)
-> (b -> Identity b) -> ErrorC e Identity b -> Identity b
forall e (m :: * -> *) b a.
(e -> m b) -> (a -> m b) -> ErrorC e m a -> m b
runError (Identity b -> e -> Identity b
forall a b. a -> b -> a
const (String -> Identity b
forall a. HasCallStack => String -> a
error String
"mfix (ErrorC): throwError")) b -> Identity b
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  {-# INLINE mfix #-}

instance MonadIO m => MonadIO (ErrorC e m) where
  liftIO :: forall a. IO a -> ErrorC e m a
liftIO = m a -> ErrorC e m a
forall (m :: * -> *) a. Monad m => m a -> ErrorC e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ErrorC e m a) -> (IO a -> m a) -> IO a -> ErrorC e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
  {-# INLINE liftIO #-}

instance (Alternative m, Monad m) => MonadPlus (ErrorC e m)

instance MonadTrans (ErrorC e) where
  lift :: forall (m :: * -> *) a. Monad m => m a -> ErrorC e m a
lift m a
m = (forall b. (e -> m b) -> (a -> m b) -> m b) -> ErrorC e m a
forall e (m :: * -> *) a.
(forall b. (e -> m b) -> (a -> m b) -> m b) -> ErrorC e m a
ErrorC ((forall b. (e -> m b) -> (a -> m b) -> m b) -> ErrorC e m a)
-> (forall b. (e -> m b) -> (a -> m b) -> m b) -> ErrorC e m a
forall a b. (a -> b) -> a -> b
$ \ e -> m b
_ a -> m b
leaf -> m a
m m a -> (a -> m b) -> m b
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> m b
leaf
  {-# INLINE lift #-}

instance Algebra sig m => Algebra (Error e :+: sig) (ErrorC e m) where
  alg :: forall (ctx :: * -> *) (n :: * -> *) a.
Functor ctx =>
Handler ctx n (ErrorC e m)
-> (:+:) (Error e) sig n a -> ctx () -> ErrorC e m (ctx a)
alg Handler ctx n (ErrorC e m)
hdl (:+:) (Error e) sig n a
sig ctx ()
ctx = (forall b. (e -> m b) -> (ctx a -> m b) -> m b)
-> ErrorC e m (ctx a)
forall e (m :: * -> *) a.
(forall b. (e -> m b) -> (a -> m b) -> m b) -> ErrorC e m a
ErrorC ((forall b. (e -> m b) -> (ctx a -> m b) -> m b)
 -> ErrorC e m (ctx a))
-> (forall b. (e -> m b) -> (ctx a -> m b) -> m b)
-> ErrorC e m (ctx a)
forall a b. (a -> b) -> a -> b
$ \ e -> m b
fail ctx a -> m b
leaf -> case (:+:) (Error e) sig n a
sig of
    L (L (Throw e
e))   -> e -> m b
fail e
e
    L (R (Catch n a
m e -> n a
h)) -> (e -> m b) -> (ctx a -> m b) -> ErrorC e m (ctx a) -> m b
forall e (m :: * -> *) b a.
(e -> m b) -> (a -> m b) -> ErrorC e m a -> m b
runError ((e -> m b) -> (ctx a -> m b) -> ErrorC e m (ctx a) -> m b
forall e (m :: * -> *) b a.
(e -> m b) -> (a -> m b) -> ErrorC e m a -> m b
runError e -> m b
fail ctx a -> m b
leaf (ErrorC e m (ctx a) -> m b)
-> (e -> ErrorC e m (ctx a)) -> e -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n a -> ErrorC e m (ctx a)
forall {x}. n x -> ErrorC e m (ctx x)
lower (n a -> ErrorC e m (ctx a))
-> (e -> n a) -> e -> ErrorC e m (ctx a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> n a
h) ctx a -> m b
leaf (n a -> ErrorC e m (ctx a)
forall {x}. n x -> ErrorC e m (ctx x)
lower n a
m)
    R sig n a
other           -> Handler (Compose (ErrorC e Identity) ctx) n m
-> sig n a
-> ErrorC e Identity (ctx ())
-> m (ErrorC e Identity (ctx a))
forall (ctx1 :: * -> *) (ctx2 :: * -> *)
       (sig :: (* -> *) -> * -> *) (m :: * -> *) (n :: * -> *) a.
(Functor ctx1, Functor ctx2, Algebra sig m) =>
Handler (Compose ctx1 ctx2) n m
-> sig n a -> ctx1 (ctx2 ()) -> m (ctx1 (ctx2 a))
thread (ErrorC e Identity (ErrorC e m x) -> m (ErrorC e Identity x)
forall {x}.
ErrorC e Identity (ErrorC e m x) -> m (ErrorC e Identity x)
forall (m :: * -> *) e a.
Applicative m =>
ErrorC e Identity (ErrorC e m a) -> m (ErrorC e Identity a)
dst (forall {x}.
 ErrorC e Identity (ErrorC e m x) -> m (ErrorC e Identity x))
-> Handler ctx n (ErrorC e m)
-> Handler (Compose (ErrorC e Identity) ctx) n m
forall (n :: * -> *) (ctx1 :: * -> *) (m :: * -> *)
       (ctx2 :: * -> *) (l :: * -> *).
(Functor n, Functor ctx1) =>
Handler ctx1 m n
-> Handler ctx2 l m -> Handler (Compose ctx1 ctx2) l n
~<~ ctx (n x) -> ErrorC e m (ctx x)
Handler ctx n (ErrorC e m)
hdl) sig n a
other (ctx () -> ErrorC e Identity (ctx ())
forall a. a -> ErrorC e Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ctx ()
ctx) m (ErrorC e Identity (ctx a))
-> (ErrorC e Identity (ctx a) -> m b) -> m b
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Identity (m b) -> m b
forall a. Identity a -> a
run (Identity (m b) -> m b)
-> (ErrorC e Identity (ctx a) -> Identity (m b))
-> ErrorC e Identity (ctx a)
-> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e -> Identity (m b))
-> (ctx a -> Identity (m b))
-> ErrorC e Identity (ctx a)
-> Identity (m b)
forall e (m :: * -> *) b a.
(e -> m b) -> (a -> m b) -> ErrorC e m a -> m b
runError ((e -> m b) -> e -> Identity (m b)
forall a b. Coercible a b => a -> b
coerce e -> m b
fail) ((ctx a -> m b) -> ctx a -> Identity (m b)
forall a b. Coercible a b => a -> b
coerce ctx a -> m b
leaf)
    where
    lower :: n x -> ErrorC e m (ctx x)
lower = ctx (n x) -> ErrorC e m (ctx x)
Handler ctx n (ErrorC e m)
hdl (ctx (n x) -> ErrorC e m (ctx x))
-> (n x -> ctx (n x)) -> n x -> ErrorC e m (ctx x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (n x -> ctx () -> ctx (n x)
forall a b. a -> ctx b -> ctx a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx)
    dst :: Applicative m => ErrorC e Identity (ErrorC e m a) -> m (ErrorC e Identity a)
    dst :: forall (m :: * -> *) e a.
Applicative m =>
ErrorC e Identity (ErrorC e m a) -> m (ErrorC e Identity a)
dst = Identity (m (ErrorC e Identity a)) -> m (ErrorC e Identity a)
forall a. Identity a -> a
run (Identity (m (ErrorC e Identity a)) -> m (ErrorC e Identity a))
-> (ErrorC e Identity (ErrorC e m a)
    -> Identity (m (ErrorC e Identity a)))
-> ErrorC e Identity (ErrorC e m a)
-> m (ErrorC e Identity a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e -> Identity (m (ErrorC e Identity a)))
-> (ErrorC e m a -> Identity (m (ErrorC e Identity a)))
-> ErrorC e Identity (ErrorC e m a)
-> Identity (m (ErrorC e Identity a))
forall e (m :: * -> *) b a.
(e -> m b) -> (a -> m b) -> ErrorC e m a -> m b
runError (m (ErrorC e Identity a) -> Identity (m (ErrorC e Identity a))
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (m (ErrorC e Identity a) -> Identity (m (ErrorC e Identity a)))
-> (e -> m (ErrorC e Identity a))
-> e
-> Identity (m (ErrorC e Identity a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorC e Identity a -> m (ErrorC e Identity a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ErrorC e Identity a -> m (ErrorC e Identity a))
-> (e -> ErrorC e Identity a) -> e -> m (ErrorC e Identity a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> ErrorC e Identity a
forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
e -> m a
throwError) (m (ErrorC e Identity a) -> Identity (m (ErrorC e Identity a))
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (m (ErrorC e Identity a) -> Identity (m (ErrorC e Identity a)))
-> (ErrorC e m a -> m (ErrorC e Identity a))
-> ErrorC e m a
-> Identity (m (ErrorC e Identity a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e -> m (ErrorC e Identity a))
-> (a -> m (ErrorC e Identity a))
-> ErrorC e m a
-> m (ErrorC e Identity a)
forall e (m :: * -> *) b a.
(e -> m b) -> (a -> m b) -> ErrorC e m a -> m b
runError (ErrorC e Identity a -> m (ErrorC e Identity a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ErrorC e Identity a -> m (ErrorC e Identity a))
-> (e -> ErrorC e Identity a) -> e -> m (ErrorC e Identity a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> ErrorC e Identity a
forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
e -> m a
throwError) (ErrorC e Identity a -> m (ErrorC e Identity a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ErrorC e Identity a -> m (ErrorC e Identity a))
-> (a -> ErrorC e Identity a) -> a -> m (ErrorC e Identity a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ErrorC e Identity a
forall a. a -> ErrorC e Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure))
  {-# INLINE alg #-}