{-# LANGUAGE RankNTypes #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} module Control.Monad.CPSExcept where import Control.Monad.Except import Control.Monad.State import Control.Monad.Reader() import Control.Monad.Writer() import Control.Monad.RWS() newtype CPSExceptT e m a = CPSExceptT { CPSExceptT e m a -> forall r. (e -> m r) -> (a -> m r) -> m r getCPSExceptT :: forall r. ((e -> m r) -> (a -> m r) -> m r) } runCPSExceptT :: Applicative m => CPSExceptT e m a -> m (Either e a) runCPSExceptT :: CPSExceptT e m a -> m (Either e a) runCPSExceptT (CPSExceptT forall r. (e -> m r) -> (a -> m r) -> m r f) = (e -> m (Either e a)) -> (a -> m (Either e a)) -> m (Either e a) forall r. (e -> m r) -> (a -> m r) -> m r f (Either e a -> m (Either e a) forall (f :: * -> *) a. Applicative f => a -> f a pure (Either e a -> m (Either e a)) -> (e -> Either e a) -> e -> m (Either e a) forall b c a. (b -> c) -> (a -> b) -> a -> c . e -> Either e a forall a b. a -> Either a b Left) (Either e a -> m (Either e a) forall (f :: * -> *) a. Applicative f => a -> f a pure (Either e a -> m (Either e a)) -> (a -> Either e a) -> a -> m (Either e a) forall b c a. (b -> c) -> (a -> b) -> a -> c . a -> Either e a forall a b. b -> Either a b Right) {-# INLINE runCPSExceptT #-} instance Functor (CPSExceptT e m) where fmap :: (a -> b) -> CPSExceptT e m a -> CPSExceptT e m b fmap a -> b f (CPSExceptT forall r. (e -> m r) -> (a -> m r) -> m r g) = (forall r. (e -> m r) -> (b -> m r) -> m r) -> CPSExceptT e m b forall e (m :: * -> *) a. (forall r. (e -> m r) -> (a -> m r) -> m r) -> CPSExceptT e m a CPSExceptT ((forall r. (e -> m r) -> (b -> m r) -> m r) -> CPSExceptT e m b) -> (forall r. (e -> m r) -> (b -> m r) -> m r) -> CPSExceptT e m b forall a b. (a -> b) -> a -> b $ \e -> m r failC b -> m r successC -> (e -> m r) -> (a -> m r) -> m r forall r. (e -> m r) -> (a -> m r) -> m r g e -> m r failC (b -> m r successC (b -> m r) -> (a -> b) -> a -> m r forall b c a. (b -> c) -> (a -> b) -> a -> c . a -> b f) {-# INLINE fmap #-} instance Monad m => Applicative (CPSExceptT e m) where pure :: a -> CPSExceptT e m a pure a x = (forall r. (e -> m r) -> (a -> m r) -> m r) -> CPSExceptT e m a forall e (m :: * -> *) a. (forall r. (e -> m r) -> (a -> m r) -> m r) -> CPSExceptT e m a CPSExceptT ((forall r. (e -> m r) -> (a -> m r) -> m r) -> CPSExceptT e m a) -> (forall r. (e -> m r) -> (a -> m r) -> m r) -> CPSExceptT e m a forall a b. (a -> b) -> a -> b $ \e -> m r _failC a -> m r successC -> a -> m r successC a x {-# INLINE pure #-} <*> :: CPSExceptT e m (a -> b) -> CPSExceptT e m a -> CPSExceptT e m b (<*>) = CPSExceptT e m (a -> b) -> CPSExceptT e m a -> CPSExceptT e m b forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b ap {-# INLINE (<*>) #-} instance Monad m => Monad (CPSExceptT e m) where CPSExceptT forall r. (e -> m r) -> (a -> m r) -> m r f >>= :: CPSExceptT e m a -> (a -> CPSExceptT e m b) -> CPSExceptT e m b >>= a -> CPSExceptT e m b g = (forall r. (e -> m r) -> (b -> m r) -> m r) -> CPSExceptT e m b forall e (m :: * -> *) a. (forall r. (e -> m r) -> (a -> m r) -> m r) -> CPSExceptT e m a CPSExceptT ((forall r. (e -> m r) -> (b -> m r) -> m r) -> CPSExceptT e m b) -> (forall r. (e -> m r) -> (b -> m r) -> m r) -> CPSExceptT e m b forall a b. (a -> b) -> a -> b $ \e -> m r failC b -> m r successC -> (e -> m r) -> (a -> m r) -> m r forall r. (e -> m r) -> (a -> m r) -> m r f e -> m r failC (\a a -> CPSExceptT e m b -> (e -> m r) -> (b -> m r) -> m r forall e (m :: * -> *) a. CPSExceptT e m a -> forall r. (e -> m r) -> (a -> m r) -> m r getCPSExceptT (a -> CPSExceptT e m b g a a) e -> m r failC b -> m r successC) {-# INLINE (>>=) #-} instance Monad m => MonadError e (CPSExceptT e m) where throwError :: e -> CPSExceptT e m a throwError e e = (forall r. (e -> m r) -> (a -> m r) -> m r) -> CPSExceptT e m a forall e (m :: * -> *) a. (forall r. (e -> m r) -> (a -> m r) -> m r) -> CPSExceptT e m a CPSExceptT ((forall r. (e -> m r) -> (a -> m r) -> m r) -> CPSExceptT e m a) -> (forall r. (e -> m r) -> (a -> m r) -> m r) -> CPSExceptT e m a forall a b. (a -> b) -> a -> b $ \e -> m r failC a -> m r _successC -> e -> m r failC e e {-# INLINE throwError #-} catchError :: CPSExceptT e m a -> (e -> CPSExceptT e m a) -> CPSExceptT e m a catchError (CPSExceptT forall r. (e -> m r) -> (a -> m r) -> m r f) e -> CPSExceptT e m a handler = (forall r. (e -> m r) -> (a -> m r) -> m r) -> CPSExceptT e m a forall e (m :: * -> *) a. (forall r. (e -> m r) -> (a -> m r) -> m r) -> CPSExceptT e m a CPSExceptT ((forall r. (e -> m r) -> (a -> m r) -> m r) -> CPSExceptT e m a) -> (forall r. (e -> m r) -> (a -> m r) -> m r) -> CPSExceptT e m a forall a b. (a -> b) -> a -> b $ \e -> m r failC a -> m r successC -> (e -> m r) -> (a -> m r) -> m r forall r. (e -> m r) -> (a -> m r) -> m r f (\e e -> CPSExceptT e m a -> (e -> m r) -> (a -> m r) -> m r forall e (m :: * -> *) a. CPSExceptT e m a -> forall r. (e -> m r) -> (a -> m r) -> m r getCPSExceptT (e -> CPSExceptT e m a handler e e) e -> m r failC a -> m r successC) a -> m r successC {-# INLINE catchError #-} instance MonadTrans (CPSExceptT e) where lift :: m a -> CPSExceptT e m a lift m a m = (forall r. (e -> m r) -> (a -> m r) -> m r) -> CPSExceptT e m a forall e (m :: * -> *) a. (forall r. (e -> m r) -> (a -> m r) -> m r) -> CPSExceptT e m a CPSExceptT ((forall r. (e -> m r) -> (a -> m r) -> m r) -> CPSExceptT e m a) -> (forall r. (e -> m r) -> (a -> m r) -> m r) -> CPSExceptT e m a forall a b. (a -> b) -> a -> b $ \e -> m r _failC a -> m r successC -> m a m m a -> (a -> m r) -> m r forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= a -> m r successC {-# INLINE lift #-} instance MonadState s m => MonadState s (CPSExceptT e m) where state :: (s -> (a, s)) -> CPSExceptT e m a state s -> (a, s) f = m a -> CPSExceptT e m a forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift (m a -> CPSExceptT e m a) -> m a -> CPSExceptT e m a forall a b. (a -> b) -> a -> b $ (s -> (a, s)) -> m a forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a state s -> (a, s) f {-# INLINE state #-}