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

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

instance Monad (WithT m) where
    return :: forall a. a -> WithT m a
return = a -> WithT m a
forall a. a -> WithT m a
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 = With m b -> WithT m b
forall k (m :: k -> Type) a. With m a -> WithT m a
MkWithT (With m b -> WithT m b) -> With m b -> WithT m b
forall a b. (a -> b) -> a -> b
$ \b -> m r
bf -> (a -> m r) -> m r
With m a
m (\a
a -> WithT m b -> With m b
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 = Dict (Monad (WithT m))
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 = With m a -> WithT m a
forall k (m :: k -> Type) a. With m a -> WithT m a
MkWithT (With m a -> WithT m a) -> With m a -> WithT m a
forall a b. (a -> b) -> a -> b
$ \a -> m r
af -> m a
m m a -> (a -> m r) -> m r
forall a b. m a -> (a -> m b) -> m b
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 = m a -> WithT m a
forall (m :: Type -> Type) a. Monad m => m a -> WithT m a
forall (t :: TransKind) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> WithT m a) -> (IO a -> m a) -> IO a -> WithT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IO a -> m a
forall a. IO a -> m a
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 = Dict (MonadIO (WithT m))
forall (a :: Constraint). a => Dict a
Dict

instance Semigroup a => Semigroup (WithT m a) where
    <> :: WithT m a -> WithT m a -> WithT m a
(<>) = (a -> a -> a) -> WithT m a -> WithT m a -> WithT m a
forall a b c. (a -> b -> c) -> WithT m a -> WithT m b -> WithT m c
forall (f :: Type -> Type) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>)

instance Monoid a => Monoid (WithT m a) where
    mempty :: WithT m a
mempty = a -> WithT m a
forall a. a -> WithT m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure a
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 =
        With m a -> WithT m a
forall k (m :: k -> Type) a. With m a -> WithT m a
MkWithT (With m a -> WithT m a) -> With m a -> WithT m a
forall a b. (a -> b) -> a -> b
$ \a -> m r
amr -> do
            rec
                (~(a
olda, r
r')) <-
                    WithT m a -> With m a
forall k (m :: k -> Type) a. WithT m a -> With m a
unWithT (a -> WithT m a
ama a
olda) ((a -> m (a, r)) -> m (a, r)) -> (a -> m (a, r)) -> m (a, r)
forall a b. (a -> b) -> a -> b
$ \a
newa -> do
                        r
r <- a -> m r
amr a
newa
                        (a, r) -> m (a, r)
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (a
newa, r
r)
            r -> m r
forall a. a -> m a
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 = With m a -> WithT m a
forall k (m :: k -> Type) a. With m a -> WithT m a
MkWithT (With m a -> WithT m a) -> With m a -> WithT m a
forall a b. (a -> b) -> a -> b
$ \a -> m r
_ -> Exc m -> m r
forall a. Exc m -> m a
forall (m :: Type -> Type) a. MonadException m => Exc m -> m a
throwExc Exc m
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 = With m a -> WithT m a
forall k (m :: k -> Type) a. With m a -> WithT m a
MkWithT (With m a -> WithT m a) -> With m a -> WithT m a
forall a b. (a -> b) -> a -> b
$ \a -> m r
afr -> m r -> (Exc m -> m r) -> m r
forall a. m a -> (Exc m -> m a) -> m a
forall (m :: Type -> Type) a.
MonadException m =>
m a -> (Exc m -> m a) -> m a
catchExc ((a -> m r) -> m r
With m a
afrfr a -> m r
afr) ((Exc m -> m r) -> m r) -> (Exc m -> m r) -> m r
forall a b. (a -> b) -> a -> b
$ \Exc m
e -> WithT m a -> With m a
forall k (m :: k -> Type) a. WithT m a -> With m a
unWithT (Exc (WithT m) -> WithT m a
cc Exc m
Exc (WithT 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 = With m a -> WithT m a
forall k (m :: k -> Type) a. With m a -> WithT m a
MkWithT (With m a -> WithT m a) -> With m a -> WithT m a
forall a b. (a -> b) -> a -> b
$ \a -> m r
_ -> e -> m r
forall a. e -> m a
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 = With m a -> WithT m a
forall k (m :: k -> Type) a. With m a -> WithT m a
MkWithT (With m a -> WithT m a) -> With m a -> WithT m a
forall a b. (a -> b) -> a -> b
$ \a -> m r
afr -> m r -> (e -> m r) -> m r
forall a. m a -> (e -> m a) -> m a
forall e (m :: Type -> Type) a.
MonadCatch e m =>
m a -> (e -> m a) -> m a
catch ((a -> m r) -> m r
With m a
afrfr a -> m r
afr) ((e -> m r) -> m r) -> (e -> m r) -> m r
forall a b. (a -> b) -> a -> b
$ \e
e -> WithT m a -> With m a
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) = With m a -> m (a, m ())
forall (m :: Type -> Type) a.
MonadCoroutine m =>
With m a -> m (a, m ())
unpickWith (a -> m r) -> m r
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 = With m a -> WithT m a
forall k (m :: k -> Type) a. With m a -> WithT m a
MkWithT (With m a -> WithT m a) -> With m a -> WithT m a
forall a b. (a -> b) -> a -> b
$ m (a, m ()) -> With m a
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 = m (a, m ()) -> WithT m a
forall (m :: Type -> Type) a. Monad m => m (a, m ()) -> WithT m a
pickWithT (m (a, m ()) -> WithT m a) -> m (a, m ()) -> WithT m a
forall a b. (a -> b) -> a -> b
$ ((a, m ()) -> (a, m ())) -> m (a, m ()) -> m (a, m ())
forall a b. (a -> b) -> m a -> m b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ((m () -> m ()) -> (a, m ()) -> (a, m ())
forall a b. (a -> b) -> (a, a) -> (a, b)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ((m () -> m ()) -> (a, m ()) -> (a, m ()))
-> (m () -> m ()) -> (a, m ()) -> (a, m ())
forall a b. (a -> b) -> a -> b
$ (IO --> IO) -> m --> m
forall (m :: Type -> Type).
MonadHoistIO m =>
(IO --> IO) -> m --> m
hoistIO IO a -> IO a
IO --> IO
f) (m (a, m ()) -> m (a, m ())) -> m (a, m ()) -> m (a, m ())
forall a b. (a -> b) -> a -> b
$ (IO --> IO) -> m --> m
forall (m :: Type -> Type).
MonadHoistIO m =>
(IO --> IO) -> m --> m
hoistIO IO a -> IO a
IO --> IO
f (m (a, m ()) -> m (a, m ())) -> m (a, m ()) -> m (a, m ())
forall a b. (a -> b) -> a -> b
$ WithT m a -> m (a, m ())
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 = With m () -> WithT m ()
forall k (m :: k -> Type) a. With m a -> WithT m a
MkWithT (With m () -> WithT m ()) -> With m () -> WithT m ()
forall a b. (a -> b) -> a -> b
$ \() -> m r
uf -> m r -> m r
m --> m
ff (m r -> m r) -> m r -> m r
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 =
    (m --> m) -> WithT m ()
forall {k} (m :: k -> Type). (m --> m) -> WithT m ()
mapWithT ((m --> m) -> WithT m ()) -> (m --> m) -> WithT m ()
forall a b. (a -> b) -> a -> b
$ \m a
mr -> do
        a
r <- m a
mr
        m ()
mu
        a -> m a
forall a. a -> m a
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 = (() -> m a) -> m a
With m ()
uff ((() -> m a) -> m a) -> (() -> m a) -> m a
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 =
    With m a -> WithT m a
forall k (m :: k -> Type) a. With m a -> WithT m a
MkWithT (With m a -> WithT m a) -> With m a -> WithT m a
forall a b. (a -> b) -> a -> b
$ \a -> m r
af -> do
        MkWithT With m a
aff <- m (WithT m a)
ffa
        (a -> m r) -> m r
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 =
        With m a -> WithT m a
forall k (m :: k -> Type) a. With m a -> WithT m a
MkWithT (With m a -> WithT m a) -> With m a -> WithT m a
forall a b. (a -> b) -> a -> b
$ \a -> m r
afr -> do
            a
a <- Param m a -> m 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 = With m () -> WithT m ()
forall k (m :: k -> Type) a. With m a -> WithT m a
MkWithT (With m () -> WithT m ()) -> With m () -> WithT m ()
forall a b. (a -> b) -> a -> b
$ \() -> m r
ufr -> Param m a -> a -> m --> m
forall (m :: Type -> Type) a. Param m a -> a -> m --> m
paramWith Param m a
param a
a (m r -> m r) -> m r -> m r
forall a b. (a -> b) -> a -> b
$ () -> m r
ufr ()
    in MkRef {WithT m a
a -> WithT m ()
refGet :: WithT m a
refPut :: a -> WithT m ()
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) = With (t m) a -> WithT (t m) a
forall k (m :: k -> Type) a. With m a -> WithT m a
MkWithT (With (t m) a -> WithT (t m) a) -> With (t m) a -> WithT (t m) a
forall a b. (a -> b) -> a -> b
$ \a -> t m r
atf -> (Unlift MonadTunnelIO t -> m r) -> t m r
forall (m :: Type -> Type) r.
MonadIO m =>
(Unlift MonadTunnelIO t -> m r) -> t m r
forall (t :: TransKind) (m :: Type -> Type) r.
(MonadTransUnlift t, MonadIO m) =>
(Unlift MonadTunnelIO t -> m r) -> t m r
liftWithUnlift ((Unlift MonadTunnelIO t -> m r) -> t m r)
-> (Unlift MonadTunnelIO t -> m r) -> t m r
forall a b. (a -> b) -> a -> b
$ \Unlift MonadTunnelIO t
unlift -> (a -> m r) -> m r
With m a
aff ((a -> m r) -> m r) -> (a -> m r) -> m r
forall a b. (a -> b) -> a -> b
$ t m r -> m r
t m --> m
Unlift MonadTunnelIO t
unlift (t m r -> m r) -> (a -> t m r) -> a -> m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
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