{-# LANGUAGE AllowAmbiguousTypes #-}

-- SPDX-License-Identifier: MPL-2.0

{- |
Copyright   : (c) 2016 Allele Dev; 2017 Ixperta Solutions s.r.o.; 2017 Alexis King
              (c) 2023-2025 Sayo contributors
License     :  MPL-2.0 (see the file LICENSE)
Maintainer  :  ymdfield@outlook.jp

This module provides effects for the coroutine, 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 ((>=>))
import Data.Effect.Input (Input (Input))
import Data.Effect.Output (Output (Output))

{- |
An effect for coroutines.
Realizes an operation that transfers control to the caller of the computation with coroutines along with a value of type @a@,
and receives a value of type @b@ from the caller.
-}
data Yield a b :: Effect where
    -- | Transfers control to the caller of the computation with coroutines along with a value of type @a@, and receives a value of type @b@ from the caller.
    Yield :: a -> Yield a b f b

makeEffectF ''Yield

{- |
The execution result when handling a computation that includes the t`Yield` effect. A computation that may include suspension.
If the computation does not include `yield`, the completed result of the computation is obtained as `Done`.
If the computation includes `yield`, execution is suspended at that point, and the value of type @a@ thrown by `yield` and the continuation of the computation from the point of `yield` are obtained as `Continue`.
By re-executing this continuation, you can resume the computation.
-}
data Status f a b r
    = -- | The computation has completely finished
      Done r
    | -- | The computation has been suspended by `yield`
      Continue a (b -> f (Status f a b r))
    deriving ((forall a b. (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)
-> Functor (Status f a b)
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
$cfmap :: forall (f :: * -> *) a b a b.
Functor f =>
(a -> b) -> Status f a b a -> Status f a b b
fmap :: forall a b. (a -> b) -> Status f a b a -> Status f a b b
$c<$ :: forall (f :: * -> *) a b a b.
Functor f =>
a -> Status f a b b -> Status f a b a
<$ :: forall a b. a -> Status f a b b -> Status f a b a
Functor)

-- | Extends the computation result by appending the specified continuation.
continueStatus
    :: (Monad m)
    => (x -> m (Status m a b r))
    -- ^ Additional continuation
    -> Status m a b x
    -- ^ Computation status to extend
    -> 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 = Status m a b x -> m (Status m a b r)
loop
  where
    loop :: Status m a b x -> m (Status m a b r)
loop = \case
        Done x
x -> x -> m (Status m a b r)
kk x
x
        Continue a
a b -> m (Status m a b x)
k -> Status m a b r -> m (Status m a b r)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Status m a b r -> m (Status m a b r))
-> ((b -> m (Status m a b r)) -> Status m a b r)
-> (b -> m (Status m a b r))
-> m (Status m a b r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (b -> m (Status m a b r)) -> Status m a b r
forall (f :: * -> *) a b r.
a -> (b -> f (Status f a b r)) -> Status f a b r
Continue a
a ((b -> m (Status m a b r)) -> m (Status m a b r))
-> (b -> m (Status m a b r)) -> m (Status m a b r)
forall a b. (a -> b) -> a -> b
$ b -> m (Status m a b x)
k (b -> m (Status m a b x))
-> (Status m a b x -> m (Status m a b r))
-> b
-> m (Status m a b r)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (x -> m (Status m a b r)) -> Status m a b x -> m (Status m a b r)
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
{-# INLINE continueStatus #-}

-- | Repeats the computation until the final result is obtained by continuing the computation using the specified handler each time it suspends.
loopStatus
    :: (Monad m)
    => (a -> m b)
    -- ^ Handler to resume computation from a suspended state.
    -> Status m a b r
    -- ^ A computation that may include suspension.
    -> 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 = Status m a b r -> m r
loop
  where
    loop :: Status m a b r -> m r
loop = \case
        Done r
r -> r -> m r
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure r
r
        Continue a
a b -> m (Status m a b r)
k -> a -> m b
f a
a m b -> (b -> m (Status m a b r)) -> m (Status m a b r)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> m (Status m a b r)
k m (Status m a b r) -> (Status m a b r -> m r) -> m r
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (a -> m b) -> Status m a b r -> m r
forall (m :: * -> *) a b r.
Monad m =>
(a -> m b) -> Status m a b r -> m r
loopStatus a -> m b
f
{-# INLINE loopStatus #-}

-- | Converts the t'Input' effect into the [coroutine]("Data.Effect.Coroutine")'s t'Yield' effect.
inputToYield :: Input i f a -> Yield () i f a
inputToYield :: forall i (f :: * -> *) a. Input i f a -> Yield () i f a
inputToYield Input i f a
Input = () -> Yield () i f i
forall a b (f :: * -> *). a -> Yield a b f b
Yield ()
{-# INLINE inputToYield #-}

-- | Converts the t'Output' effect into the [coroutine]("Data.Effect.Coroutine")'s t'Yield' effect.
outputToYield :: Output o f a -> Yield o () f a
outputToYield :: forall o (f :: * -> *) a. Output o f a -> Yield o () f a
outputToYield (Output o
o) = o -> Yield o () f ()
forall a b (f :: * -> *). a -> Yield a b f b
Yield o
o
{-# INLINE outputToYield #-}