{-# LANGUAGE DataKinds     #-}
{-# LANGUAGE TypeOperators #-}

{- Interpreting the 'Yield' effect as a stream -}
module Control.Monad.Freer.Extras.Stream(
    runStream
    ) where

import Control.Monad.Freer
import Control.Monad.Freer.Coroutine (Status (..), Yield, runC)
import Streaming (Stream)
import Streaming.Prelude (Of)
import Streaming.Prelude qualified as S

-- | Turn the @Yield e ()@ effect into a pull-based stream
--   of @e@ events.
runStream :: forall e a effs.
    Eff (Yield e () ': effs) a
    -> Stream (Of e) (Eff effs) a
runStream :: Eff (Yield e () : effs) a -> Stream (Of e) (Eff effs) a
runStream Eff (Yield e () : effs) a
action =
    let f :: Eff effs (Status effs e () a) -> Eff effs (Either a (e, Eff effs (Status effs e () a)))
        f :: Eff effs (Status effs e () a)
-> Eff effs (Either a (e, Eff effs (Status effs e () a)))
f Eff effs (Status effs e () a)
a = do
            Status effs e () a
result <- Eff effs (Status effs e () a)
a
            case Status effs e () a
result of
                Done a
b          -> Either a (e, Eff effs (Status effs e () a))
-> Eff effs (Either a (e, Eff effs (Status effs e () a)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Either a (e, Eff effs (Status effs e () a))
forall a b. a -> Either a b
Left a
b)
                Continue e
e () -> Eff effs (Status effs e () a)
cont -> Either a (e, Eff effs (Status effs e () a))
-> Eff effs (Either a (e, Eff effs (Status effs e () a)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either a (e, Eff effs (Status effs e () a))
 -> Eff effs (Either a (e, Eff effs (Status effs e () a))))
-> Either a (e, Eff effs (Status effs e () a))
-> Eff effs (Either a (e, Eff effs (Status effs e () a)))
forall a b. (a -> b) -> a -> b
$ (e, Eff effs (Status effs e () a))
-> Either a (e, Eff effs (Status effs e () a))
forall a b. b -> Either a b
Right (e
e, () -> Eff effs (Status effs e () a)
cont ())
    in (Eff effs (Status effs e () a)
 -> Eff effs (Either a (e, Eff effs (Status effs e () a))))
-> Eff effs (Status effs e () a) -> Stream (Of e) (Eff effs) a
forall (m :: * -> *) s r a.
Monad m =>
(s -> m (Either r (a, s))) -> s -> Stream (Of a) m r
S.unfoldr Eff effs (Status effs e () a)
-> Eff effs (Either a (e, Eff effs (Status effs e () a)))
f (Eff (Yield e () : effs) a -> Eff effs (Status effs e () a)
forall a b (effs :: [* -> *]) r.
Eff (Yield a b : effs) r -> Eff effs (Status effs a b r)
runC Eff (Yield e () : effs) a
action)