{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeOperators #-}

-- | Deal with throw and try effects

module Control.Kernmantle.Error
  (ThrowEffect(..), TryEffect(..)
  ,module Control.Exception.Safe)
where

import Control.Applicative
import Control.Arrow
import Control.Exception.Safe
import Data.Profunctor.Cayley

  
-- | A class for binary effects that can possibly throw exceptions
class ThrowEffect ex eff where
  throwE :: eff (Either ex b) b

-- | A class for binary effects that can catch exceptions
class TryEffect ex eff where
  tryE :: eff a b -> eff a (Either ex b)

instance (MonadThrow m, Exception ex) => ThrowEffect ex (Kleisli m) where
  throwE :: Kleisli m (Either ex b) b
throwE = (Either ex b -> m b) -> Kleisli m (Either ex b) b
forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b
Kleisli ((Either ex b -> m b) -> Kleisli m (Either ex b) b)
-> (Either ex b -> m b) -> Kleisli m (Either ex b) b
forall a b. (a -> b) -> a -> b
$ (ex -> m b) -> (b -> m b) -> Either ex b -> m b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ex -> m b
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throw b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return
  {-# INLINE throwE #-}

instance (MonadCatch m, Exception ex) => TryEffect ex (Kleisli m) where
  tryE :: Kleisli m a b -> Kleisli m a (Either ex b)
tryE (Kleisli a -> m b
act) = (a -> m (Either ex b)) -> Kleisli m a (Either ex b)
forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b
Kleisli ((a -> m (Either ex b)) -> Kleisli m a (Either ex b))
-> (a -> m (Either ex b)) -> Kleisli m a (Either ex b)
forall a b. (a -> b) -> a -> b
$ m b -> m (Either ex b)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (m b -> m (Either ex b)) -> (a -> m b) -> a -> m (Either ex b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m b
act
  {-# INLINE tryE #-}

instance (Applicative f, ThrowEffect ex eff) => ThrowEffect ex (f `Cayley` eff) where
  throwE :: Cayley f eff (Either ex b) b
throwE = f (eff (Either ex b) b) -> Cayley f eff (Either ex b) b
forall k k1 k2 (f :: k -> *) (p :: k1 -> k2 -> k) (a :: k1)
       (b :: k2).
f (p a b) -> Cayley f p a b
Cayley (f (eff (Either ex b) b) -> Cayley f eff (Either ex b) b)
-> f (eff (Either ex b) b) -> Cayley f eff (Either ex b) b
forall a b. (a -> b) -> a -> b
$ eff (Either ex b) b -> f (eff (Either ex b) b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure eff (Either ex b) b
forall ex (eff :: * -> * -> *) b.
ThrowEffect ex eff =>
eff (Either ex b) b
throwE
  {-# INLINE throwE #-}

instance (Functor f, TryEffect ex eff) => TryEffect ex (f `Cayley` eff) where
  tryE :: Cayley f eff a b -> Cayley f eff a (Either ex b)
tryE (Cayley f (eff a b)
f) = f (eff a (Either ex b)) -> Cayley f eff a (Either ex b)
forall k k1 k2 (f :: k -> *) (p :: k1 -> k2 -> k) (a :: k1)
       (b :: k2).
f (p a b) -> Cayley f p a b
Cayley (f (eff a (Either ex b)) -> Cayley f eff a (Either ex b))
-> f (eff a (Either ex b)) -> Cayley f eff a (Either ex b)
forall a b. (a -> b) -> a -> b
$ eff a b -> eff a (Either ex b)
forall ex (eff :: * -> * -> *) a b.
TryEffect ex eff =>
eff a b -> eff a (Either ex b)
tryE (eff a b -> eff a (Either ex b))
-> f (eff a b) -> f (eff a (Either ex b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (eff a b)
f
  {-# INLINE tryE #-}