{-# LANGUAGE AllowAmbiguousTypes #-}

-- This Source Code Form is subject to the terms of the Mozilla Public
-- License, v. 2.0. If a copy of the MPL was not distributed with this
-- file, You can obtain one at https://mozilla.org/MPL/2.0/.

{- |
Copyright   : (c) 2016 Allele Dev; 2017 Ixperta Solutions s.r.o.; 2017 Alexis King
              (c) 2023-2024 Yamada Ryo
License     :  MPL-2.0 (see the file LICENSE)
Maintainer  :  ymdfield@outlook.jp
Stability   :  experimental
Portability :  portable

This module provides the t`Coroutine` effect, comes
from [@Control.Monad.Freer.Coroutine@](https://hackage.haskell.org/package/freer-simple-1.2.1.2/docs/Control-Monad-Freer-Coroutine.html)
in the @freer-simple@ package (The continuation part @(b -> c)@ has been removed. If necessary, please manually compose the t`Data.Functor.Coyoneda.Coyoneda`) .
-}
module Data.Effect.Coroutine where

import Control.Monad ((>=>))

data Yield a b (c :: Type) where
    Yield :: a -> Yield a b b

makeEffectF [''Yield]

yield_ :: Yield a () <: f => a -> f ()
yield_ :: forall a (f :: * -> *). (Yield a () <: f) => a -> f ()
yield_ = forall a b (f :: * -> *). SendIns (Yield a b) f => a -> f b
yield
{-# INLINE yield_ #-}

data Status f a b r
    = Done r
    | Coroutine a (b -> f (Status f a b r))
    deriving (forall a b. a -> Status f a b b -> Status f a b a
forall a b. (a -> b) -> Status f a b a -> Status f a b b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (f :: * -> *) a b a b.
Functor f =>
a -> Status f a b b -> Status f a b a
forall (f :: * -> *) a b a b.
Functor f =>
(a -> b) -> Status f a b a -> Status f a b b
<$ :: forall a b. a -> Status f a b b -> Status f a b a
$c<$ :: forall (f :: * -> *) a b a b.
Functor f =>
a -> Status f a b b -> Status f a b a
fmap :: forall a b. (a -> b) -> Status f a b a -> Status f a b b
$cfmap :: forall (f :: * -> *) a b a b.
Functor f =>
(a -> b) -> Status f a b a -> Status f a b b
Functor)

continueStatus :: Monad m => (x -> m (Status m a b r)) -> Status m a b x -> m (Status m a b r)
continueStatus :: forall (m :: * -> *) x a b r.
Monad m =>
(x -> m (Status m a b r)) -> Status m a b x -> m (Status m a b r)
continueStatus x -> m (Status m a b r)
kk = \case
    Done x
x -> x -> m (Status m a b r)
kk x
x
    Coroutine a
a b -> m (Status m a b x)
k -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b r.
a -> (b -> f (Status f a b r)) -> Status f a b r
Coroutine a
a forall a b. (a -> b) -> a -> b
$ b -> m (Status m a b x)
k forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) x a b r.
Monad m =>
(x -> m (Status m a b r)) -> Status m a b x -> m (Status m a b r)
continueStatus x -> m (Status m a b r)
kk

loopStatus :: Monad m => (a -> m b) -> Status m a b r -> m r
loopStatus :: forall (m :: * -> *) a b r.
Monad m =>
(a -> m b) -> Status m a b r -> m r
loopStatus a -> m b
f = \case
    Done r
r -> forall (f :: * -> *) a. Applicative f => a -> f a
pure r
r
    Coroutine a
a b -> m (Status m a b r)
k -> a -> m b
f a
a forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> m (Status m a b r)
k forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a b r.
Monad m =>
(a -> m b) -> Status m a b r -> m r
loopStatus a -> m b
f