# LANGUAGE DataKinds #
# LANGUAGE DeriveFunctor #
# LANGUAGE FlexibleContexts #
# LANGUAGE NoImplicitPrelude #
# LANGUAGE TypeOperators #
-- |
  Module :        Control .  . Freer . Coroutine
-- Description:  Composable coroutine effects layer.
  Copyright :     ( c ) 2016 Allele Dev ; 2017 Ixperta Solutions s.r.o .
-- License:      BSD3
-- Maintainer:   
-- Stability:    experimental
  Portability :   GHC specific language extensions .
--
-- An effect to compose functions with the ability to yield.
--
-- Using <> as a starting point.
module Control.Monad.Freer.Coroutine
    (
    -- * Yield Control
      Yield(..)
    , yield

    -- * Handle Yield Effect
    , Status(..)
    , runC
    , interposeC
    , replyC
    )
  where

import Control.Applicative (pure)
import Data.Function (($), (.))
import Data.Functor (Functor)

import Control.Monad.Freer.Internal (Eff, Member, handleRelay, interpose, send)


-- | A type representing a yielding of control.
--
-- Type variables have following meaning:
--
-- [@a@]
--   The current type.
--
-- [@b@]
--   The input to the continuation function.
--
-- [@c@]
--   The output of the continuation.
data Yield a b c = Yield a (b -> c)
  deriving (Functor)

  | Lifts a value and a function into the Coroutine effect .
yield :: Member (Yield a b) effs => a -> (b -> c) -> Eff effs c
yield x f = send (Yield x f)

-- | Represents status of a coroutine.
data Status effs a b r
    = Done r
  ^ Coroutine is done with a result value of type @r@.
    | Continue a (b -> Eff effs (Status effs a b r))
    -- ^ Reporting a value of the type @a@, and resuming with the value of type
  @b@ , possibly ending with a value of type @x@.

  | Reply to a coroutine effect by returning the Continue constructor .
replyC
  :: Yield a b c
  -> (c -> Eff effs (Status effs a b r))
  -> Eff effs (Status effs a b r)
replyC (Yield a k) arr = pure $ Continue a (arr . k)

-- | Launch a coroutine and report its status.
runC :: Eff (Yield a b ': effs) r -> Eff effs (Status effs a b r)
runC = handleRelay (pure . Done) replyC

-- | Launch a coroutine and report its status, without handling (removing)
-- 'Yield' from the typelist. This is useful for reducing nested coroutines.
interposeC
    :: Member (Yield a b) effs
    => Eff effs r
    -> Eff effs (Status effs a b r)
interposeC = interpose (pure . Done) replyC

 |
 Description:  Composable coroutine effects layer.
 License:      BSD3
 Maintainer:   
 Stability:    experimental

 An effect to compose functions with the ability to yield.

 Using <> as a starting point.
 * Yield Control
 * Handle Yield Effect
 | A type representing a yielding of control.

 Type variables have following meaning:

 [@a@]
   The current type.

 [@b@]
   The input to the continuation function.

 [@c@]
   The output of the continuation.
 | Represents status of a coroutine.
 ^ Reporting a value of the type @a@, and resuming with the value of type
 | Launch a coroutine and report its status.
 | Launch a coroutine and report its status, without handling (removing)
 'Yield' from the typelist. This is useful for reducing nested coroutines.
# LANGUAGE DataKinds #
# LANGUAGE DeriveFunctor #
# LANGUAGE FlexibleContexts #
# LANGUAGE NoImplicitPrelude #
# LANGUAGE TypeOperators #
  Module :        Control .  . Freer . Coroutine
  Copyright :     ( c ) 2016 Allele Dev ; 2017 Ixperta Solutions s.r.o .
  Portability :   GHC specific language extensions .
module Control.Monad.Freer.Coroutine
    (
      Yield(..)
    , yield

    , Status(..)
    , runC
    , interposeC
    , replyC
    )
  where

import Control.Applicative (pure)
import Data.Function (($), (.))
import Data.Functor (Functor)

import Control.Monad.Freer.Internal (Eff, Member, handleRelay, interpose, send)


data Yield a b c = Yield a (b -> c)
  deriving (Functor)

  | Lifts a value and a function into the Coroutine effect .
yield :: Member (Yield a b) effs => a -> (b -> c) -> Eff effs c
yield x f = send (Yield x f)

data Status effs a b r
    = Done r
  ^ Coroutine is done with a result value of type @r@.
    | Continue a (b -> Eff effs (Status effs a b r))
  @b@ , possibly ending with a value of type @x@.

  | Reply to a coroutine effect by returning the Continue constructor .
replyC
  :: Yield a b c
  -> (c -> Eff effs (Status effs a b r))
  -> Eff effs (Status effs a b r)
replyC (Yield a k) arr = pure $ Continue a (arr . k)

runC :: Eff (Yield a b ': effs) r -> Eff effs (Status effs a b r)
runC = handleRelay (pure . Done) replyC

interposeC
    :: Member (Yield a b) effs
    => Eff effs r
    -> Eff effs (Status effs a b r)
interposeC = interpose (pure . Done) replyC
