module Control.Monad.Ology.Data.Prod where

import Control.Monad.Ology.General
import Control.Monad.Ology.Specific.WriterT
import Import

-- | A product of a monad (as in 'WriterT').
data Prod m a = MkProd
    { forall (m :: Type -> Type) a. Prod m a -> a -> m ()
prodTell :: a -> m ()
    , forall (m :: Type -> Type) a. Prod m a -> forall r. m r -> m (r, a)
prodListen :: forall r. m r -> m (r, a)
    }

instance Functor m => Invariant (Prod m) where
    invmap :: forall a b. (a -> b) -> (b -> a) -> Prod m a -> Prod m b
invmap a -> b
f b -> a
g (MkProd a -> m ()
t forall r. m r -> m (r, a)
l) = forall (m :: Type -> Type) a.
(a -> m ()) -> (forall r. m r -> m (r, a)) -> Prod m a
MkProd (a -> m ()
t forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. b -> a
g) (\m r
mr -> 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 a -> b
f) forall a b. (a -> b) -> a -> b
$ forall r. m r -> m (r, a)
l m r
mr)

instance Applicative m => Productable (Prod m) where
    rUnit :: Prod m ()
rUnit = forall (m :: Type -> Type) a.
(a -> m ()) -> (forall r. m r -> m (r, a)) -> Prod m a
MkProd (\() -> forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ()) forall a b. (a -> b) -> a -> b
$ forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a -> b) -> a -> b
$ \r
r -> (r
r, ())
    (<***>) :: forall a b. Prod m a -> Prod m b -> Prod m (a, b)
    MkProd a -> m ()
tellA forall r. m r -> m (r, a)
listenA <***> :: forall a b. Prod m a -> Prod m b -> Prod m (a, b)
<***> MkProd b -> m ()
tellB forall r. m r -> m (r, b)
listenB = let
        tellAB :: (a, b) -> m ()
        tellAB :: (a, b) -> m ()
tellAB (a
a, b
b) = a -> m ()
tellA a
a forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> b -> m ()
tellB b
b
        listenAB :: m r -> m (r, (a, b))
        listenAB :: forall r. m r -> m (r, (a, b))
listenAB m r
m = forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (\((r
r, a
a), b
b) -> (r
r, (a
a, b
b))) forall a b. (a -> b) -> a -> b
$ forall r. m r -> m (r, b)
listenB (forall r. m r -> m (r, a)
listenA m r
m)
        in forall (m :: Type -> Type) a.
(a -> m ()) -> (forall r. m r -> m (r, a)) -> Prod m a
MkProd (a, b) -> m ()
tellAB forall r. m r -> m (r, (a, b))
listenAB

prodListen_ :: Functor m => Prod m a -> m () -> m a
prodListen_ :: forall (m :: Type -> Type) a. Functor m => Prod m a -> m () -> m a
prodListen_ Prod m a
p m ()
mu = forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall (m :: Type -> Type) a. Prod m a -> forall r. m r -> m (r, a)
prodListen Prod m a
p m ()
mu

liftProd :: (MonadTransTunnel t, Monad m) => Prod m --> Prod (t m)
liftProd :: forall (t :: TransKind) (m :: Type -> Type).
(MonadTransTunnel t, Monad m) =>
Prod m --> Prod (t m)
liftProd (MkProd a -> m ()
t forall r. m r -> m (r, a)
l) =
    forall (m :: Type -> Type) a.
(a -> m ()) -> (forall r. m r -> m (r, a)) -> Prod m a
MkProd (\a
a -> forall (t :: TransKind) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ a -> m ()
t a
a) forall a b. (a -> b) -> a -> b
$ \t m r
tmr -> forall (t :: TransKind) (m :: Type -> Type) r.
(MonadTransTunnel t, Monad m) =>
((forall (m1 :: Type -> Type) a.
  Monad m1 =>
  t m1 a -> m1 (Tunnel t a))
 -> m (Tunnel t r))
-> t m r
tunnel forall a b. (a -> b) -> a -> b
$ \forall (m1 :: Type -> Type) a.
Monad m1 =>
t m1 a -> m1 (Tunnel t a)
unlift -> forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Tunnel t r
tun, a
a) -> forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (\r
r -> (r
r, a
a)) Tunnel t r
tun) forall a b. (a -> b) -> a -> b
$ forall r. m r -> m (r, a)
l forall a b. (a -> b) -> a -> b
$ forall (m1 :: Type -> Type) a.
Monad m1 =>
t m1 a -> m1 (Tunnel t a)
unlift t m r
tmr

writerProd :: Monad m => Prod (WriterT w m) w
writerProd :: forall (m :: Type -> Type) w. Monad m => Prod (WriterT w m) w
writerProd = MkProd {prodTell :: w -> WriterT w m ()
prodTell = forall (m :: Type -> Type) w. Monad m => w -> WriterT w m ()
tell, prodListen :: forall r. WriterT w m r -> WriterT w m (r, w)
prodListen = forall (m :: Type -> Type) w a.
Monad m =>
WriterT w m a -> WriterT w m (a, w)
listen}

foldProd ::
       forall f m a. (Applicative f, Foldable f, Applicative m)
    => Prod m a
    -> Prod m (f a)
foldProd :: forall (f :: Type -> Type) (m :: Type -> Type) a.
(Applicative f, Foldable f, Applicative m) =>
Prod m a -> Prod m (f a)
foldProd (MkProd a -> m ()
prodTell forall r. m r -> m (r, a)
prodListen) = let
    prodTell' :: f a -> m ()
    prodTell' :: f a -> m ()
prodTell' f a
aa = forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ f a
aa a -> m ()
prodTell
    prodListen' :: forall r. m r -> m (r, f a)
    prodListen' :: forall r. m r -> m (r, f a)
prodListen' m r
mr = forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(r
r, a
a) -> (r
r, forall (f :: Type -> Type) a. Applicative f => a -> f a
pure a
a)) forall a b. (a -> b) -> a -> b
$ forall r. m r -> m (r, a)
prodListen m r
mr
    in forall (m :: Type -> Type) a.
(a -> m ()) -> (forall r. m r -> m (r, a)) -> Prod m a
MkProd f a -> m ()
prodTell' forall r. m r -> m (r, f a)
prodListen'