{- 
    Copyright 2009-2014 Mario Blazevic

    This file is part of the Streaming Component Combinators (SCC) project.

    The SCC project is free software: you can redistribute it and/or modify it under the terms of the GNU General Public
    License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later
    version.

    SCC is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty
    of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more details.

    You should have received a copy of the GNU General Public License along with SCC.  If not, see
    <http://www.gnu.org/licenses/>.
-}

-- | This module defines the 'Coroutine' monad transformer.
-- 
-- A 'Coroutine' monadic computation can 'suspend' its execution at any time, returning control to its invoker. The
-- returned suspension value contains the coroutine's resumption wrapped in a 'Functor'. Here is an example of a
-- coroutine in the 'IO' monad that suspends computation using the functor 'Yield' from the
-- "Control.Monad.Coroutine.SuspensionFunctors" module:
-- 
-- @
-- producer :: Coroutine (Yield Int) IO String
-- producer = do yield 1
--               lift (putStrLn \"Produced one, next is four.\")
--               yield 4
--               return \"Finished\"
-- @
-- 
-- To continue the execution of a suspended 'Coroutine', extract it from the suspension functor and apply its 'resume'
-- method. The easiest way to run a coroutine to completion is by using the 'pogoStick' function, which keeps resuming
-- the coroutine in trampolined style until it completes. Here is one way to apply 'pogoStick' to the /producer/ example
-- above:
-- 
-- @
-- printProduce :: Show x => Coroutine (Yield x) IO r -> IO r
-- printProduce producer = pogoStick (\\(Yield x cont) -> lift (print x) >> cont) producer
-- @
-- 
-- Multiple concurrent coroutines can be run as well, and this module provides two different ways. To run two
-- interleaved computations, use a 'WeaveStepper' to 'weave' together steps of two different coroutines into a single
-- coroutine, which can then be executed by 'pogoStick'.
-- 
-- For various uses of trampoline-style coroutines, see
-- 
-- > Coroutine Pipelines - Mario Blažević, The Monad.Reader issue 19, pages 29-50
-- 
-- > Trampolined Style - Ganz, S. E. Friedman, D. P. Wand, M, ACM SIGPLAN NOTICES, 1999, VOL 34; NUMBER 9, pages 18-27
-- 
-- and
-- 
-- > The Essence of Multitasking - William L. Harrison, Proceedings of the 11th International Conference on Algebraic
-- > Methodology and Software Technology, volume 4019 of Lecture Notes in Computer Science, 2006

{-# LANGUAGE ScopedTypeVariables, Rank2Types, EmptyDataDecls #-}

module Control.Monad.Coroutine
   (
    -- * Coroutine definition
    Coroutine(Coroutine, resume), CoroutineStepResult, suspend,
    -- * Coroutine operations
    mapMonad, mapSuspension, mapFirstSuspension,
    -- * Running coroutines
    Naught, runCoroutine, bounce, pogoStick, pogoStickM, foldRun,
    -- * Weaving coroutines together
    PairBinder, sequentialBinder, parallelBinder, liftBinder,
    Weaver, WeaveStepper, weave, merge
   )
where

import Control.Applicative (Applicative(..))
import Control.Monad (ap, liftM, (<=<))
import Control.Monad.Fail (MonadFail(fail))
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Trans.Class (MonadTrans(..))
import Data.Either (partitionEithers)

import Control.Monad.Parallel (MonadParallel(..))

import Prelude hiding (fail)

-- | Suspending, resumable monadic computations.
newtype Coroutine s m r = Coroutine {
   -- | Run the next step of a `Coroutine` computation. The result of the step execution will be either a suspension or
   -- the final coroutine result.
   Coroutine s m r -> m (Either (s (Coroutine s m r)) r)
resume :: m (Either (s (Coroutine s m r)) r)
   }

type CoroutineStepResult s m r = Either (s (Coroutine s m r)) r

instance (Functor s, Functor m) => Functor (Coroutine s m) where
   fmap :: (a -> b) -> Coroutine s m a -> Coroutine s m b
fmap a -> b
f Coroutine s m a
t = m (Either (s (Coroutine s m b)) b) -> Coroutine s m b
forall (s :: * -> *) (m :: * -> *) r.
m (Either (s (Coroutine s m r)) r) -> Coroutine s m r
Coroutine ((Either (s (Coroutine s m a)) a -> Either (s (Coroutine s m b)) b)
-> m (Either (s (Coroutine s m a)) a)
-> m (Either (s (Coroutine s m b)) b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b)
-> Either (s (Coroutine s m a)) a -> Either (s (Coroutine s m b)) b
forall (f :: * -> *) (f :: * -> *) t b.
(Functor f, Functor f) =>
(t -> b) -> Either (f (f t)) t -> Either (f (f b)) b
apply a -> b
f) (Coroutine s m a -> m (Either (s (Coroutine s m a)) a)
forall (s :: * -> *) (m :: * -> *) r.
Coroutine s m r -> m (Either (s (Coroutine s m r)) r)
resume Coroutine s m a
t))
      where apply :: (t -> b) -> Either (f (f t)) t -> Either (f (f b)) b
apply t -> b
fc (Right t
x) = b -> Either (f (f b)) b
forall a b. b -> Either a b
Right (t -> b
fc t
x)
            apply t -> b
fc (Left f (f t)
s) = f (f b) -> Either (f (f b)) b
forall a b. a -> Either a b
Left ((f t -> f b) -> f (f t) -> f (f b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((t -> b) -> f t -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap t -> b
fc) f (f t)
s)

instance (Functor s, Functor m, Monad m) => Applicative (Coroutine s m) where
   pure :: a -> Coroutine s m a
pure a
x = m (Either (s (Coroutine s m a)) a) -> Coroutine s m a
forall (s :: * -> *) (m :: * -> *) r.
m (Either (s (Coroutine s m r)) r) -> Coroutine s m r
Coroutine (Either (s (Coroutine s m a)) a
-> m (Either (s (Coroutine s m a)) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Either (s (Coroutine s m a)) a
forall a b. b -> Either a b
Right a
x))
   <*> :: Coroutine s m (a -> b) -> Coroutine s m a -> Coroutine s m b
(<*>) = Coroutine s m (a -> b) -> Coroutine s m a -> Coroutine s m b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance (Functor s, Monad m) => Monad (Coroutine s m) where
   return :: a -> Coroutine s m a
return = a -> Coroutine s m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
   Coroutine s m a
t >>= :: Coroutine s m a -> (a -> Coroutine s m b) -> Coroutine s m b
>>= a -> Coroutine s m b
f = m (Either (s (Coroutine s m b)) b) -> Coroutine s m b
forall (s :: * -> *) (m :: * -> *) r.
m (Either (s (Coroutine s m r)) r) -> Coroutine s m r
Coroutine (Coroutine s m a -> m (Either (s (Coroutine s m a)) a)
forall (s :: * -> *) (m :: * -> *) r.
Coroutine s m r -> m (Either (s (Coroutine s m r)) r)
resume Coroutine s m a
t m (Either (s (Coroutine s m a)) a)
-> (Either (s (Coroutine s m a)) a
    -> m (Either (s (Coroutine s m b)) b))
-> m (Either (s (Coroutine s m b)) b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (a -> Coroutine s m b)
-> Either (s (Coroutine s m a)) a
-> m (Either (s (Coroutine s m b)) b)
forall (m :: * -> *) (s :: * -> *) t b.
(Monad m, Functor s) =>
(t -> Coroutine s m b)
-> Either (s (Coroutine s m t)) t
-> m (Either (s (Coroutine s m b)) b)
apply a -> Coroutine s m b
f)
      where apply :: (t -> Coroutine s m b)
-> Either (s (Coroutine s m t)) t
-> m (Either (s (Coroutine s m b)) b)
apply t -> Coroutine s m b
fc (Right t
x) = Coroutine s m b -> m (Either (s (Coroutine s m b)) b)
forall (s :: * -> *) (m :: * -> *) r.
Coroutine s m r -> m (Either (s (Coroutine s m r)) r)
resume (t -> Coroutine s m b
fc t
x)
            apply t -> Coroutine s m b
fc (Left s (Coroutine s m t)
s) = Either (s (Coroutine s m b)) b
-> m (Either (s (Coroutine s m b)) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (s (Coroutine s m b) -> Either (s (Coroutine s m b)) b
forall a b. a -> Either a b
Left ((Coroutine s m t -> Coroutine s m b)
-> s (Coroutine s m t) -> s (Coroutine s m b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Coroutine s m t -> (t -> Coroutine s m b) -> Coroutine s m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= t -> Coroutine s m b
fc) s (Coroutine s m t)
s))
   Coroutine s m a
t >> :: Coroutine s m a -> Coroutine s m b -> Coroutine s m b
>> Coroutine s m b
f = m (Either (s (Coroutine s m b)) b) -> Coroutine s m b
forall (s :: * -> *) (m :: * -> *) r.
m (Either (s (Coroutine s m r)) r) -> Coroutine s m r
Coroutine (Coroutine s m a -> m (Either (s (Coroutine s m a)) a)
forall (s :: * -> *) (m :: * -> *) r.
Coroutine s m r -> m (Either (s (Coroutine s m r)) r)
resume Coroutine s m a
t m (Either (s (Coroutine s m a)) a)
-> (Either (s (Coroutine s m a)) a
    -> m (Either (s (Coroutine s m b)) b))
-> m (Either (s (Coroutine s m b)) b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Coroutine s m b
-> Either (s (Coroutine s m a)) a
-> m (Either (s (Coroutine s m b)) b)
forall (m :: * -> *) (s :: * -> *) b a b.
(Monad m, Functor s) =>
Coroutine s m b
-> Either (s (Coroutine s m a)) b
-> m (Either (s (Coroutine s m b)) b)
apply Coroutine s m b
f)
      where apply :: Coroutine s m b
-> Either (s (Coroutine s m a)) b
-> m (Either (s (Coroutine s m b)) b)
apply Coroutine s m b
fc (Right b
_) = Coroutine s m b -> m (Either (s (Coroutine s m b)) b)
forall (s :: * -> *) (m :: * -> *) r.
Coroutine s m r -> m (Either (s (Coroutine s m r)) r)
resume Coroutine s m b
fc
            apply Coroutine s m b
fc (Left s (Coroutine s m a)
s) = Either (s (Coroutine s m b)) b
-> m (Either (s (Coroutine s m b)) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (s (Coroutine s m b) -> Either (s (Coroutine s m b)) b
forall a b. a -> Either a b
Left ((Coroutine s m a -> Coroutine s m b)
-> s (Coroutine s m a) -> s (Coroutine s m b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Coroutine s m a -> Coroutine s m b -> Coroutine s m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Coroutine s m b
fc) s (Coroutine s m a)
s))

instance (Functor s, MonadFail m) => MonadFail (Coroutine s m) where
   fail :: String -> Coroutine s m a
fail String
msg = m (Either (s (Coroutine s m a)) a) -> Coroutine s m a
forall (s :: * -> *) (m :: * -> *) r.
m (Either (s (Coroutine s m r)) r) -> Coroutine s m r
Coroutine (a -> Either (s (Coroutine s m a)) a
forall a b. b -> Either a b
Right (a -> Either (s (Coroutine s m a)) a)
-> m a -> m (Either (s (Coroutine s m a)) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
msg)

instance (Functor s, MonadParallel m) => MonadParallel (Coroutine s m) where
   bindM2 :: (a -> b -> Coroutine s m c)
-> Coroutine s m a -> Coroutine s m b -> Coroutine s m c
bindM2 = PairBinder m
-> forall a b c.
   (a -> b -> Coroutine s m c)
   -> Coroutine s m a -> Coroutine s m b -> Coroutine s m c
forall (s :: * -> *) (m :: * -> *).
(Functor s, Monad m) =>
PairBinder m -> PairBinder (Coroutine s m)
liftBinder PairBinder m
forall (m :: * -> *) a b c.
MonadParallel m =>
(a -> b -> m c) -> m a -> m b -> m c
bindM2

instance Functor s => MonadTrans (Coroutine s) where
   lift :: m a -> Coroutine s m a
lift = m (Either (s (Coroutine s m a)) a) -> Coroutine s m a
forall (s :: * -> *) (m :: * -> *) r.
m (Either (s (Coroutine s m r)) r) -> Coroutine s m r
Coroutine (m (Either (s (Coroutine s m a)) a) -> Coroutine s m a)
-> (m a -> m (Either (s (Coroutine s m a)) a))
-> m a
-> Coroutine s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Either (s (Coroutine s m a)) a)
-> m a -> m (Either (s (Coroutine s m a)) a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> Either (s (Coroutine s m a)) a
forall a b. b -> Either a b
Right

instance (Functor s, MonadIO m) => MonadIO (Coroutine s m) where
   liftIO :: IO a -> Coroutine s m a
liftIO = m a -> Coroutine s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> Coroutine s m a)
-> (IO a -> m a) -> IO a -> Coroutine s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

-- | The 'Naught' functor instance doesn't contain anything and cannot be constructed. Used for building non-suspendable
-- coroutines.
data Naught x
instance Functor Naught where
   fmap :: (a -> b) -> Naught a -> Naught b
fmap a -> b
_ Naught a
_ = Naught b
forall a. HasCallStack => a
undefined

-- | Suspend the current 'Coroutine'.
suspend :: (Monad m, Functor s) => s (Coroutine s m x) -> Coroutine s m x
suspend :: s (Coroutine s m x) -> Coroutine s m x
suspend s (Coroutine s m x)
s = m (Either (s (Coroutine s m x)) x) -> Coroutine s m x
forall (s :: * -> *) (m :: * -> *) r.
m (Either (s (Coroutine s m r)) r) -> Coroutine s m r
Coroutine (Either (s (Coroutine s m x)) x
-> m (Either (s (Coroutine s m x)) x)
forall (m :: * -> *) a. Monad m => a -> m a
return (s (Coroutine s m x) -> Either (s (Coroutine s m x)) x
forall a b. a -> Either a b
Left s (Coroutine s m x)
s))
{-# INLINE suspend #-}

-- | Change the base monad of a 'Coroutine'.
mapMonad :: forall s m m' x. (Functor s, Monad m, Monad m') =>
            (forall y. m y -> m' y) -> Coroutine s m x -> Coroutine s m' x
mapMonad :: (forall y. m y -> m' y) -> Coroutine s m x -> Coroutine s m' x
mapMonad forall y. m y -> m' y
f Coroutine s m x
cort = Coroutine :: forall (s :: * -> *) (m :: * -> *) r.
m (Either (s (Coroutine s m r)) r) -> Coroutine s m r
Coroutine {resume :: m' (Either (s (Coroutine s m' x)) x)
resume= (Either (s (Coroutine s m x)) x -> Either (s (Coroutine s m' x)) x)
-> m' (Either (s (Coroutine s m x)) x)
-> m' (Either (s (Coroutine s m' x)) x)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Either (s (Coroutine s m x)) x -> Either (s (Coroutine s m' x)) x
forall (f :: * -> *) (s :: * -> *) x b.
(Functor f, Functor s) =>
Either (f (Coroutine s m x)) b -> Either (f (Coroutine s m' x)) b
map' (m (Either (s (Coroutine s m x)) x)
-> m' (Either (s (Coroutine s m x)) x)
forall y. m y -> m' y
f (m (Either (s (Coroutine s m x)) x)
 -> m' (Either (s (Coroutine s m x)) x))
-> m (Either (s (Coroutine s m x)) x)
-> m' (Either (s (Coroutine s m x)) x)
forall a b. (a -> b) -> a -> b
$ Coroutine s m x -> m (Either (s (Coroutine s m x)) x)
forall (s :: * -> *) (m :: * -> *) r.
Coroutine s m r -> m (Either (s (Coroutine s m r)) r)
resume Coroutine s m x
cort)}
   where map' :: Either (f (Coroutine s m x)) b -> Either (f (Coroutine s m' x)) b
map' (Right b
r) = b -> Either (f (Coroutine s m' x)) b
forall a b. b -> Either a b
Right b
r
         map' (Left f (Coroutine s m x)
s) = f (Coroutine s m' x) -> Either (f (Coroutine s m' x)) b
forall a b. a -> Either a b
Left ((Coroutine s m x -> Coroutine s m' x)
-> f (Coroutine s m x) -> f (Coroutine s m' x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((forall y. m y -> m' y) -> Coroutine s m x -> Coroutine s m' x
forall (s :: * -> *) (m :: * -> *) (m' :: * -> *) x.
(Functor s, Monad m, Monad m') =>
(forall y. m y -> m' y) -> Coroutine s m x -> Coroutine s m' x
mapMonad forall y. m y -> m' y
f) f (Coroutine s m x)
s)

-- | Change the suspension functor of a 'Coroutine'.
mapSuspension :: (Functor s, Monad m) => (forall y. s y -> s' y) -> Coroutine s m x -> Coroutine s' m x
mapSuspension :: (forall y. s y -> s' y) -> Coroutine s m x -> Coroutine s' m x
mapSuspension forall y. s y -> s' y
f Coroutine s m x
cort = Coroutine :: forall (s :: * -> *) (m :: * -> *) r.
m (Either (s (Coroutine s m r)) r) -> Coroutine s m r
Coroutine {resume :: m (Either (s' (Coroutine s' m x)) x)
resume= (Either (s (Coroutine s m x)) x
 -> Either (s' (Coroutine s' m x)) x)
-> m (Either (s (Coroutine s m x)) x)
-> m (Either (s' (Coroutine s' m x)) x)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Either (s (Coroutine s m x)) x -> Either (s' (Coroutine s' m x)) x
forall (m :: * -> *) x b.
Monad m =>
Either (s (Coroutine s m x)) b -> Either (s' (Coroutine s' m x)) b
map' (Coroutine s m x -> m (Either (s (Coroutine s m x)) x)
forall (s :: * -> *) (m :: * -> *) r.
Coroutine s m r -> m (Either (s (Coroutine s m r)) r)
resume Coroutine s m x
cort)}
   where map' :: Either (s (Coroutine s m x)) b -> Either (s' (Coroutine s' m x)) b
map' (Right b
r) = b -> Either (s' (Coroutine s' m x)) b
forall a b. b -> Either a b
Right b
r
         map' (Left s (Coroutine s m x)
s) = s' (Coroutine s' m x) -> Either (s' (Coroutine s' m x)) b
forall a b. a -> Either a b
Left (s (Coroutine s' m x) -> s' (Coroutine s' m x)
forall y. s y -> s' y
f (s (Coroutine s' m x) -> s' (Coroutine s' m x))
-> s (Coroutine s' m x) -> s' (Coroutine s' m x)
forall a b. (a -> b) -> a -> b
$ (Coroutine s m x -> Coroutine s' m x)
-> s (Coroutine s m x) -> s (Coroutine s' m x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((forall y. s y -> s' y) -> Coroutine s m x -> Coroutine s' m x
forall (s :: * -> *) (m :: * -> *) (s' :: * -> *) x.
(Functor s, Monad m) =>
(forall y. s y -> s' y) -> Coroutine s m x -> Coroutine s' m x
mapSuspension forall y. s y -> s' y
f) s (Coroutine s m x)
s)
{-# INLINE mapSuspension #-}

-- | Modify the first upcoming suspension of a 'Coroutine'.
mapFirstSuspension :: forall s m x. (Functor s, Monad m) =>
                      (forall y. s y -> s y) -> Coroutine s m x -> Coroutine s m x
mapFirstSuspension :: (forall y. s y -> s y) -> Coroutine s m x -> Coroutine s m x
mapFirstSuspension forall y. s y -> s y
f Coroutine s m x
cort = Coroutine :: forall (s :: * -> *) (m :: * -> *) r.
m (Either (s (Coroutine s m r)) r) -> Coroutine s m r
Coroutine {resume :: m (Either (s (Coroutine s m x)) x)
resume= (Either (s (Coroutine s m x)) x -> Either (s (Coroutine s m x)) x)
-> m (Either (s (Coroutine s m x)) x)
-> m (Either (s (Coroutine s m x)) x)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Either (s (Coroutine s m x)) x -> Either (s (Coroutine s m x)) x
forall y b. Either (s y) b -> Either (s y) b
map' (Coroutine s m x -> m (Either (s (Coroutine s m x)) x)
forall (s :: * -> *) (m :: * -> *) r.
Coroutine s m r -> m (Either (s (Coroutine s m r)) r)
resume Coroutine s m x
cort)}
   where map' :: Either (s y) b -> Either (s y) b
map' (Right b
r) = b -> Either (s y) b
forall a b. b -> Either a b
Right b
r
         map' (Left s y
s) = s y -> Either (s y) b
forall a b. a -> Either a b
Left (s y -> s y
forall y. s y -> s y
f s y
s)

-- | Convert a non-suspending 'Coroutine' to the base monad.
runCoroutine :: Monad m => Coroutine Naught m x -> m x
runCoroutine :: Coroutine Naught m x -> m x
runCoroutine = (Naught (Coroutine Naught m x) -> Coroutine Naught m x)
-> Coroutine Naught m x -> m x
forall (m :: * -> *) (s :: * -> *) x.
Monad m =>
(s (Coroutine s m x) -> Coroutine s m x) -> Coroutine s m x -> m x
pogoStick (String -> Naught (Coroutine Naught m x) -> Coroutine Naught m x
forall a. HasCallStack => String -> a
error String
"runCoroutine can run only a non-suspending coroutine!")

-- | Runs a single step of a suspendable 'Coroutine', using a function that extracts the coroutine resumption from its
-- suspension functor.
bounce :: (Monad m, Functor s) => (s (Coroutine s m x) -> Coroutine s m x) -> Coroutine s m x -> Coroutine s m x
bounce :: (s (Coroutine s m x) -> Coroutine s m x)
-> Coroutine s m x -> Coroutine s m x
bounce s (Coroutine s m x) -> Coroutine s m x
spring Coroutine s m x
c = m (Either (s (Coroutine s m x)) x)
-> Coroutine s m (Either (s (Coroutine s m x)) x)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Coroutine s m x -> m (Either (s (Coroutine s m x)) x)
forall (s :: * -> *) (m :: * -> *) r.
Coroutine s m r -> m (Either (s (Coroutine s m r)) r)
resume Coroutine s m x
c) Coroutine s m (Either (s (Coroutine s m x)) x)
-> (Either (s (Coroutine s m x)) x -> Coroutine s m x)
-> Coroutine s m x
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (s (Coroutine s m x) -> Coroutine s m x)
-> (x -> Coroutine s m x)
-> Either (s (Coroutine s m x)) x
-> Coroutine s m x
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either s (Coroutine s m x) -> Coroutine s m x
spring x -> Coroutine s m x
forall (m :: * -> *) a. Monad m => a -> m a
return

-- | Runs a suspendable 'Coroutine' to its completion.
pogoStick :: Monad m => (s (Coroutine s m x) -> Coroutine s m x) -> Coroutine s m x -> m x
pogoStick :: (s (Coroutine s m x) -> Coroutine s m x) -> Coroutine s m x -> m x
pogoStick s (Coroutine s m x) -> Coroutine s m x
spring = Coroutine s m x -> m x
loop
   where loop :: Coroutine s m x -> m x
loop Coroutine s m x
c = Coroutine s m x -> m (Either (s (Coroutine s m x)) x)
forall (s :: * -> *) (m :: * -> *) r.
Coroutine s m r -> m (Either (s (Coroutine s m r)) r)
resume Coroutine s m x
c m (Either (s (Coroutine s m x)) x)
-> (Either (s (Coroutine s m x)) x -> m x) -> m x
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (s (Coroutine s m x) -> m x)
-> (x -> m x) -> Either (s (Coroutine s m x)) x -> m x
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Coroutine s m x -> m x
loop (Coroutine s m x -> m x)
-> (s (Coroutine s m x) -> Coroutine s m x)
-> s (Coroutine s m x)
-> m x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s (Coroutine s m x) -> Coroutine s m x
spring) x -> m x
forall (m :: * -> *) a. Monad m => a -> m a
return

-- | Runs a suspendable 'Coroutine' to its completion with a monadic action.
pogoStickM :: Monad m => (s (Coroutine s m x) -> m (Coroutine s m x)) -> Coroutine s m x -> m x
pogoStickM :: (s (Coroutine s m x) -> m (Coroutine s m x))
-> Coroutine s m x -> m x
pogoStickM s (Coroutine s m x) -> m (Coroutine s m x)
spring = Coroutine s m x -> m x
loop
   where loop :: Coroutine s m x -> m x
loop Coroutine s m x
c = Coroutine s m x -> m (Either (s (Coroutine s m x)) x)
forall (s :: * -> *) (m :: * -> *) r.
Coroutine s m r -> m (Either (s (Coroutine s m r)) r)
resume Coroutine s m x
c m (Either (s (Coroutine s m x)) x)
-> (Either (s (Coroutine s m x)) x -> m x) -> m x
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (s (Coroutine s m x) -> m x)
-> (x -> m x) -> Either (s (Coroutine s m x)) x -> m x
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Coroutine s m x -> m x
loop (Coroutine s m x -> m x)
-> (s (Coroutine s m x) -> m (Coroutine s m x))
-> s (Coroutine s m x)
-> m x
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< s (Coroutine s m x) -> m (Coroutine s m x)
spring) x -> m x
forall (m :: * -> *) a. Monad m => a -> m a
return

-- | Runs a suspendable coroutine much like 'pogoStick', but allows the resumption function to thread an arbitrary
-- state as well.
foldRun :: Monad m => (a -> s (Coroutine s m x) -> (a, Coroutine s m x)) -> a -> Coroutine s m x -> m (a, x)
foldRun :: (a -> s (Coroutine s m x) -> (a, Coroutine s m x))
-> a -> Coroutine s m x -> m (a, x)
foldRun a -> s (Coroutine s m x) -> (a, Coroutine s m x)
f a
a Coroutine s m x
c = Coroutine s m x -> m (Either (s (Coroutine s m x)) x)
forall (s :: * -> *) (m :: * -> *) r.
Coroutine s m r -> m (Either (s (Coroutine s m r)) r)
resume Coroutine s m x
c
                m (Either (s (Coroutine s m x)) x)
-> (Either (s (Coroutine s m x)) x -> m (a, x)) -> m (a, x)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Either (s (Coroutine s m x)) x
s-> case Either (s (Coroutine s m x)) x
s 
                         of Right x
result -> (a, x) -> m (a, x)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, x
result)
                            Left s (Coroutine s m x)
c' -> (a -> Coroutine s m x -> m (a, x))
-> (a, Coroutine s m x) -> m (a, x)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((a -> s (Coroutine s m x) -> (a, Coroutine s m x))
-> a -> Coroutine s m x -> m (a, x)
forall (m :: * -> *) a (s :: * -> *) x.
Monad m =>
(a -> s (Coroutine s m x) -> (a, Coroutine s m x))
-> a -> Coroutine s m x -> m (a, x)
foldRun a -> s (Coroutine s m x) -> (a, Coroutine s m x)
f) (a -> s (Coroutine s m x) -> (a, Coroutine s m x)
f a
a s (Coroutine s m x)
c')

-- | Type of functions that can bind two monadic values together, used to combine two coroutines' step results. The two
-- functions provided here are 'sequentialBinder' and 'parallelBinder'.
type PairBinder m = forall x y r. (x -> y -> m r) -> m x -> m y -> m r

-- | A 'PairBinder' that runs the two steps sequentially before combining their results.
sequentialBinder :: Monad m => PairBinder m
sequentialBinder :: PairBinder m
sequentialBinder x -> y -> m r
f m x
mx m y
my = do {x
x <- m x
mx; y
y <- m y
my; x -> y -> m r
f x
x y
y}

-- | A 'PairBinder' that runs the two steps in parallel.
parallelBinder :: MonadParallel m => PairBinder m
parallelBinder :: PairBinder m
parallelBinder = (x -> y -> m r) -> m x -> m y -> m r
forall (m :: * -> *) a b c.
MonadParallel m =>
(a -> b -> m c) -> m a -> m b -> m c
bindM2

-- | Lifting a 'PairBinder' onto a 'Coroutine' monad transformer.
liftBinder :: forall s m. (Functor s, Monad m) => PairBinder m -> PairBinder (Coroutine s m)
liftBinder :: PairBinder m -> PairBinder (Coroutine s m)
liftBinder PairBinder m
binder x -> y -> Coroutine s m r
f Coroutine s m x
t1 Coroutine s m y
t2 = m (Either (s (Coroutine s m r)) r) -> Coroutine s m r
forall (s :: * -> *) (m :: * -> *) r.
m (Either (s (Coroutine s m r)) r) -> Coroutine s m r
Coroutine ((Either (s (Coroutine s m x)) x
 -> Either (s (Coroutine s m y)) y
 -> m (Either (s (Coroutine s m r)) r))
-> m (Either (s (Coroutine s m x)) x)
-> m (Either (s (Coroutine s m y)) y)
-> m (Either (s (Coroutine s m r)) r)
PairBinder m
binder Either (s (Coroutine s m x)) x
-> Either (s (Coroutine s m y)) y
-> m (Either (s (Coroutine s m r)) r)
combine (Coroutine s m x -> m (Either (s (Coroutine s m x)) x)
forall (s :: * -> *) (m :: * -> *) r.
Coroutine s m r -> m (Either (s (Coroutine s m r)) r)
resume Coroutine s m x
t1) (Coroutine s m y -> m (Either (s (Coroutine s m y)) y)
forall (s :: * -> *) (m :: * -> *) r.
Coroutine s m r -> m (Either (s (Coroutine s m r)) r)
resume Coroutine s m y
t2)) where
   combine :: Either (s (Coroutine s m x)) x
-> Either (s (Coroutine s m y)) y
-> m (Either (s (Coroutine s m r)) r)
combine (Right x
x) (Right y
y) = Coroutine s m r -> m (Either (s (Coroutine s m r)) r)
forall (s :: * -> *) (m :: * -> *) r.
Coroutine s m r -> m (Either (s (Coroutine s m r)) r)
resume (x -> y -> Coroutine s m r
f x
x y
y)
   combine (Left s (Coroutine s m x)
s) (Right y
y) = Either (s (Coroutine s m r)) r
-> m (Either (s (Coroutine s m r)) r)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (s (Coroutine s m r)) r
 -> m (Either (s (Coroutine s m r)) r))
-> Either (s (Coroutine s m r)) r
-> m (Either (s (Coroutine s m r)) r)
forall a b. (a -> b) -> a -> b
$ s (Coroutine s m r) -> Either (s (Coroutine s m r)) r
forall a b. a -> Either a b
Left ((Coroutine s m x -> Coroutine s m r)
-> s (Coroutine s m x) -> s (Coroutine s m r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((x -> y -> Coroutine s m r) -> y -> x -> Coroutine s m r
forall a b c. (a -> b -> c) -> b -> a -> c
flip x -> y -> Coroutine s m r
f y
y (x -> Coroutine s m r) -> Coroutine s m x -> Coroutine s m r
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) s (Coroutine s m x)
s)
   combine (Right x
x) (Left s (Coroutine s m y)
s) = Either (s (Coroutine s m r)) r
-> m (Either (s (Coroutine s m r)) r)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (s (Coroutine s m r)) r
 -> m (Either (s (Coroutine s m r)) r))
-> Either (s (Coroutine s m r)) r
-> m (Either (s (Coroutine s m r)) r)
forall a b. (a -> b) -> a -> b
$ s (Coroutine s m r) -> Either (s (Coroutine s m r)) r
forall a b. a -> Either a b
Left ((Coroutine s m y -> Coroutine s m r)
-> s (Coroutine s m y) -> s (Coroutine s m r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (x -> y -> Coroutine s m r
f x
x (y -> Coroutine s m r) -> Coroutine s m y -> Coroutine s m r
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) s (Coroutine s m y)
s)
   combine (Left s (Coroutine s m x)
s1) (Left s (Coroutine s m y)
s2) = Either (s (Coroutine s m r)) r
-> m (Either (s (Coroutine s m r)) r)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (s (Coroutine s m r)) r
 -> m (Either (s (Coroutine s m r)) r))
-> Either (s (Coroutine s m r)) r
-> m (Either (s (Coroutine s m r)) r)
forall a b. (a -> b) -> a -> b
$ s (Coroutine s m r) -> Either (s (Coroutine s m r)) r
forall a b. a -> Either a b
Left ((Coroutine s m y -> Coroutine s m r)
-> s (Coroutine s m y) -> s (Coroutine s m r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PairBinder m
-> (x -> y -> Coroutine s m r)
-> Coroutine s m x
-> Coroutine s m y
-> Coroutine s m r
forall (s :: * -> *) (m :: * -> *).
(Functor s, Monad m) =>
PairBinder m -> PairBinder (Coroutine s m)
liftBinder PairBinder m
binder x -> y -> Coroutine s m r
f (Coroutine s m x -> Coroutine s m y -> Coroutine s m r)
-> Coroutine s m x -> Coroutine s m y -> Coroutine s m r
forall a b. (a -> b) -> a -> b
$ s (Coroutine s m x) -> Coroutine s m x
forall (m :: * -> *) (s :: * -> *) x.
(Monad m, Functor s) =>
s (Coroutine s m x) -> Coroutine s m x
suspend s (Coroutine s m x)
s1) s (Coroutine s m y)
s2)

-- | Type of functions that can weave two coroutines into a single coroutine.
type Weaver s1 s2 s3 m x y z = Coroutine s1 m x -> Coroutine s2 m y -> Coroutine s3 m z

-- | Type of functions capable of combining two coroutines' 'CoroutineStepResult' values into a third one. Module
-- "Monad.Coroutine.SuspensionFunctors" contains several 'WeaveStepper' examples.
type WeaveStepper s1 s2 s3 m x y z =
   Weaver s1 s2 s3 m x y z -> CoroutineStepResult s1 m x -> CoroutineStepResult s2 m y -> Coroutine s3 m z

-- | Weaves two coroutines into one, given a 'PairBinder' to run the next step of each coroutine and a 'WeaveStepper' to
-- combine the results of the steps.
weave :: forall s1 s2 s3 m x y z. (Monad m, Functor s1, Functor s2, Functor s3) =>
         PairBinder m -> WeaveStepper s1 s2 s3 m x y z -> Weaver s1 s2 s3 m x y z
weave :: PairBinder m
-> WeaveStepper s1 s2 s3 m x y z -> Weaver s1 s2 s3 m x y z
weave PairBinder m
runPair WeaveStepper s1 s2 s3 m x y z
weaveStep Coroutine s1 m x
c1 Coroutine s2 m y
c2 = Weaver s1 s2 s3 m x y z
zipC Coroutine s1 m x
c1 Coroutine s2 m y
c2 where
   zipC :: Weaver s1 s2 s3 m x y z
zipC Coroutine s1 m x
c1 Coroutine s2 m y
c2 = Coroutine :: forall (s :: * -> *) (m :: * -> *) r.
m (Either (s (Coroutine s m r)) r) -> Coroutine s m r
Coroutine{resume :: m (Either (s3 (Coroutine s3 m z)) z)
resume= (CoroutineStepResult s1 m x
 -> CoroutineStepResult s2 m y
 -> m (Either (s3 (Coroutine s3 m z)) z))
-> m (CoroutineStepResult s1 m x)
-> m (CoroutineStepResult s2 m y)
-> m (Either (s3 (Coroutine s3 m z)) z)
PairBinder m
runPair (\CoroutineStepResult s1 m x
c1' CoroutineStepResult s2 m y
c2'-> Coroutine s3 m z -> m (Either (s3 (Coroutine s3 m z)) z)
forall (s :: * -> *) (m :: * -> *) r.
Coroutine s m r -> m (Either (s (Coroutine s m r)) r)
resume (Coroutine s3 m z -> m (Either (s3 (Coroutine s3 m z)) z))
-> Coroutine s3 m z -> m (Either (s3 (Coroutine s3 m z)) z)
forall a b. (a -> b) -> a -> b
$ WeaveStepper s1 s2 s3 m x y z
weaveStep Weaver s1 s2 s3 m x y z
zipC CoroutineStepResult s1 m x
c1' CoroutineStepResult s2 m y
c2') (Coroutine s1 m x -> m (CoroutineStepResult s1 m x)
forall (s :: * -> *) (m :: * -> *) r.
Coroutine s m r -> m (Either (s (Coroutine s m r)) r)
resume Coroutine s1 m x
c1) (Coroutine s2 m y -> m (CoroutineStepResult s2 m y)
forall (s :: * -> *) (m :: * -> *) r.
Coroutine s m r -> m (Either (s (Coroutine s m r)) r)
resume Coroutine s2 m y
c2)}

-- | Weaves a list of coroutines with the same suspension functor type into a single coroutine. The coroutines suspend
-- and resume in lockstep.
merge :: forall s m x. (Monad m, Functor s) =>
         (forall y. [m y] -> m [y]) -> (forall y. [s y] -> s [y])
      -> [Coroutine s m x] -> Coroutine s m [x]
merge :: (forall y. [m y] -> m [y])
-> (forall y. [s y] -> s [y])
-> [Coroutine s m x]
-> Coroutine s m [x]
merge forall y. [m y] -> m [y]
sequence1 forall y. [s y] -> s [y]
sequence2 [Coroutine s m x]
corts = Coroutine :: forall (s :: * -> *) (m :: * -> *) r.
m (Either (s (Coroutine s m r)) r) -> Coroutine s m r
Coroutine{resume :: m (Either (s (Coroutine s m [x])) [x])
resume= ([CoroutineStepResult s m x] -> Either (s (Coroutine s m [x])) [x])
-> m [CoroutineStepResult s m x]
-> m (Either (s (Coroutine s m [x])) [x])
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [CoroutineStepResult s m x] -> Either (s (Coroutine s m [x])) [x]
step (m [CoroutineStepResult s m x]
 -> m (Either (s (Coroutine s m [x])) [x]))
-> m [CoroutineStepResult s m x]
-> m (Either (s (Coroutine s m [x])) [x])
forall a b. (a -> b) -> a -> b
$ [m (CoroutineStepResult s m x)] -> m [CoroutineStepResult s m x]
forall y. [m y] -> m [y]
sequence1 ((Coroutine s m x -> m (CoroutineStepResult s m x))
-> [Coroutine s m x] -> [m (CoroutineStepResult s m x)]
forall a b. (a -> b) -> [a] -> [b]
map Coroutine s m x -> m (CoroutineStepResult s m x)
forall (s :: * -> *) (m :: * -> *) r.
Coroutine s m r -> m (Either (s (Coroutine s m r)) r)
resume [Coroutine s m x]
corts)} where
   step :: [CoroutineStepResult s m x] -> CoroutineStepResult s m [x]
   step :: [CoroutineStepResult s m x] -> Either (s (Coroutine s m [x])) [x]
step [CoroutineStepResult s m x]
list = case [CoroutineStepResult s m x] -> ([s (Coroutine s m x)], [x])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [CoroutineStepResult s m x]
list
               of ([], [x]
ends) -> [x] -> Either (s (Coroutine s m [x])) [x]
forall a b. b -> Either a b
Right [x]
ends
                  ([s (Coroutine s m x)]
suspensions, [x]
ends) -> s (Coroutine s m [x]) -> Either (s (Coroutine s m [x])) [x]
forall a b. a -> Either a b
Left (s (Coroutine s m [x]) -> Either (s (Coroutine s m [x])) [x])
-> s (Coroutine s m [x]) -> Either (s (Coroutine s m [x])) [x]
forall a b. (a -> b) -> a -> b
$ ([Coroutine s m x] -> Coroutine s m [x])
-> s [Coroutine s m x] -> s (Coroutine s m [x])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((forall y. [m y] -> m [y])
-> (forall y. [s y] -> s [y])
-> [Coroutine s m x]
-> Coroutine s m [x]
forall (s :: * -> *) (m :: * -> *) x.
(Monad m, Functor s) =>
(forall y. [m y] -> m [y])
-> (forall y. [s y] -> s [y])
-> [Coroutine s m x]
-> Coroutine s m [x]
merge forall y. [m y] -> m [y]
sequence1 forall y. [s y] -> s [y]
sequence2 ([Coroutine s m x] -> Coroutine s m [x])
-> ([Coroutine s m x] -> [Coroutine s m x])
-> [Coroutine s m x]
-> Coroutine s m [x]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((x -> Coroutine s m x) -> [x] -> [Coroutine s m x]
forall a b. (a -> b) -> [a] -> [b]
map x -> Coroutine s m x
forall (m :: * -> *) a. Monad m => a -> m a
return [x]
ends [Coroutine s m x] -> [Coroutine s m x] -> [Coroutine s m x]
forall a. [a] -> [a] -> [a]
++)) (s [Coroutine s m x] -> s (Coroutine s m [x]))
-> s [Coroutine s m x] -> s (Coroutine s m [x])
forall a b. (a -> b) -> a -> b
$
                                         [s (Coroutine s m x)] -> s [Coroutine s m x]
forall y. [s y] -> s [y]
sequence2 [s (Coroutine s m x)]
suspensions