{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Effect.Error.Passthrough where

import Control.Monad.Except
import Effect
import Effect.Error

-- | A "passthough" instance for 'MonadErrorEffect's: Modifications are applied in
-- all nested positions of 'CatchError', but don't actually change the semantics
-- of any 'MonadErrorEffect'.
instance (MonadError e m) => InterpretEffectStateful x m (MonadErrorEffect e) where
  interpretEffectStateful :: forall (ops :: [Effect]) x a.
(forall b y. x y -> AST ops b -> m (b, x y))
-> x x -> MonadErrorEffect e (AST ops) a -> m (a, x x)
interpretEffectStateful forall b y. x y -> AST ops b -> m (b, x y)
interpAST x x
x (CatchError AST ops a
acts e -> AST ops a
handler) =
    m (a, x x) -> (e -> m (a, x x)) -> m (a, x x)
forall a. m a -> (e -> m a) -> m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError
      (x x -> AST ops a -> m (a, x x)
forall b y. x y -> AST ops b -> m (b, x y)
interpAST x x
x AST ops a
acts)
      (x x -> AST ops a -> m (a, x x)
forall b y. x y -> AST ops b -> m (b, x y)
interpAST x x
x (AST ops a -> m (a, x x)) -> (e -> AST ops a) -> e -> m (a, x x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> AST ops a
handler)
  interpretEffectStateful forall b y. x y -> AST ops b -> m (b, x y)
interpAST x x
x MonadErrorEffect e (AST ops) a
op = (,x x
x) (a -> (a, x x)) -> m a -> m (a, x x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall b. AST ops b -> m b)
-> MonadErrorEffect e (AST ops) a -> m a
forall (ops :: [Effect]) a.
(forall b. AST ops b -> m b)
-> MonadErrorEffect e (AST ops) a -> m a
forall (m :: * -> *) (op :: Effect) (ops :: [Effect]) a.
InterpretEffect m op =>
(forall b. AST ops b -> m b) -> op (AST ops) a -> m a
interpretEffect (((b, x x) -> b) -> m (b, x x) -> m b
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b, x x) -> b
forall a b. (a, b) -> a
fst (m (b, x x) -> m b)
-> (AST ops b -> m (b, x x)) -> AST ops b -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x x -> AST ops b -> m (b, x x)
forall b y. x y -> AST ops b -> m (b, x y)
interpAST x x
x) MonadErrorEffect e (AST ops) a
op