module Control.Monad.Freer.Coroutine
(
Yield(..)
, yield
, Status(..)
, runC
, interposeC
, replyC
) where
import Control.Monad.Freer.Internal (Eff, Member, handleRelay, interpose, send)
data Yield a b c = Yield a (b -> c)
deriving (a -> Yield a b b -> Yield a b a
(a -> b) -> Yield a b a -> Yield a b b
(forall a b. (a -> b) -> Yield a b a -> Yield a b b)
-> (forall a b. a -> Yield a b b -> Yield a b a)
-> Functor (Yield a b)
forall a b. a -> Yield a b b -> Yield a b a
forall a b. (a -> b) -> Yield a b a -> Yield a b b
forall a b a b. a -> Yield a b b -> Yield a b a
forall a b a b. (a -> b) -> Yield a b a -> Yield a b b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Yield a b b -> Yield a b a
$c<$ :: forall a b a b. a -> Yield a b b -> Yield a b a
fmap :: (a -> b) -> Yield a b a -> Yield a b b
$cfmap :: forall a b a b. (a -> b) -> Yield a b a -> Yield a b b
Functor)
yield :: Member (Yield a b) effs => a -> (b -> c) -> Eff effs c
yield :: a -> (b -> c) -> Eff effs c
yield a
x b -> c
f = Yield a b c -> Eff effs c
forall (eff :: * -> *) (effs :: [* -> *]) a.
Member eff effs =>
eff a -> Eff effs a
send (a -> (b -> c) -> Yield a b c
forall a b c. a -> (b -> c) -> Yield a b c
Yield a
x b -> c
f)
data Status effs a b r
= Done r
| Continue a (b -> Eff effs (Status effs a b r))
replyC
:: Yield a b c
-> (c -> Eff effs (Status effs a b r))
-> Eff effs (Status effs a b r)
replyC :: Yield a b c
-> (c -> Eff effs (Status effs a b r))
-> Eff effs (Status effs a b r)
replyC (Yield a
a b -> c
k) c -> Eff effs (Status effs a b r)
arr = Status effs a b r -> Eff effs (Status effs a b r)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Status effs a b r -> Eff effs (Status effs a b r))
-> Status effs a b r -> Eff effs (Status effs a b r)
forall a b. (a -> b) -> a -> b
$ a -> (b -> Eff effs (Status effs a b r)) -> Status effs a b r
forall (effs :: [* -> *]) a b r.
a -> (b -> Eff effs (Status effs a b r)) -> Status effs a b r
Continue a
a (c -> Eff effs (Status effs a b r)
arr (c -> Eff effs (Status effs a b r))
-> (b -> c) -> b -> Eff effs (Status effs a b r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> c
k)
runC :: Eff (Yield a b ': effs) r -> Eff effs (Status effs a b r)
runC :: Eff (Yield a b : effs) r -> Eff effs (Status effs a b r)
runC = (r -> Eff effs (Status effs a b r))
-> (forall v.
Yield a b v
-> Arr effs v (Status effs a b r) -> Eff effs (Status effs a b r))
-> Eff (Yield a b : effs) r
-> Eff effs (Status effs a b r)
forall a (effs :: [* -> *]) b (eff :: * -> *).
(a -> Eff effs b)
-> (forall v. eff v -> Arr effs v b -> Eff effs b)
-> Eff (eff : effs) a
-> Eff effs b
handleRelay (Status effs a b r -> Eff effs (Status effs a b r)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Status effs a b r -> Eff effs (Status effs a b r))
-> (r -> Status effs a b r) -> r -> Eff effs (Status effs a b r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> Status effs a b r
forall (effs :: [* -> *]) a b r. r -> Status effs a b r
Done) forall v.
Yield a b v
-> Arr effs v (Status effs a b r) -> Eff effs (Status effs a b r)
forall a b c (effs :: [* -> *]) r.
Yield a b c
-> (c -> Eff effs (Status effs a b r))
-> Eff effs (Status effs a b r)
replyC
interposeC
:: Member (Yield a b) effs
=> Eff effs r
-> Eff effs (Status effs a b r)
interposeC :: Eff effs r -> Eff effs (Status effs a b r)
interposeC = (r -> Eff effs (Status effs a b r))
-> (forall v.
Yield a b v
-> Arr effs v (Status effs a b r) -> Eff effs (Status effs a b r))
-> Eff effs r
-> Eff effs (Status effs a b r)
forall (eff :: * -> *) (effs :: [* -> *]) a b.
Member eff effs =>
(a -> Eff effs b)
-> (forall v. eff v -> Arr effs v b -> Eff effs b)
-> Eff effs a
-> Eff effs b
interpose (Status effs a b r -> Eff effs (Status effs a b r)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Status effs a b r -> Eff effs (Status effs a b r))
-> (r -> Status effs a b r) -> r -> Eff effs (Status effs a b r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> Status effs a b r
forall (effs :: [* -> *]) a b r. r -> Status effs a b r
Done) forall v.
Yield a b v
-> Arr effs v (Status effs a b r) -> Eff effs (Status effs a b r)
forall a b c (effs :: [* -> *]) r.
Yield a b c
-> (c -> Eff effs (Status effs a b r))
-> Eff effs (Status effs a b r)
replyC