{-# LANGUAGE DeriveFunctor, ExistentialQuantification, StandaloneDeriving #-}
module Control.Effect.Catch.Internal
( Catch(..)
) where

import Control.Effect.Class

-- | 'Catch' effects can be used alongside 'Control.Effect.Throw.Throw' to provide recoverable exceptions.
--
-- @since 1.0.0.0
data Catch e m k
  = forall b . Catch (m b) (e -> m b) (b -> m k)

deriving instance Functor m => Functor (Catch e m)

instance HFunctor (Catch e) where
  hmap :: (forall x. m x -> n x) -> Catch e m a -> Catch e n a
hmap f :: forall x. m x -> n x
f (Catch m :: m b
m h :: e -> m b
h k :: b -> m a
k) = n b -> (e -> n b) -> (b -> n a) -> Catch e n a
forall e (m :: * -> *) k b.
m b -> (e -> m b) -> (b -> m k) -> Catch e m k
Catch (m b -> n b
forall x. m x -> n x
f m b
m) (m b -> n b
forall x. m x -> n x
f (m b -> n b) -> (e -> m b) -> e -> n b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m b
h) (m a -> n a
forall x. m x -> n x
f (m a -> n a) -> (b -> m a) -> b -> n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> m a
k)

instance Effect (Catch e) where
  thread :: ctx ()
-> (forall x. ctx (m x) -> n (ctx x))
-> Catch e m a
-> Catch e n (ctx a)
thread ctx :: ctx ()
ctx handler :: forall x. ctx (m x) -> n (ctx x)
handler (Catch m :: m b
m h :: e -> m b
h k :: b -> m a
k) = n (ctx b)
-> (e -> n (ctx b)) -> (ctx b -> n (ctx a)) -> Catch e n (ctx a)
forall e (m :: * -> *) k b.
m b -> (e -> m b) -> (b -> m k) -> Catch e m k
Catch (ctx (m b) -> n (ctx b)
forall x. ctx (m x) -> n (ctx x)
handler (m b
m m b -> ctx () -> ctx (m b)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx)) (ctx (m b) -> n (ctx b)
forall x. ctx (m x) -> n (ctx x)
handler (ctx (m b) -> n (ctx b)) -> (e -> ctx (m b)) -> e -> n (ctx b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (m b -> ctx () -> ctx (m b)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx) (m b -> ctx (m b)) -> (e -> m b) -> e -> ctx (m b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m b
h) (ctx (m a) -> n (ctx a)
forall x. ctx (m x) -> n (ctx x)
handler (ctx (m a) -> n (ctx a))
-> (ctx b -> ctx (m a)) -> ctx b -> n (ctx a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> m a) -> ctx b -> ctx (m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> m a
k)