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) = p -> (q -> b) -> Turn p q b
forall p q a. p -> (q -> a) -> Turn p q a
MkTurn p
p ((q -> b) -> Turn p q b) -> (q -> b) -> Turn p q b
forall a b. (a -> b) -> a -> b
$ (a -> b) -> (q -> a) -> q -> b
forall a b. (a -> b) -> (q -> a) -> q -> 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 = Extract (Turn p p) -> StepT (Turn p p) m --> m
forall (m :: Type -> Type) (f :: Type -> Type).
Monad m =>
Extract f -> StepT f m --> m
runSteps (Extract (Turn p p) -> StepT (Turn p p) m --> m)
-> Extract (Turn p p) -> StepT (Turn p p) m --> m
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 = Turn p q q -> StepT (Turn p q) m q
Turn p q --> StepT (Turn p q) m
forall (f :: Type -> Type) (m :: Type -> Type).
(Functor f, Monad m) =>
f --> StepT f m
pendingStep (Turn p q q -> StepT (Turn p q) m q)
-> Turn p q q -> StepT (Turn p q) m q
forall a b. (a -> b) -> a -> b
$ p -> (q -> q) -> Turn p q q
forall p q a. p -> (q -> a) -> Turn p q a
MkTurn p
p q -> q
forall a. a -> a
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 =
    m (Either a (Turn p r (StepT (Turn p r) m a)))
-> StepT (Turn p r) m a
forall (f :: Type -> Type) (m :: Type -> Type) a.
m (Either a (f (StepT f m a))) -> StepT f m a
MkStepT (m (Either a (Turn p r (StepT (Turn p r) m a)))
 -> StepT (Turn p r) m a)
-> m (Either a (Turn p r (StepT (Turn p r) m a)))
-> StepT (Turn p r) m a
forall a b. (a -> b) -> a -> b
$ do
        Either a (Turn q r (CoroutineT q r m a))
eqra <- CoroutineT q r m a -> m (Either a (Turn q r (CoroutineT q r m a)))
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 -> Either a (Turn p r (StepT (Turn p r) m a))
-> m (Either a (Turn p r (StepT (Turn p r) m a)))
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Either a (Turn p r (StepT (Turn p r) m a))
 -> m (Either a (Turn p r (StepT (Turn p r) m a))))
-> Either a (Turn p r (StepT (Turn p r) m a))
-> m (Either a (Turn p r (StepT (Turn p r) m a)))
forall a b. (a -> b) -> a -> b
$ a -> Either a (Turn p r (StepT (Turn p r) m a))
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 <- CoroutineT p q m a -> m (Either a (Turn p q (CoroutineT p q m a)))
forall (f :: Type -> Type) (m :: Type -> Type) a.
StepT f m a -> m (Either a (f (StepT f m a)))
unStepT (CoroutineT p q m a
 -> m (Either a (Turn p q (CoroutineT p q m a))))
-> CoroutineT p q m a
-> m (Either a (Turn p q (CoroutineT p q m a)))
forall a b. (a -> b) -> a -> b
$ q -> CoroutineT p q m a
qcpq q
q
                Either a (Turn p r (StepT (Turn p r) m a))
-> m (Either a (Turn p r (StepT (Turn p r) m a)))
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Either a (Turn p r (StepT (Turn p r) m a))
 -> m (Either a (Turn p r (StepT (Turn p r) m a))))
-> Either a (Turn p r (StepT (Turn p r) m a))
-> m (Either a (Turn p r (StepT (Turn p r) m a)))
forall a b. (a -> b) -> a -> b
$ (Turn p q (CoroutineT p q m a) -> Turn p r (StepT (Turn p r) m a))
-> Either a (Turn p q (CoroutineT p q m a))
-> Either a (Turn p r (StepT (Turn p r) m a))
forall a b. (a -> b) -> Either a a -> Either 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) -> p -> (r -> StepT (Turn p r) m a) -> Turn p r (StepT (Turn p r) m a)
forall p q a. p -> (q -> a) -> Turn p q a
MkTurn p
p ((r -> StepT (Turn p r) m a) -> Turn p r (StepT (Turn p r) m a))
-> (r -> StepT (Turn p r) m a) -> Turn p r (StepT (Turn p r) m a)
forall a b. (a -> b) -> a -> b
$ \r
r -> CoroutineT q r m a
-> (q -> CoroutineT p q m a) -> StepT (Turn p r) m a
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) (Either a (Turn p q (CoroutineT p q m a))
 -> Either a (Turn p r (StepT (Turn p r) m a)))
-> Either a (Turn p q (CoroutineT p q m a))
-> Either a (Turn p r (StepT (Turn p r) m a))
forall a b. (a -> b) -> a -> b
$ Either a (Turn p q (CoroutineT p q m a))
epqa