{-# LANGUAGE
  RankNTypes,
  MultiParamTypeClasses,
  UndecidableInstances
  #-}
module Control.Monad.AnyCont.Class where

import Prelude

import Control.Monad.Trans.Class
import Control.Monad.Trans.AnyCont (AnyContT)
import qualified Control.Monad.Trans.AnyCont as AnyCont
import Control.Monad.Trans.Except as Except
import Control.Monad.Trans.State as State

class ScopeAnyCont m where
  scopeAnyCont :: m a -> m a

class MonadAnyCont b m where
  anyContToM :: (forall r . (a -> b r) -> b r) -> m a


instance MonadTransAnyCont b m => MonadAnyCont b (AnyContT m) where
  anyContToM :: (forall r. (a -> b r) -> b r) -> AnyContT m a
anyContToM c :: forall r. (a -> b r) -> b r
c = (forall r. (a -> m r) -> m r) -> AnyContT m a
forall a (m :: * -> *).
(forall r. (a -> m r) -> m r) -> AnyContT m a
AnyCont.anyContT ((forall r. (a -> b r) -> b r) -> forall r. (a -> m r) -> m r
forall (b :: * -> *) (m :: * -> *) a.
MonadTransAnyCont b m =>
(forall r. (a -> b r) -> b r) -> forall r. (a -> m r) -> m r
liftAnyCont forall r. (a -> b r) -> b r
c)

instance Monad m => ScopeAnyCont (AnyContT m) where
  scopeAnyCont :: AnyContT m a -> AnyContT m a
scopeAnyCont = m a -> AnyContT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> AnyContT m a)
-> (AnyContT m a -> m a) -> AnyContT m a -> AnyContT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AnyContT m a -> (a -> m a) -> m a)
-> (a -> m a) -> AnyContT m a -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip AnyContT m a -> (a -> m a) -> m a
forall (m :: * -> *) a. AnyContT m a -> forall r. (a -> m r) -> m r
AnyCont.runAnyContT a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return


instance (Monad m, MonadAnyCont b m) => MonadAnyCont b (StateT s m) where
  anyContToM :: (forall r. (a -> b r) -> b r) -> StateT s m a
anyContToM x :: forall r. (a -> b r) -> b r
x = m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> StateT s m a) -> m a -> StateT s m a
forall a b. (a -> b) -> a -> b
$ (forall r. (a -> b r) -> b r) -> m a
forall (b :: * -> *) (m :: * -> *) a.
MonadAnyCont b m =>
(forall r. (a -> b r) -> b r) -> m a
anyContToM forall r. (a -> b r) -> b r
x

instance ScopeAnyCont m => ScopeAnyCont (StateT s m) where
  scopeAnyCont :: StateT s m a -> StateT s m a
scopeAnyCont = (s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((s -> m (a, s)) -> StateT s m a)
-> (StateT s m a -> s -> m (a, s)) -> StateT s m a -> StateT s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (m (a, s) -> m (a, s)
forall (m :: * -> *) a. ScopeAnyCont m => m a -> m a
scopeAnyCont (m (a, s) -> m (a, s)) -> (s -> m (a, s)) -> s -> m (a, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((s -> m (a, s)) -> s -> m (a, s))
-> (StateT s m a -> s -> m (a, s)) -> StateT s m a -> s -> m (a, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT s m a -> s -> m (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT


instance (Monad m, MonadAnyCont b m) => MonadAnyCont b (ExceptT e m) where
  anyContToM :: (forall r. (a -> b r) -> b r) -> ExceptT e m a
anyContToM x :: forall r. (a -> b r) -> b r
x = m a -> ExceptT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ExceptT e m a) -> m a -> ExceptT e m a
forall a b. (a -> b) -> a -> b
$ (forall r. (a -> b r) -> b r) -> m a
forall (b :: * -> *) (m :: * -> *) a.
MonadAnyCont b m =>
(forall r. (a -> b r) -> b r) -> m a
anyContToM forall r. (a -> b r) -> b r
x


instance ScopeAnyCont m => ScopeAnyCont (ExceptT e m) where
  scopeAnyCont :: ExceptT e m a -> ExceptT e m a
scopeAnyCont = (m (Either e a) -> m (Either e a))
-> ExceptT e m a -> ExceptT e m a
forall (m :: * -> *) e a (n :: * -> *) e' b.
(m (Either e a) -> n (Either e' b))
-> ExceptT e m a -> ExceptT e' n b
mapExceptT m (Either e a) -> m (Either e a)
forall (m :: * -> *) a. ScopeAnyCont m => m a -> m a
scopeAnyCont

class MonadTransAnyCont b m where
  liftAnyCont :: (forall r . (a -> b r) -> b r) -> (forall r . (a -> m r) -> m r)

instance MonadTransAnyCont b b where
  liftAnyCont :: (forall r. (a -> b r) -> b r) -> forall r. (a -> b r) -> b r
liftAnyCont c :: forall r. (a -> b r) -> b r
c = (a -> b r) -> b r
forall r. (a -> b r) -> b r
c

instance MonadTransAnyCont b m => MonadTransAnyCont b (StateT s m) where
  liftAnyCont :: (forall r. (a -> b r) -> b r)
-> forall r. (a -> StateT s m r) -> StateT s m r
liftAnyCont c :: forall r. (a -> b r) -> b r
c = (\c :: (a -> m (r, s)) -> m (r, s)
c q :: a -> StateT s m r
q -> (s -> m (r, s)) -> StateT s m r
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((s -> m (r, s)) -> StateT s m r)
-> (s -> m (r, s)) -> StateT s m r
forall a b. (a -> b) -> a -> b
$ \s :: s
s -> (a -> m (r, s)) -> m (r, s)
c ((a -> m (r, s)) -> m (r, s)) -> (a -> m (r, s)) -> m (r, s)
forall a b. (a -> b) -> a -> b
$ ((s -> m (r, s)) -> s -> m (r, s)
forall a b. (a -> b) -> a -> b
$ s
s) ((s -> m (r, s)) -> m (r, s))
-> (a -> s -> m (r, s)) -> a -> m (r, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT s m r -> s -> m (r, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (StateT s m r -> s -> m (r, s))
-> (a -> StateT s m r) -> a -> s -> m (r, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> StateT s m r
q) ((forall r. (a -> b r) -> b r) -> forall r. (a -> m r) -> m r
forall (b :: * -> *) (m :: * -> *) a.
MonadTransAnyCont b m =>
(forall r. (a -> b r) -> b r) -> forall r. (a -> m r) -> m r
liftAnyCont forall r. (a -> b r) -> b r
c)

instance MonadTransAnyCont b m => MonadTransAnyCont b (ExceptT e m) where
  liftAnyCont :: (forall r. (a -> b r) -> b r)
-> forall r. (a -> ExceptT e m r) -> ExceptT e m r
liftAnyCont c :: forall r. (a -> b r) -> b r
c = (\c :: (a -> m (Either e r)) -> m (Either e r)
c q :: a -> ExceptT e m r
q -> m (Either e r) -> ExceptT e m r
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either e r) -> ExceptT e m r)
-> ((a -> m (Either e r)) -> m (Either e r))
-> (a -> m (Either e r))
-> ExceptT e m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> m (Either e r)) -> m (Either e r)
c ((a -> m (Either e r)) -> ExceptT e m r)
-> (a -> m (Either e r)) -> ExceptT e m r
forall a b. (a -> b) -> a -> b
$ ExceptT e m r -> m (Either e r)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT e m r -> m (Either e r))
-> (a -> ExceptT e m r) -> a -> m (Either e r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ExceptT e m r
q) ((forall r. (a -> b r) -> b r) -> forall r. (a -> m r) -> m r
forall (b :: * -> *) (m :: * -> *) a.
MonadTransAnyCont b m =>
(forall r. (a -> b r) -> b r) -> forall r. (a -> m r) -> m r
liftAnyCont forall r. (a -> b r) -> b r
c)