module Control.Monad.Ology.Specific.TransformT where import Control.Monad.Ology.Data import Control.Monad.Ology.General import Import type TransformT :: forall k. (k -> Type) -> Type -> Type newtype TransformT f a = MkTransformT { forall k (f :: k -> Type) a. TransformT f a -> forall (r :: k). (a -> f r) -> f r unTransformT :: forall r. (a -> f r) -> f r } instance Functor (TransformT f) where fmap :: forall a b. (a -> b) -> TransformT f a -> TransformT f b fmap a -> b ab (MkTransformT forall (r :: k). (a -> f r) -> f r aff) = forall k (f :: k -> Type) a. (forall (r :: k). (a -> f r) -> f r) -> TransformT f a MkTransformT forall a b. (a -> b) -> a -> b $ \b -> f r bf -> forall (r :: k). (a -> f r) -> f r aff forall a b. (a -> b) -> a -> b $ b -> f r bf forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k). Category cat => cat b c -> cat a b -> cat a c . a -> b ab instance TransConstraint Functor TransformT where hasTransConstraint :: forall (m :: Type -> Type). Functor m => Dict (Functor (TransformT m)) hasTransConstraint = forall (a :: Constraint). a => Dict a Dict instance Applicative (TransformT f) where pure :: forall a. a -> TransformT f a pure a a = forall k (f :: k -> Type) a. (forall (r :: k). (a -> f r) -> f r) -> TransformT f a MkTransformT forall a b. (a -> b) -> a -> b $ \a -> f r af -> a -> f r af a a MkTransformT forall (r :: k). ((a -> b) -> f r) -> f r f <*> :: forall a b. TransformT f (a -> b) -> TransformT f a -> TransformT f b <*> MkTransformT forall (r :: k). (a -> f r) -> f r x = forall k (f :: k -> Type) a. (forall (r :: k). (a -> f r) -> f r) -> TransformT f a MkTransformT forall a b. (a -> b) -> a -> b $ \b -> f r bf -> forall (r :: k). ((a -> b) -> f r) -> f r f forall a b. (a -> b) -> a -> b $ \a -> b ab -> forall (r :: k). (a -> f r) -> f r x (b -> f r bf forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k). Category cat => cat b c -> cat a b -> cat a c . a -> b ab) instance TransConstraint Applicative TransformT where hasTransConstraint :: forall (m :: Type -> Type). Applicative m => Dict (Applicative (TransformT m)) hasTransConstraint = forall (a :: Constraint). a => Dict a Dict instance Monad (TransformT f) where return :: forall a. a -> TransformT f a return = forall (f :: Type -> Type) a. Applicative f => a -> f a pure MkTransformT forall (r :: k). (a -> f r) -> f r m >>= :: forall a b. TransformT f a -> (a -> TransformT f b) -> TransformT f b >>= a -> TransformT f b f = forall k (f :: k -> Type) a. (forall (r :: k). (a -> f r) -> f r) -> TransformT f a MkTransformT forall a b. (a -> b) -> a -> b $ \b -> f r bf -> forall (r :: k). (a -> f r) -> f r m (\a a -> forall k (f :: k -> Type) a. TransformT f a -> forall (r :: k). (a -> f r) -> f r unTransformT (a -> TransformT f b f a a) b -> f r bf) instance TransConstraint Monad TransformT where hasTransConstraint :: forall (m :: Type -> Type). Monad m => Dict (Monad (TransformT m)) hasTransConstraint = forall (a :: Constraint). a => Dict a Dict instance MonadTrans TransformT where lift :: forall (m :: Type -> Type) a. Monad m => m a -> TransformT m a lift m a m = forall k (f :: k -> Type) a. (forall (r :: k). (a -> f r) -> f r) -> TransformT f a MkTransformT forall a b. (a -> b) -> a -> b $ \a -> m r af -> m a m forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b >>= a -> m r af instance MonadIO m => MonadIO (TransformT m) where liftIO :: forall a. IO a -> TransformT m a liftIO = forall (t :: TransKind) (m :: Type -> Type) a. (MonadTrans t, Monad m) => m a -> t m a lift forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k). Category cat => cat b c -> cat a b -> cat a c . forall (m :: Type -> Type) a. MonadIO m => IO a -> m a liftIO instance TransConstraint MonadIO TransformT where hasTransConstraint :: forall (m :: Type -> Type). MonadIO m => Dict (MonadIO (TransformT m)) hasTransConstraint = forall (a :: Constraint). a => Dict a Dict instance Semigroup a => Semigroup (TransformT f a) where <> :: TransformT f a -> TransformT f a -> TransformT f a (<>) = forall (f :: Type -> Type) a b c. Applicative f => (a -> b -> c) -> f a -> f b -> f c liftA2 forall a. Semigroup a => a -> a -> a (<>) instance Monoid a => Monoid (TransformT f a) where mempty :: TransformT f a mempty = forall (f :: Type -> Type) a. Applicative f => a -> f a pure forall a. Monoid a => a mempty instance MonadFix m => MonadFix (TransformT m) where mfix :: forall a. (a -> TransformT m a) -> TransformT m a mfix a -> TransformT m a ama = forall k (f :: k -> Type) a. (forall (r :: k). (a -> f r) -> f r) -> TransformT f a MkTransformT forall a b. (a -> b) -> a -> b $ \a -> m r amr -> do rec (~(a olda, r r')) <- forall k (f :: k -> Type) a. TransformT f a -> forall (r :: k). (a -> f r) -> f r unTransformT (a -> TransformT m a ama a olda) forall a b. (a -> b) -> a -> b $ \a newa -> do r r <- a -> m r amr a newa forall (m :: Type -> Type) a. Monad m => a -> m a return (a newa, r r) forall (m :: Type -> Type) a. Monad m => a -> m a return r r' mapTransformT :: (f --> f) -> TransformT f () mapTransformT :: forall {k} (f :: k -> Type). (f --> f) -> TransformT f () mapTransformT f --> f ff = forall k (f :: k -> Type) a. (forall (r :: k). (a -> f r) -> f r) -> TransformT f a MkTransformT forall a b. (a -> b) -> a -> b $ \() -> f r uf -> f --> f ff forall a b. (a -> b) -> a -> b $ () -> f r uf () postTransformT :: Monad m => m () -> TransformT m () postTransformT :: forall (m :: Type -> Type). Monad m => m () -> TransformT m () postTransformT m () mu = forall {k} (f :: k -> Type). (f --> f) -> TransformT f () mapTransformT forall a b. (a -> b) -> a -> b $ \m a mr -> do a r <- m a mr m () mu forall (m :: Type -> Type) a. Monad m => a -> m a return a r transformTMap :: TransformT f () -> f --> f transformTMap :: forall {k} (f :: k -> Type). TransformT f () -> f --> f transformTMap (MkTransformT forall (r :: k). (() -> f r) -> f r uff) f a f = forall (r :: k). (() -> f r) -> f r uff forall a b. (a -> b) -> a -> b $ \() -> f a f execMapTransformT :: Monad f => f (TransformT f a) -> TransformT f a execMapTransformT :: forall (f :: Type -> Type) a. Monad f => f (TransformT f a) -> TransformT f a execMapTransformT f (TransformT f a) ffa = forall k (f :: k -> Type) a. (forall (r :: k). (a -> f r) -> f r) -> TransformT f a MkTransformT forall a b. (a -> b) -> a -> b $ \a -> f r af -> do MkTransformT forall r. (a -> f r) -> f r aff <- f (TransformT f a) ffa forall r. (a -> f r) -> f r aff a -> f r af transformParamRef :: forall m. Monad m => Param m --> Ref (TransformT m) transformParamRef :: forall (m :: Type -> Type). Monad m => Param m --> Ref (TransformT m) transformParamRef (Param m a param :: _ a) = let refGet :: TransformT m a refGet :: TransformT m a refGet = forall k (f :: k -> Type) a. (forall (r :: k). (a -> f r) -> f r) -> TransformT f a MkTransformT forall a b. (a -> b) -> a -> b $ \a -> m r afr -> do a a <- forall (m :: Type -> Type) a. Param m a -> m a paramAsk Param m a param a -> m r afr a a refPut :: a -> TransformT m () refPut :: a -> TransformT m () refPut a a = forall k (f :: k -> Type) a. (forall (r :: k). (a -> f r) -> f r) -> TransformT f a MkTransformT forall a b. (a -> b) -> a -> b $ \() -> m r ufr -> forall (m :: Type -> Type) a. Param m a -> a -> m --> m paramWith Param m a param a a forall a b. (a -> b) -> a -> b $ () -> m r ufr () in MkRef {TransformT m a a -> TransformT m () refPut :: a -> TransformT m () refGet :: TransformT m a refPut :: a -> TransformT m () refGet :: TransformT m a ..} liftTransformT :: forall t m. (MonadTransUnlift t, MonadTunnelIOInner m) => TransformT m --> TransformT (t m) liftTransformT :: forall (t :: TransKind) (m :: Type -> Type). (MonadTransUnlift t, MonadTunnelIOInner m) => TransformT m --> TransformT (t m) liftTransformT (MkTransformT forall r. (a -> m r) -> m r aff) = forall k (f :: k -> Type) a. (forall (r :: k). (a -> f r) -> f r) -> TransformT f a MkTransformT forall a b. (a -> b) -> a -> b $ \a -> t m r atf -> forall (t :: TransKind) (m :: Type -> Type) r. (MonadTransUnlift t, MonadIO m) => (Unlift MonadTunnelIOInner t -> m r) -> t m r liftWithUnlift forall a b. (a -> b) -> a -> b $ \Unlift MonadTunnelIOInner t unlift -> forall r. (a -> m r) -> m r aff forall a b. (a -> b) -> a -> b $ Unlift MonadTunnelIOInner t unlift forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k). Category cat => cat b c -> cat a b -> cat a c . a -> t m r atf