module Control.Monad.Ology.Specific.CoroutineT where

import Control.Monad.Ology.Specific.StepT
import Import

data Turn p q a =
    MkTurn p
           (q -> a)

instance Functor (Turn p q) where
    fmap :: forall a b. (a -> b) -> Turn p q a -> Turn p q b
fmap a -> b
ab (MkTurn p
p q -> a
qa) = forall p q a. p -> (q -> a) -> Turn p q a
MkTurn p
p forall a b. (a -> b) -> a -> b
$ forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
ab q -> a
qa

type CoroutineT p q = StepT (Turn p q)

runCoroutine :: Monad m => CoroutineT p p m a -> m a
runCoroutine :: forall (m :: Type -> Type) p a.
Monad m =>
CoroutineT p p m a -> m a
runCoroutine = forall (m :: Type -> Type) (f :: Type -> Type).
Monad m =>
Extract f -> StepT f m --> m
runSteps forall a b. (a -> b) -> a -> b
$ \(MkTurn p
p p -> a
pa) -> p -> a
pa p
p

yieldCoroutine :: Monad m => p -> CoroutineT p q m q
yieldCoroutine :: forall (m :: Type -> Type) p q. Monad m => p -> CoroutineT p q m q
yieldCoroutine p
p = forall (f :: Type -> Type) (m :: Type -> Type).
(Functor f, Monad m) =>
f --> StepT f m
pendingStep forall a b. (a -> b) -> a -> b
$ forall p q a. p -> (q -> a) -> Turn p q a
MkTurn p
p forall {k} (cat :: k -> k -> Type) (a :: k).
Category cat =>
cat a a
id

joinCoroutines :: Monad m => CoroutineT q r m a -> (q -> CoroutineT p q m a) -> CoroutineT p r m a
joinCoroutines :: forall (m :: Type -> Type) q r a p.
Monad m =>
CoroutineT q r m a
-> (q -> CoroutineT p q m a) -> CoroutineT p r m a
joinCoroutines CoroutineT q r m a
cqr q -> CoroutineT p q m a
qcpq =
    forall (f :: Type -> Type) (m :: Type -> Type) a.
m (Either a (f (StepT f m a))) -> StepT f m a
MkStepT forall a b. (a -> b) -> a -> b
$ do
        Either a (Turn q r (CoroutineT q r m a))
eqra <- forall (f :: Type -> Type) (m :: Type -> Type) a.
StepT f m a -> m (Either a (f (StepT f m a)))
unStepT CoroutineT q r m a
cqr
        case Either a (Turn q r (CoroutineT q r m a))
eqra of
            Left a
a -> forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left a
a
            Right (MkTurn q
q r -> CoroutineT q r m a
rf) -> do
                Either a (Turn p q (CoroutineT p q m a))
epqa <- forall (f :: Type -> Type) (m :: Type -> Type) a.
StepT f m a -> m (Either a (f (StepT f m a)))
unStepT forall a b. (a -> b) -> a -> b
$ q -> CoroutineT p q m a
qcpq q
q
                forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(MkTurn p
p q -> CoroutineT p q m a
qa) -> forall p q a. p -> (q -> a) -> Turn p q a
MkTurn p
p forall a b. (a -> b) -> a -> b
$ \r
r -> forall (m :: Type -> Type) q r a p.
Monad m =>
CoroutineT q r m a
-> (q -> CoroutineT p q m a) -> CoroutineT p r m a
joinCoroutines (r -> CoroutineT q r m a
rf r
r) q -> CoroutineT p q m a
qa) forall a b. (a -> b) -> a -> b
$ Either a (Turn p q (CoroutineT p q m a))
epqa