{-# LANGUAGE QuantifiedConstraints, UndecidableInstances, TupleSections #-} module Control.Monad.Trans.Elevator where import Control.Monad.Base import Control.Monad.Error.Class import Control.Monad.Reader.Class import Control.Monad.State.Class import Control.Monad.Trans import Control.Monad.Trans.Control import Control.Monad.Writer.Class import Data.Kind newtype Elevator (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) (a :: Type) = Ascend { Elevator t m a -> t m a descend :: t m a } deriving newtype (Functor (Elevator t m) a -> Elevator t m a Functor (Elevator t m) -> (forall a. a -> Elevator t m a) -> (forall a b. Elevator t m (a -> b) -> Elevator t m a -> Elevator t m b) -> (forall a b c. (a -> b -> c) -> Elevator t m a -> Elevator t m b -> Elevator t m c) -> (forall a b. Elevator t m a -> Elevator t m b -> Elevator t m b) -> (forall a b. Elevator t m a -> Elevator t m b -> Elevator t m a) -> Applicative (Elevator t m) Elevator t m a -> Elevator t m b -> Elevator t m b Elevator t m a -> Elevator t m b -> Elevator t m a Elevator t m (a -> b) -> Elevator t m a -> Elevator t m b (a -> b -> c) -> Elevator t m a -> Elevator t m b -> Elevator t m c forall a. a -> Elevator t m a forall a b. Elevator t m a -> Elevator t m b -> Elevator t m a forall a b. Elevator t m a -> Elevator t m b -> Elevator t m b forall a b. Elevator t m (a -> b) -> Elevator t m a -> Elevator t m b forall a b c. (a -> b -> c) -> Elevator t m a -> Elevator t m b -> Elevator t m c forall (f :: * -> *). Functor f -> (forall a. a -> f a) -> (forall a b. f (a -> b) -> f a -> f b) -> (forall a b c. (a -> b -> c) -> f a -> f b -> f c) -> (forall a b. f a -> f b -> f b) -> (forall a b. f a -> f b -> f a) -> Applicative f forall (t :: (* -> *) -> * -> *) (m :: * -> *). Applicative (t m) => Functor (Elevator t m) forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. Applicative (t m) => a -> Elevator t m a forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b. Applicative (t m) => Elevator t m a -> Elevator t m b -> Elevator t m a forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b. Applicative (t m) => Elevator t m a -> Elevator t m b -> Elevator t m b forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b. Applicative (t m) => Elevator t m (a -> b) -> Elevator t m a -> Elevator t m b forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b c. Applicative (t m) => (a -> b -> c) -> Elevator t m a -> Elevator t m b -> Elevator t m c <* :: Elevator t m a -> Elevator t m b -> Elevator t m a $c<* :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b. Applicative (t m) => Elevator t m a -> Elevator t m b -> Elevator t m a *> :: Elevator t m a -> Elevator t m b -> Elevator t m b $c*> :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b. Applicative (t m) => Elevator t m a -> Elevator t m b -> Elevator t m b liftA2 :: (a -> b -> c) -> Elevator t m a -> Elevator t m b -> Elevator t m c $cliftA2 :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b c. Applicative (t m) => (a -> b -> c) -> Elevator t m a -> Elevator t m b -> Elevator t m c <*> :: Elevator t m (a -> b) -> Elevator t m a -> Elevator t m b $c<*> :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b. Applicative (t m) => Elevator t m (a -> b) -> Elevator t m a -> Elevator t m b pure :: a -> Elevator t m a $cpure :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. Applicative (t m) => a -> Elevator t m a $cp1Applicative :: forall (t :: (* -> *) -> * -> *) (m :: * -> *). Applicative (t m) => Functor (Elevator t m) Applicative, a -> Elevator t m b -> Elevator t m a (a -> b) -> Elevator t m a -> Elevator t m b (forall a b. (a -> b) -> Elevator t m a -> Elevator t m b) -> (forall a b. a -> Elevator t m b -> Elevator t m a) -> Functor (Elevator t m) forall a b. a -> Elevator t m b -> Elevator t m a forall a b. (a -> b) -> Elevator t m a -> Elevator t m b forall (f :: * -> *). (forall a b. (a -> b) -> f a -> f b) -> (forall a b. a -> f b -> f a) -> Functor f forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b. Functor (t m) => a -> Elevator t m b -> Elevator t m a forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b. Functor (t m) => (a -> b) -> Elevator t m a -> Elevator t m b <$ :: a -> Elevator t m b -> Elevator t m a $c<$ :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b. Functor (t m) => a -> Elevator t m b -> Elevator t m a fmap :: (a -> b) -> Elevator t m a -> Elevator t m b $cfmap :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b. Functor (t m) => (a -> b) -> Elevator t m a -> Elevator t m b Functor, Applicative (Elevator t m) a -> Elevator t m a Applicative (Elevator t m) -> (forall a b. Elevator t m a -> (a -> Elevator t m b) -> Elevator t m b) -> (forall a b. Elevator t m a -> Elevator t m b -> Elevator t m b) -> (forall a. a -> Elevator t m a) -> Monad (Elevator t m) Elevator t m a -> (a -> Elevator t m b) -> Elevator t m b Elevator t m a -> Elevator t m b -> Elevator t m b forall a. a -> Elevator t m a forall a b. Elevator t m a -> Elevator t m b -> Elevator t m b forall a b. Elevator t m a -> (a -> Elevator t m b) -> Elevator t m b forall (m :: * -> *). Applicative m -> (forall a b. m a -> (a -> m b) -> m b) -> (forall a b. m a -> m b -> m b) -> (forall a. a -> m a) -> Monad m forall (t :: (* -> *) -> * -> *) (m :: * -> *). Monad (t m) => Applicative (Elevator t m) forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. Monad (t m) => a -> Elevator t m a forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b. Monad (t m) => Elevator t m a -> Elevator t m b -> Elevator t m b forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b. Monad (t m) => Elevator t m a -> (a -> Elevator t m b) -> Elevator t m b return :: a -> Elevator t m a $creturn :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. Monad (t m) => a -> Elevator t m a >> :: Elevator t m a -> Elevator t m b -> Elevator t m b $c>> :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b. Monad (t m) => Elevator t m a -> Elevator t m b -> Elevator t m b >>= :: Elevator t m a -> (a -> Elevator t m b) -> Elevator t m b $c>>= :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b. Monad (t m) => Elevator t m a -> (a -> Elevator t m b) -> Elevator t m b $cp1Monad :: forall (t :: (* -> *) -> * -> *) (m :: * -> *). Monad (t m) => Applicative (Elevator t m) Monad) instance (Monad (t m), MonadTrans t, MonadBase b m) => MonadBase b (Elevator t m) where liftBase :: b α -> Elevator t m α liftBase = t m α -> Elevator t m α forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. t m a -> Elevator t m a Ascend (t m α -> Elevator t m α) -> (b α -> t m α) -> b α -> Elevator t m α forall b c a. (b -> c) -> (a -> b) -> a -> c . m α -> t m α forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift (m α -> t m α) -> (b α -> m α) -> b α -> t m α forall b c a. (b -> c) -> (a -> b) -> a -> c . b α -> m α forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α liftBase instance (Monad (t m), MonadTransControl t, MonadBaseControl b m) => MonadBaseControl b (Elevator t m) where type StM (Elevator t m) a = StM m (StT t a) liftBaseWith :: (RunInBase (Elevator t m) b -> b a) -> Elevator t m a liftBaseWith RunInBase (Elevator t m) b -> b a f = t m a -> Elevator t m a forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. t m a -> Elevator t m a Ascend (t m a -> Elevator t m a) -> t m a -> Elevator t m a forall a b. (a -> b) -> a -> b $ (Run t -> m a) -> t m a forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTransControl t, Monad m) => (Run t -> m a) -> t m a liftWith ((Run t -> m a) -> t m a) -> (Run t -> m a) -> t m a forall a b. (a -> b) -> a -> b $ \ Run t runT -> (RunInBase m b -> b a) -> m a forall (b :: * -> *) (m :: * -> *) a. MonadBaseControl b m => (RunInBase m b -> b a) -> m a liftBaseWith ((RunInBase m b -> b a) -> m a) -> (RunInBase m b -> b a) -> m a forall a b. (a -> b) -> a -> b $ \ RunInBase m b runInBase -> RunInBase (Elevator t m) b -> b a f (RunInBase (Elevator t m) b -> b a) -> RunInBase (Elevator t m) b -> b a forall a b. (a -> b) -> a -> b $ m (StT t a) -> b (StM m (StT t a)) RunInBase m b runInBase (m (StT t a) -> b (StM m (StT t a))) -> (Elevator t m a -> m (StT t a)) -> Elevator t m a -> b (StM m (StT t a)) forall b c a. (b -> c) -> (a -> b) -> a -> c . t m a -> m (StT t a) Run t runT (t m a -> m (StT t a)) -> (Elevator t m a -> t m a) -> Elevator t m a -> m (StT t a) forall b c a. (b -> c) -> (a -> b) -> a -> c . Elevator t m a -> t m a forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. Elevator t m a -> t m a descend restoreM :: StM (Elevator t m) a -> Elevator t m a restoreM = t m a -> Elevator t m a forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. t m a -> Elevator t m a Ascend (t m a -> Elevator t m a) -> (StM m (StT t a) -> t m a) -> StM m (StT t a) -> Elevator t m a forall b c a. (b -> c) -> (a -> b) -> a -> c . m (StT t a) -> t m a forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTransControl t, Monad m) => m (StT t a) -> t m a restoreT (m (StT t a) -> t m a) -> (StM m (StT t a) -> m (StT t a)) -> StM m (StT t a) -> t m a forall b c a. (b -> c) -> (a -> b) -> a -> c . StM m (StT t a) -> m (StT t a) forall (b :: * -> *) (m :: * -> *) a. MonadBaseControl b m => StM m a -> m a restoreM instance (Monad (t m), MonadTrans t, MonadIO m) => MonadIO (Elevator t m) where liftIO :: IO a -> Elevator t m a liftIO = t m a -> Elevator t m a forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. t m a -> Elevator t m a Ascend (t m a -> Elevator t m a) -> (IO a -> t m a) -> IO a -> Elevator t m a forall b c a. (b -> c) -> (a -> b) -> a -> c . m a -> t m a forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift (m a -> t m a) -> (IO a -> m a) -> IO a -> t m a forall b c a. (b -> c) -> (a -> b) -> a -> c . IO a -> m a forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO instance (Monad (t m), MonadTransControl t, MonadError e m) => MonadError e (Elevator t m) where throwError :: e -> Elevator t m a throwError = t m a -> Elevator t m a forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. t m a -> Elevator t m a Ascend (t m a -> Elevator t m a) -> (e -> t m a) -> e -> Elevator t m a forall b c a. (b -> c) -> (a -> b) -> a -> c . m a -> t m a forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift (m a -> t m a) -> (e -> m a) -> e -> t m a forall b c a. (b -> c) -> (a -> b) -> a -> c . e -> m a forall e (m :: * -> *) a. MonadError e m => e -> m a throwError catchError :: Elevator t m a -> (e -> Elevator t m a) -> Elevator t m a catchError Elevator t m a throwing e -> Elevator t m a catching = t m a -> Elevator t m a forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. t m a -> Elevator t m a Ascend (t m a -> Elevator t m a) -> t m a -> Elevator t m a forall a b. (a -> b) -> a -> b $ (m (StT t a) -> t m a forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTransControl t, Monad m) => m (StT t a) -> t m a restoreT (m (StT t a) -> t m a) -> (StT t a -> m (StT t a)) -> StT t a -> t m a forall b c a. (b -> c) -> (a -> b) -> a -> c . StT t a -> m (StT t a) forall (f :: * -> *) a. Applicative f => a -> f a pure (StT t a -> t m a) -> t m (StT t a) -> t m a forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<<) (t m (StT t a) -> t m a) -> t m (StT t a) -> t m a forall a b. (a -> b) -> a -> b $ (Run t -> m (StT t a)) -> t m (StT t a) forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTransControl t, Monad m) => (Run t -> m a) -> t m a liftWith ((Run t -> m (StT t a)) -> t m (StT t a)) -> (Run t -> m (StT t a)) -> t m (StT t a) forall a b. (a -> b) -> a -> b $ \ Run t runT -> m (StT t a) -> (e -> m (StT t a)) -> m (StT t a) forall e (m :: * -> *) a. MonadError e m => m a -> (e -> m a) -> m a catchError (t m a -> m (StT t a) Run t runT (t m a -> m (StT t a)) -> t m a -> m (StT t a) forall a b. (a -> b) -> a -> b $ Elevator t m a -> t m a forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. Elevator t m a -> t m a descend Elevator t m a throwing) (t m a -> m (StT t a) Run t runT (t m a -> m (StT t a)) -> (e -> t m a) -> e -> m (StT t a) forall b c a. (b -> c) -> (a -> b) -> a -> c . Elevator t m a -> t m a forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. Elevator t m a -> t m a descend (Elevator t m a -> t m a) -> (e -> Elevator t m a) -> e -> t m a forall b c a. (b -> c) -> (a -> b) -> a -> c . e -> Elevator t m a catching) instance (Monad (t m), MonadTransControl t, MonadReader r m) => MonadReader r (Elevator t m) where ask :: Elevator t m r ask = t m r -> Elevator t m r forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. t m a -> Elevator t m a Ascend (t m r -> Elevator t m r) -> t m r -> Elevator t m r forall a b. (a -> b) -> a -> b $ m r -> t m r forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift m r forall r (m :: * -> *). MonadReader r m => m r ask local :: (r -> r) -> Elevator t m a -> Elevator t m a local r -> r f Elevator t m a tma = t m a -> Elevator t m a forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. t m a -> Elevator t m a Ascend (t m a -> Elevator t m a) -> t m a -> Elevator t m a forall a b. (a -> b) -> a -> b $ (m (StT t a) -> t m a forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTransControl t, Monad m) => m (StT t a) -> t m a restoreT (m (StT t a) -> t m a) -> (StT t a -> m (StT t a)) -> StT t a -> t m a forall b c a. (b -> c) -> (a -> b) -> a -> c . StT t a -> m (StT t a) forall (f :: * -> *) a. Applicative f => a -> f a pure (StT t a -> t m a) -> t m (StT t a) -> t m a forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<<) (t m (StT t a) -> t m a) -> t m (StT t a) -> t m a forall a b. (a -> b) -> a -> b $ (Run t -> m (StT t a)) -> t m (StT t a) forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTransControl t, Monad m) => (Run t -> m a) -> t m a liftWith ((Run t -> m (StT t a)) -> t m (StT t a)) -> (Run t -> m (StT t a)) -> t m (StT t a) forall a b. (a -> b) -> a -> b $ \ Run t runT -> (r -> r) -> m (StT t a) -> m (StT t a) forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a local r -> r f (m (StT t a) -> m (StT t a)) -> m (StT t a) -> m (StT t a) forall a b. (a -> b) -> a -> b $ t m a -> m (StT t a) Run t runT (t m a -> m (StT t a)) -> t m a -> m (StT t a) forall a b. (a -> b) -> a -> b $ Elevator t m a -> t m a forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. Elevator t m a -> t m a descend Elevator t m a tma instance (Monad (t m), MonadTrans t, MonadState s m) => MonadState s (Elevator t m) where get :: Elevator t m s get = t m s -> Elevator t m s forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. t m a -> Elevator t m a Ascend (t m s -> Elevator t m s) -> t m s -> Elevator t m s forall a b. (a -> b) -> a -> b $ m s -> t m s forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift m s forall s (m :: * -> *). MonadState s m => m s get put :: s -> Elevator t m () put = t m () -> Elevator t m () forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. t m a -> Elevator t m a Ascend (t m () -> Elevator t m ()) -> (s -> t m ()) -> s -> Elevator t m () forall b c a. (b -> c) -> (a -> b) -> a -> c . m () -> t m () forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift (m () -> t m ()) -> (s -> m ()) -> s -> t m () forall b c a. (b -> c) -> (a -> b) -> a -> c . s -> m () forall s (m :: * -> *). MonadState s m => s -> m () put instance (Monad (t m), MonadTransControl t, MonadWriter w m) => MonadWriter w (Elevator t m) where tell :: w -> Elevator t m () tell = t m () -> Elevator t m () forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. t m a -> Elevator t m a Ascend (t m () -> Elevator t m ()) -> (w -> t m ()) -> w -> Elevator t m () forall b c a. (b -> c) -> (a -> b) -> a -> c . m () -> t m () forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift (m () -> t m ()) -> (w -> m ()) -> w -> t m () forall b c a. (b -> c) -> (a -> b) -> a -> c . w -> m () forall w (m :: * -> *). MonadWriter w m => w -> m () tell listen :: Elevator t m a -> Elevator t m (a, w) listen Elevator t m a tma = t m (a, w) -> Elevator t m (a, w) forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. t m a -> Elevator t m a Ascend (t m (a, w) -> Elevator t m (a, w)) -> t m (a, w) -> Elevator t m (a, w) forall a b. (a -> b) -> a -> b $ (Run t -> m (StT t a, w)) -> t m (StT t a, w) forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTransControl t, Monad m) => (Run t -> m a) -> t m a liftWith (\ Run t runT -> m (StT t a) -> m (StT t a, w) forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w) listen (m (StT t a) -> m (StT t a, w)) -> m (StT t a) -> m (StT t a, w) forall a b. (a -> b) -> a -> b $ t m a -> m (StT t a) Run t runT (t m a -> m (StT t a)) -> t m a -> m (StT t a) forall a b. (a -> b) -> a -> b $ Elevator t m a -> t m a forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. Elevator t m a -> t m a descend Elevator t m a tma) t m (StT t a, w) -> ((StT t a, w) -> t m (a, w)) -> t m (a, w) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \ (StT t a sta, w w) -> (, w w) (a -> (a, w)) -> t m a -> t m (a, w) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> m (StT t a) -> t m a forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTransControl t, Monad m) => m (StT t a) -> t m a restoreT (StT t a -> m (StT t a) forall (f :: * -> *) a. Applicative f => a -> f a pure StT t a sta) pass :: Elevator t m (a, w -> w) -> Elevator t m a pass Elevator t m (a, w -> w) tma = t m a -> Elevator t m a forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. t m a -> Elevator t m a Ascend (t m a -> Elevator t m a) -> t m a -> Elevator t m a forall a b. (a -> b) -> a -> b $ m a -> t m a forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift (m a -> t m a) -> ((a, w -> w) -> m a) -> (a, w -> w) -> t m a forall b c a. (b -> c) -> (a -> b) -> a -> c . m (a, w -> w) -> m a forall w (m :: * -> *) a. MonadWriter w m => m (a, w -> w) -> m a pass (m (a, w -> w) -> m a) -> ((a, w -> w) -> m (a, w -> w)) -> (a, w -> w) -> m a forall b c a. (b -> c) -> (a -> b) -> a -> c . (a, w -> w) -> m (a, w -> w) forall (f :: * -> *) a. Applicative f => a -> f a pure ((a, w -> w) -> t m a) -> t m (a, w -> w) -> t m a forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< Elevator t m (a, w -> w) -> t m (a, w -> w) forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. Elevator t m a -> t m a descend Elevator t m (a, w -> w) tma