module Control.Monad.Ology.Specific.WithT where

import Control.Monad.Ology.Data
import Control.Monad.Ology.General
import Import

type WithT :: forall k. (k -> Type) -> Type -> Type
newtype WithT m a = MkWithT
    { forall k (m :: k -> Type) a. WithT m a -> With m a
unWithT :: With m a
    }

instance Functor (WithT m) where
    fmap :: forall a b. (a -> b) -> WithT m a -> WithT m b
fmap a -> b
ab (MkWithT With m a
aff) = forall k (m :: k -> Type) a. With m a -> WithT m a
MkWithT forall a b. (a -> b) -> a -> b
$ \b -> m r
bf -> With m a
aff forall a b. (a -> b) -> a -> b
$ b -> m 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 WithT where
    hasTransConstraint :: forall (m :: Type -> Type). Functor m => Dict (Functor (WithT m))
hasTransConstraint = forall (a :: Constraint). a => Dict a
Dict

instance Applicative (WithT m) where
    pure :: forall a. a -> WithT m a
pure a
a = forall k (m :: k -> Type) a. With m a -> WithT m a
MkWithT forall a b. (a -> b) -> a -> b
$ \a -> m r
af -> a -> m r
af a
a
    MkWithT With m (a -> b)
f <*> :: forall a b. WithT m (a -> b) -> WithT m a -> WithT m b
<*> MkWithT With m a
x = forall k (m :: k -> Type) a. With m a -> WithT m a
MkWithT forall a b. (a -> b) -> a -> b
$ \b -> m r
bf -> With m (a -> b)
f forall a b. (a -> b) -> a -> b
$ \a -> b
ab -> With m a
x (b -> m 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 WithT where
    hasTransConstraint :: forall (m :: Type -> Type).
Applicative m =>
Dict (Applicative (WithT m))
hasTransConstraint = forall (a :: Constraint). a => Dict a
Dict

instance Monad (WithT m) where
    return :: forall a. a -> WithT m a
return = forall (f :: Type -> Type) a. Applicative f => a -> f a
pure
    MkWithT With m a
m >>= :: forall a b. WithT m a -> (a -> WithT m b) -> WithT m b
>>= a -> WithT m b
f = forall k (m :: k -> Type) a. With m a -> WithT m a
MkWithT forall a b. (a -> b) -> a -> b
$ \b -> m r
bf -> With m a
m (\a
a -> forall k (m :: k -> Type) a. WithT m a -> With m a
unWithT (a -> WithT m b
f a
a) b -> m r
bf)

instance TransConstraint Monad WithT where
    hasTransConstraint :: forall (m :: Type -> Type). Monad m => Dict (Monad (WithT m))
hasTransConstraint = forall (a :: Constraint). a => Dict a
Dict

instance MonadTrans WithT where
    lift :: forall (m :: Type -> Type) a. Monad m => m a -> WithT m a
lift m a
m = forall k (m :: k -> Type) a. With m a -> WithT m a
MkWithT 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 (WithT m) where
    liftIO :: forall a. IO a -> WithT 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 WithT where
    hasTransConstraint :: forall (m :: Type -> Type). MonadIO m => Dict (MonadIO (WithT m))
hasTransConstraint = forall (a :: Constraint). a => Dict a
Dict

instance Semigroup a => Semigroup (WithT m a) where
    <> :: WithT m a -> WithT m a -> WithT m 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 (WithT m a) where
    mempty :: WithT m a
mempty = forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty

instance MonadFix m => MonadFix (WithT m) where
    mfix :: forall a. (a -> WithT m a) -> WithT m a
mfix a -> WithT m a
ama =
        forall k (m :: k -> Type) a. With m a -> WithT m a
MkWithT forall a b. (a -> b) -> a -> b
$ \a -> m r
amr -> do
            rec
                (~(a
olda, r
r')) <-
                    forall k (m :: k -> Type) a. WithT m a -> With m a
unWithT (a -> WithT 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'

instance MonadException m => MonadException (WithT m) where
    type Exc (WithT m) = Exc m
    throwExc :: forall a. Exc (WithT m) -> WithT m a
throwExc Exc (WithT m)
e = forall k (m :: k -> Type) a. With m a -> WithT m a
MkWithT forall a b. (a -> b) -> a -> b
$ \a -> m r
_ -> forall (m :: Type -> Type) a. MonadException m => Exc m -> m a
throwExc Exc (WithT m)
e
    catchExc :: forall a. WithT m a -> (Exc (WithT m) -> WithT m a) -> WithT m a
catchExc (MkWithT With m a
afrfr) Exc (WithT m) -> WithT m a
cc = forall k (m :: k -> Type) a. With m a -> WithT m a
MkWithT forall a b. (a -> b) -> a -> b
$ \a -> m r
afr -> forall (m :: Type -> Type) a.
MonadException m =>
m a -> (Exc m -> m a) -> m a
catchExc (With m a
afrfr a -> m r
afr) forall a b. (a -> b) -> a -> b
$ \Exc m
e -> forall k (m :: k -> Type) a. WithT m a -> With m a
unWithT (Exc (WithT m) -> WithT m a
cc Exc m
e) a -> m r
afr

instance MonadThrow e m => MonadThrow e (WithT m) where
    throw :: forall a. e -> WithT m a
throw e
e = forall k (m :: k -> Type) a. With m a -> WithT m a
MkWithT forall a b. (a -> b) -> a -> b
$ \a -> m r
_ -> forall e (m :: Type -> Type) a. MonadThrow e m => e -> m a
throw e
e

instance MonadCatch e m => MonadCatch e (WithT m) where
    catch :: forall a. WithT m a -> (e -> WithT m a) -> WithT m a
catch (MkWithT With m a
afrfr) e -> WithT m a
cc = forall k (m :: k -> Type) a. With m a -> WithT m a
MkWithT forall a b. (a -> b) -> a -> b
$ \a -> m r
afr -> forall e (m :: Type -> Type) a.
MonadCatch e m =>
m a -> (e -> m a) -> m a
catch (With m a
afrfr a -> m r
afr) forall a b. (a -> b) -> a -> b
$ \e
e -> forall k (m :: k -> Type) a. WithT m a -> With m a
unWithT (e -> WithT m a
cc e
e) a -> m r
afr

unpickWithT ::
       forall m a. MonadCoroutine m
    => WithT m a
    -> m (a, m ())
unpickWithT :: forall (m :: Type -> Type) a.
MonadCoroutine m =>
WithT m a -> m (a, m ())
unpickWithT (MkWithT With m a
w) = forall (m :: Type -> Type) a.
MonadCoroutine m =>
With m a -> m (a, m ())
unpickWith With m a
w

pickWithT ::
       forall m a. Monad m
    => m (a, m ())
    -> WithT m a
pickWithT :: forall (m :: Type -> Type) a. Monad m => m (a, m ()) -> WithT m a
pickWithT m (a, m ())
mm = forall k (m :: k -> Type) a. With m a -> WithT m a
MkWithT forall a b. (a -> b) -> a -> b
$ forall (m :: Type -> Type) a. Monad m => m (a, m ()) -> With m a
pickWith m (a, m ())
mm

instance {-# OVERLAPPING #-} (MonadHoistIO m, MonadCoroutine m) => MonadHoistIO (WithT m) where
    hoistIO :: (IO --> IO) -> WithT m --> WithT m
hoistIO IO --> IO
f WithT m a
wma = forall (m :: Type -> Type) a. Monad m => m (a, m ()) -> WithT m a
pickWithT forall a b. (a -> b) -> a -> b
$ forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a -> b) -> a -> b
$ forall (m :: Type -> Type).
MonadHoistIO m =>
(IO --> IO) -> m --> m
hoistIO IO --> IO
f) forall a b. (a -> b) -> a -> b
$ forall (m :: Type -> Type).
MonadHoistIO m =>
(IO --> IO) -> m --> m
hoistIO IO --> IO
f forall a b. (a -> b) -> a -> b
$ forall (m :: Type -> Type) a.
MonadCoroutine m =>
WithT m a -> m (a, m ())
unpickWithT WithT m a
wma

mapWithT :: (m --> m) -> WithT m ()
mapWithT :: forall {k} (m :: k -> Type). (m --> m) -> WithT m ()
mapWithT m --> m
ff = forall k (m :: k -> Type) a. With m a -> WithT m a
MkWithT forall a b. (a -> b) -> a -> b
$ \() -> m r
uf -> m --> m
ff forall a b. (a -> b) -> a -> b
$ () -> m r
uf ()

postWithT :: Monad m => m () -> WithT m ()
postWithT :: forall (m :: Type -> Type). Monad m => m () -> WithT m ()
postWithT m ()
mu =
    forall {k} (m :: k -> Type). (m --> m) -> WithT m ()
mapWithT 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

withTMap :: WithT m () -> m --> m
withTMap :: forall {k} (m :: k -> Type). WithT m () -> m --> m
withTMap (MkWithT With m ()
uff) m a
f = With m ()
uff forall a b. (a -> b) -> a -> b
$ \() -> m a
f

execMapWithT :: Monad m => m (WithT m a) -> WithT m a
execMapWithT :: forall (m :: Type -> Type) a. Monad m => m (WithT m a) -> WithT m a
execMapWithT m (WithT m a)
ffa =
    forall k (m :: k -> Type) a. With m a -> WithT m a
MkWithT forall a b. (a -> b) -> a -> b
$ \a -> m r
af -> do
        MkWithT With m a
aff <- m (WithT m a)
ffa
        With m a
aff a -> m r
af

withParamRef ::
       forall m. Monad m
    => Param m --> Ref (WithT m)
withParamRef :: forall (m :: Type -> Type). Monad m => Param m --> Ref (WithT m)
withParamRef (Param m a
param :: _ a) = let
    refGet :: WithT m a
    refGet :: WithT m a
refGet =
        forall k (m :: k -> Type) a. With m a -> WithT m a
MkWithT 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 -> WithT m ()
    refPut :: a -> WithT m ()
refPut a
a = forall k (m :: k -> Type) a. With m a -> WithT m a
MkWithT 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 {WithT m a
a -> WithT m ()
refPut :: a -> WithT m ()
refGet :: WithT m a
refPut :: a -> WithT m ()
refGet :: WithT m a
..}

liftWithT ::
       forall t m. (MonadTransUnlift t, MonadTunnelIO m)
    => WithT m --> WithT (t m)
liftWithT :: forall (t :: TransKind) (m :: Type -> Type).
(MonadTransUnlift t, MonadTunnelIO m) =>
WithT m --> WithT (t m)
liftWithT (MkWithT With m a
aff) = forall k (m :: k -> Type) a. With m a -> WithT m a
MkWithT forall a b. (a -> b) -> a -> b
$ \a -> t m r
atf -> forall (t :: TransKind) (m :: Type -> Type) r.
(MonadTransUnlift t, MonadIO m) =>
(Unlift MonadTunnelIO t -> m r) -> t m r
liftWithUnlift forall a b. (a -> b) -> a -> b
$ \Unlift MonadTunnelIO t
unlift -> With m a
aff forall a b. (a -> b) -> a -> b
$ Unlift MonadTunnelIO 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