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