{- 
    Copyright 2010-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 some common suspension functors for use with the "Control.Monad.Coroutine" module.
-- 

{-# LANGUAGE Rank2Types, ExistentialQuantification #-}

module Control.Monad.Coroutine.SuspensionFunctors
   (
    -- * Suspension functors
    Yield(Yield), Await(Await), Request(Request),
    ReadRequest, ReadingResult(..), Reader, Reading(..),
    eitherFunctor,
    yield, await, request, requestRead,
    -- * Utility functions
    concatYields, concatAwaits,
    -- * WeaveSteppers for weaving pairs of coroutines
    weaveAwaitYield, weaveAwaitMaybeYield, weaveRequests,
    weaveReadWriteRequests, weaveNestedReadWriteRequests
   )
where

import Prelude hiding (foldl, foldr)
import Control.Monad (liftM)
import Control.Monad.Trans.Class (lift)
import Data.Foldable (Foldable, foldl, foldr)
import Data.Functor.Identity (Identity(..))
import Data.Functor.Sum (Sum(InL, InR))
import Data.Monoid (Monoid, mempty)

import Control.Monad.Coroutine
import Control.Monad.Coroutine.Nested (eitherFunctor, NestWeaveStepper, pogoStickNested)

-- | The 'Yield' functor instance is equivalent to (,) but more descriptive. A coroutine with this suspension functor
-- provides a value with every suspension.
data Yield x y = Yield x y
instance Functor (Yield x) where
   fmap :: (a -> b) -> Yield x a -> Yield x b
fmap a -> b
f (Yield x
x a
y) = x -> b -> Yield x b
forall x y. x -> y -> Yield x y
Yield x
x (a -> b
f a
y)

-- | The 'Await' functor instance is equivalent to (->) but more descriptive. A coroutine with this suspension functor
-- demands a value whenever it suspends, before it can resume its execution.
newtype Await x y = Await (x -> y)
instance Functor (Await x) where
   fmap :: (a -> b) -> Await x a -> Await x b
fmap a -> b
f (Await x -> a
g) = (x -> b) -> Await x b
forall x y. (x -> y) -> Await x y
Await (a -> b
f (a -> b) -> (x -> a) -> x -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> a
g)

-- | The 'Request' functor instance combines a 'Yield' of a request with an 'Await' for a response.
data Request request response x = Request request (response -> x)
instance Functor (Request x f) where
   fmap :: (a -> b) -> Request x f a -> Request x f b
fmap a -> b
f (Request x
x f -> a
g) = x -> (f -> b) -> Request x f b
forall request response x.
request -> (response -> x) -> Request request response x
Request x
x (a -> b
f (a -> b) -> (f -> a) -> f -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f -> a
g)

data Reading x py y = Final x y                     -- ^ Final result chunk with the unconsumed portion of the input
                    | Advance (Reader x py y) y py  -- ^ A part of the result with the reader of more input and the EOF
                    | Deferred (Reader x py y) y    -- ^ Reader of more input, plus the result if there isn't any.

data ReadingResult x py y = ResultPart py (Reader x py y)  -- ^ A part of the result with the reader of more input
                          | FinalResult y                  -- ^ Final result chunk

type Reader x py y = x -> Reading x py y

-- | Combines a 'Yield' of a 'Reader' with an 'Await' for a 'ReadingResult'.
data ReadRequest x z = forall a py y. ReadRequest (Reader x py y) y (ReadingResult x py y -> z)
instance Functor (ReadRequest x) where
   fmap :: (a -> b) -> ReadRequest x a -> ReadRequest x b
fmap a -> b
f (ReadRequest Reader x py y
r y
y ReadingResult x py y -> a
g) = Reader x py y
-> y -> (ReadingResult x py y -> b) -> ReadRequest x b
forall x z a py y.
Reader x py y
-> y -> (ReadingResult x py y -> z) -> ReadRequest x z
ReadRequest Reader x py y
r y
y (a -> b
f (a -> b)
-> (ReadingResult x py y -> a) -> ReadingResult x py y -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadingResult x py y -> a
g)

-- | Suspend the current coroutine yielding a value.
yield :: Monad m => x -> Coroutine (Yield x) m ()
yield :: x -> Coroutine (Yield x) m ()
yield x
x = Yield x (Coroutine (Yield x) m ()) -> Coroutine (Yield x) m ()
forall (m :: * -> *) (s :: * -> *) x.
(Monad m, Functor s) =>
s (Coroutine s m x) -> Coroutine s m x
suspend (x -> Coroutine (Yield x) m () -> Yield x (Coroutine (Yield x) m ())
forall x y. x -> y -> Yield x y
Yield x
x (() -> Coroutine (Yield x) m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()))

-- | Suspend the current coroutine until a value is provided.
await :: Monad m => Coroutine (Await x) m x
await :: Coroutine (Await x) m x
await = Await x (Coroutine (Await x) m x) -> Coroutine (Await x) m x
forall (m :: * -> *) (s :: * -> *) x.
(Monad m, Functor s) =>
s (Coroutine s m x) -> Coroutine s m x
suspend ((x -> Coroutine (Await x) m x) -> Await x (Coroutine (Await x) m x)
forall x y. (x -> y) -> Await x y
Await x -> Coroutine (Await x) m x
forall (m :: * -> *) a. Monad m => a -> m a
return)

-- | Suspend yielding a request and awaiting the response.
request :: Monad m => x -> Coroutine (Request x y) m y
request :: x -> Coroutine (Request x y) m y
request x
x = Request x y (Coroutine (Request x y) m y)
-> Coroutine (Request x y) m y
forall (m :: * -> *) (s :: * -> *) x.
(Monad m, Functor s) =>
s (Coroutine s m x) -> Coroutine s m x
suspend (x
-> (y -> Coroutine (Request x y) m y)
-> Request x y (Coroutine (Request x y) m y)
forall request response x.
request -> (response -> x) -> Request request response x
Request x
x y -> Coroutine (Request x y) m y
forall (m :: * -> *) a. Monad m => a -> m a
return)

-- | Suspend yielding a 'ReadRequest' and awaiting the 'ReadingResult'.
requestRead :: (Monad m, Monoid x) => Reader x py y -> Coroutine (ReadRequest x) m (ReadingResult x py y)
requestRead :: Reader x py y -> Coroutine (ReadRequest x) m (ReadingResult x py y)
requestRead Reader x py y
p = ReadRequest x (Coroutine (ReadRequest x) m (ReadingResult x py y))
-> Coroutine (ReadRequest x) m (ReadingResult x py y)
forall (m :: * -> *) (s :: * -> *) x.
(Monad m, Functor s) =>
s (Coroutine s m x) -> Coroutine s m x
suspend (Reader x py y
-> y
-> (ReadingResult x py y
    -> Coroutine (ReadRequest x) m (ReadingResult x py y))
-> ReadRequest
     x (Coroutine (ReadRequest x) m (ReadingResult x py y))
forall x z a py y.
Reader x py y
-> y -> (ReadingResult x py y -> z) -> ReadRequest x z
ReadRequest Reader x py y
p y
eof ReadingResult x py y
-> Coroutine (ReadRequest x) m (ReadingResult x py y)
forall (m :: * -> *) a. Monad m => a -> m a
return)
   where eof :: y
eof = case Reader x py y
p x
forall a. Monoid a => a
mempty
               of Deferred Reader x py y
_ y
r -> y
r
                  Advance Reader x py y
_ y
r py
rp -> y
r
                  Final x
_ y
r -> y
r

-- | Converts a coroutine yielding collections of values into one yielding single values.
concatYields :: (Monad m, Foldable f) => Coroutine (Yield (f x)) m r -> Coroutine (Yield x) m r
concatYields :: Coroutine (Yield (f x)) m r -> Coroutine (Yield x) m r
concatYields Coroutine (Yield (f x)) m r
c = Coroutine :: forall (s :: * -> *) (m :: * -> *) r.
m (Either (s (Coroutine s m r)) r) -> Coroutine s m r
Coroutine{resume :: m (Either (Yield x (Coroutine (Yield x) m r)) r)
resume= Coroutine (Yield (f x)) m r
-> m (Either (Yield (f x) (Coroutine (Yield (f x)) m r)) r)
forall (s :: * -> *) (m :: * -> *) r.
Coroutine s m r -> m (Either (s (Coroutine s m r)) r)
resume Coroutine (Yield (f x)) m r
c m (Either (Yield (f x) (Coroutine (Yield (f x)) m r)) r)
-> (Either (Yield (f x) (Coroutine (Yield (f x)) m r)) r
    -> m (Either (Yield x (Coroutine (Yield x) m r)) r))
-> m (Either (Yield x (Coroutine (Yield x) m r)) r)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either (Yield (f x) (Coroutine (Yield (f x)) m r)) r
-> m (Either (Yield x (Coroutine (Yield x) m r)) r)
forall (m :: * -> *) (t :: * -> *) (f :: * -> *) x b.
(Monad m, Foldable t, Foldable f) =>
Either (Yield (t x) (Coroutine (Yield (f x)) m b)) b
-> m (Either (Yield x (Coroutine (Yield x) m b)) b)
foldChunk}
   where foldChunk :: Either (Yield (t x) (Coroutine (Yield (f x)) m b)) b
-> m (Either (Yield x (Coroutine (Yield x) m b)) b)
foldChunk (Right b
r) = Either (Yield x (Coroutine (Yield x) m b)) b
-> m (Either (Yield x (Coroutine (Yield x) m b)) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Either (Yield x (Coroutine (Yield x) m b)) b
forall a b. b -> Either a b
Right b
r)
         foldChunk (Left (Yield t x
s Coroutine (Yield (f x)) m b
c')) = (x
 -> m (Either (Yield x (Coroutine (Yield x) m b)) b)
 -> m (Either (Yield x (Coroutine (Yield x) m b)) b))
-> m (Either (Yield x (Coroutine (Yield x) m b)) b)
-> t x
-> m (Either (Yield x (Coroutine (Yield x) m b)) b)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr x
-> m (Either (Yield x (Coroutine (Yield x) m b)) b)
-> m (Either (Yield x (Coroutine (Yield x) m b)) b)
forall (m :: * -> *) x (m :: * -> *) (s :: * -> *) r b.
Monad m =>
x
-> m (Either (s (Coroutine s m r)) r)
-> m (Either (Yield x (Coroutine s m r)) b)
f (Coroutine (Yield x) m b
-> m (Either (Yield x (Coroutine (Yield x) m b)) b)
forall (s :: * -> *) (m :: * -> *) r.
Coroutine s m r -> m (Either (s (Coroutine s m r)) r)
resume (Coroutine (Yield x) m b
 -> m (Either (Yield x (Coroutine (Yield x) m b)) b))
-> Coroutine (Yield x) m b
-> m (Either (Yield x (Coroutine (Yield x) m b)) b)
forall a b. (a -> b) -> a -> b
$ Coroutine (Yield (f x)) m b -> Coroutine (Yield x) m b
forall (m :: * -> *) (f :: * -> *) x r.
(Monad m, Foldable f) =>
Coroutine (Yield (f x)) m r -> Coroutine (Yield x) m r
concatYields Coroutine (Yield (f x)) m b
c') t x
s
         f :: x
-> m (Either (s (Coroutine s m r)) r)
-> m (Either (Yield x (Coroutine s m r)) b)
f x
x m (Either (s (Coroutine s m r)) r)
rest = Either (Yield x (Coroutine s m r)) b
-> m (Either (Yield x (Coroutine s m r)) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Yield x (Coroutine s m r) -> Either (Yield x (Coroutine s m r)) b
forall a b. a -> Either a b
Left (Yield x (Coroutine s m r) -> Either (Yield x (Coroutine s m r)) b)
-> Yield x (Coroutine s m r)
-> Either (Yield x (Coroutine s m r)) b
forall a b. (a -> b) -> a -> b
$ x -> Coroutine s m r -> Yield x (Coroutine s m r)
forall x y. x -> y -> Yield x y
Yield x
x (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 m (Either (s (Coroutine s m r)) r)
rest))

-- | Converts a coroutine awaiting single values into one awaiting collections of values.
concatAwaits :: (Monad m, Foldable f) => Coroutine (Await x) m r -> Coroutine (Await (f x)) m r
concatAwaits :: Coroutine (Await x) m r -> Coroutine (Await (f x)) m r
concatAwaits Coroutine (Await x) m r
c = m (Either (Await x (Coroutine (Await x) m r)) r)
-> Coroutine
     (Await (f x)) m (Either (Await x (Coroutine (Await x) m r)) r)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Coroutine (Await x) m r
-> m (Either (Await x (Coroutine (Await x) m r)) r)
forall (s :: * -> *) (m :: * -> *) r.
Coroutine s m r -> m (Either (s (Coroutine s m r)) r)
resume Coroutine (Await x) m r
c) Coroutine
  (Await (f x)) m (Either (Await x (Coroutine (Await x) m r)) r)
-> (Either (Await x (Coroutine (Await x) m r)) r
    -> Coroutine (Await (f x)) m r)
-> Coroutine (Await (f x)) m r
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Await x (Coroutine (Await x) m r) -> Coroutine (Await (f x)) m r)
-> (r -> Coroutine (Await (f x)) m r)
-> Either (Await x (Coroutine (Await x) m r)) r
-> Coroutine (Await (f x)) m r
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Await x (Coroutine (Await x) m r) -> Coroutine (Await (f x)) m r
forall (m :: * -> *) (f :: * -> *) x b.
(Monad m, Foldable f) =>
Await x (Coroutine (Await x) m b) -> Coroutine (Await (f x)) m b
concatenate r -> Coroutine (Await (f x)) m r
forall (m :: * -> *) a. Monad m => a -> m a
return
   where concatenate :: Await x (Coroutine (Await x) m b) -> Coroutine (Await (f x)) m b
concatenate Await x (Coroutine (Await x) m b)
s = do f x
chunk <- Coroutine (Await (f x)) m (f x)
forall (m :: * -> *) x. Monad m => Coroutine (Await x) m x
await
                            Coroutine (Await x) m b -> Coroutine (Await (f x)) m b
forall (m :: * -> *) (f :: * -> *) x r.
(Monad m, Foldable f) =>
Coroutine (Await x) m r -> Coroutine (Await (f x)) m r
concatAwaits (f x -> Coroutine (Await x) m b -> Coroutine (Await x) m b
forall (f :: * -> *) (m :: * -> *) x r.
(Foldable f, Monad m) =>
f x -> Coroutine (Await x) m r -> Coroutine (Await x) m r
feedAll f x
chunk (Await x (Coroutine (Await x) m b) -> Coroutine (Await x) m b
forall (m :: * -> *) (s :: * -> *) x.
(Monad m, Functor s) =>
s (Coroutine s m x) -> Coroutine s m x
suspend Await x (Coroutine (Await x) m b)
s))
         feedAll :: (Foldable f, Monad m) => f x -> Coroutine (Await x) m r -> Coroutine (Await x) m r
         feedAll :: f x -> Coroutine (Await x) m r -> Coroutine (Await x) m r
feedAll f x
chunk Coroutine (Await x) m r
c = (Coroutine (Await x) m r -> x -> Coroutine (Await x) m r)
-> Coroutine (Await x) m r -> f x -> Coroutine (Await x) m r
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ((x -> Coroutine (Await x) m r -> Coroutine (Await x) m r)
-> Coroutine (Await x) m r -> x -> Coroutine (Await x) m r
forall a b c. (a -> b -> c) -> b -> a -> c
flip x -> Coroutine (Await x) m r -> Coroutine (Await x) m r
forall (m :: * -> *) x r.
Monad m =>
x -> Coroutine (Await x) m r -> Coroutine (Await x) m r
feedCoroutine) Coroutine (Await x) m r
c f x
chunk
         feedCoroutine :: Monad m => x -> Coroutine (Await x) m r -> Coroutine (Await x) m r
         feedCoroutine :: x -> Coroutine (Await x) m r -> Coroutine (Await x) m r
feedCoroutine x
x Coroutine (Await x) m r
c = (Await x (Coroutine (Await x) m r) -> Coroutine (Await x) m r)
-> Coroutine (Await x) m r -> Coroutine (Await x) m r
forall (m :: * -> *) (s :: * -> *) x.
(Monad m, Functor s) =>
(s (Coroutine s m x) -> Coroutine s m x)
-> Coroutine s m x -> Coroutine s m x
bounce (\(Await x -> Coroutine (Await x) m r
f)-> x -> Coroutine (Await x) m r
f x
x) Coroutine (Await x) m r
c

-- | Weaves the suspensions of a 'Yield' and an 'Await' coroutine together into a plain 'Identity' coroutine. If the
-- 'Yield' coroutine terminates first, the 'Await' one is resumed using the argument default value.
weaveAwaitYield :: Monad m => x -> WeaveStepper (Await x) (Yield x) Identity m r1 r2 (r1, r2)
weaveAwaitYield :: x -> WeaveStepper (Await x) (Yield x) Identity m r1 r2 (r1, r2)
weaveAwaitYield x
_ Weaver (Await x) (Yield x) Identity m r1 r2 (r1, r2)
weave (Left (Await x -> Coroutine (Await x) m r1
f)) (Left (Yield x
x Coroutine (Yield x) m r2
c)) = Weaver (Await x) (Yield x) Identity m r1 r2 (r1, r2)
weave (x -> Coroutine (Await x) m r1
f x
x) Coroutine (Yield x) m r2
c
weaveAwaitYield x
x Weaver (Await x) (Yield x) Identity m r1 r2 (r1, r2)
_ (Left (Await x -> Coroutine (Await x) m r1
f)) (Right r2
r2) = (r1 -> (r1, r2))
-> Coroutine Identity m r1 -> Coroutine Identity m (r1, r2)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (\r1
r1-> (r1
r1, r2
r2)) (Coroutine Identity m r1 -> Coroutine Identity m (r1, r2))
-> Coroutine Identity m r1 -> Coroutine Identity m (r1, r2)
forall a b. (a -> b) -> a -> b
$ (forall y. Await x y -> Identity y)
-> Coroutine (Await x) m r1 -> Coroutine Identity m r1
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. Await x y -> Identity y
proceed (x -> Coroutine (Await x) m r1
f x
x)
   where proceed :: Await x a -> Identity a
proceed (Await x -> a
f) = a -> Identity a
forall a. a -> Identity a
Identity (x -> a
f x
x)
weaveAwaitYield x
_ Weaver (Await x) (Yield x) Identity m r1 r2 (r1, r2)
_ (Right r1
r1) (Left (Yield x
_ Coroutine (Yield x) m r2
c)) = (r2 -> (r1, r2))
-> Coroutine Identity m r2 -> Coroutine Identity m (r1, r2)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((,) r1
r1) (Coroutine Identity m r2 -> Coroutine Identity m (r1, r2))
-> Coroutine Identity m r2 -> Coroutine Identity m (r1, r2)
forall a b. (a -> b) -> a -> b
$ (forall y. Yield x y -> Identity y)
-> Coroutine (Yield x) m r2 -> Coroutine Identity m r2
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. Yield x y -> Identity y
forall x a. Yield x a -> Identity a
discardYield Coroutine (Yield x) m r2
c
   where discardYield :: Yield x a -> Identity a
discardYield (Yield x
_ a
c) = a -> Identity a
forall a. a -> Identity a
Identity a
c
weaveAwaitYield x
_ Weaver (Await x) (Yield x) Identity m r1 r2 (r1, r2)
_ (Right r1
r1) (Right r2
r2) = (r1, r2) -> Coroutine Identity m (r1, r2)
forall (m :: * -> *) a. Monad m => a -> m a
return (r1
r1, r2
r2)

-- | Like 'weaveAwaitYield', except the 'Await' coroutine expects 'Maybe'-wrapped values. After the 'Yield' coroutine
-- terminates, the 'Await' coroutine receives only 'Nothing'.
weaveAwaitMaybeYield :: Monad m => WeaveStepper (Await (Maybe x)) (Yield x) Identity m r1 r2 (r1, r2)
weaveAwaitMaybeYield :: WeaveStepper (Await (Maybe x)) (Yield x) Identity m r1 r2 (r1, r2)
weaveAwaitMaybeYield Weaver (Await (Maybe x)) (Yield x) Identity m r1 r2 (r1, r2)
weave (Left (Await Maybe x -> Coroutine (Await (Maybe x)) m r1
f)) (Left (Yield x
x Coroutine (Yield x) m r2
c)) = Weaver (Await (Maybe x)) (Yield x) Identity m r1 r2 (r1, r2)
weave (Maybe x -> Coroutine (Await (Maybe x)) m r1
f (Maybe x -> Coroutine (Await (Maybe x)) m r1)
-> Maybe x -> Coroutine (Await (Maybe x)) m r1
forall a b. (a -> b) -> a -> b
$ x -> Maybe x
forall a. a -> Maybe a
Just x
x) Coroutine (Yield x) m r2
c
weaveAwaitMaybeYield Weaver (Await (Maybe x)) (Yield x) Identity m r1 r2 (r1, r2)
_ (Left (Await Maybe x -> Coroutine (Await (Maybe x)) m r1
f)) (Right r2
r2) = (r1 -> (r1, r2))
-> Coroutine Identity m r1 -> Coroutine Identity m (r1, r2)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (\r1
r1-> (r1
r1, r2
r2)) (Coroutine Identity m r1 -> Coroutine Identity m (r1, r2))
-> Coroutine Identity m r1 -> Coroutine Identity m (r1, r2)
forall a b. (a -> b) -> a -> b
$ (forall y. Await (Maybe x) y -> Identity y)
-> Coroutine (Await (Maybe x)) m r1 -> Coroutine Identity m r1
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. Await (Maybe x) y -> Identity y
forall a a. Await (Maybe a) a -> Identity a
proceed (Maybe x -> Coroutine (Await (Maybe x)) m r1
f Maybe x
forall a. Maybe a
Nothing)
   where proceed :: Await (Maybe a) a -> Identity a
proceed (Await Maybe a -> a
f) = a -> Identity a
forall a. a -> Identity a
Identity (Maybe a -> a
f Maybe a
forall a. Maybe a
Nothing)
weaveAwaitMaybeYield Weaver (Await (Maybe x)) (Yield x) Identity m r1 r2 (r1, r2)
_ (Right r1
r1) (Left (Yield x
_ Coroutine (Yield x) m r2
c)) = (r2 -> (r1, r2))
-> Coroutine Identity m r2 -> Coroutine Identity m (r1, r2)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((,) r1
r1) (Coroutine Identity m r2 -> Coroutine Identity m (r1, r2))
-> Coroutine Identity m r2 -> Coroutine Identity m (r1, r2)
forall a b. (a -> b) -> a -> b
$ (forall y. Yield x y -> Identity y)
-> Coroutine (Yield x) m r2 -> Coroutine Identity m r2
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. Yield x y -> Identity y
forall x a. Yield x a -> Identity a
discardYield Coroutine (Yield x) m r2
c
   where discardYield :: Yield x a -> Identity a
discardYield (Yield x
_ a
c) = a -> Identity a
forall a. a -> Identity a
Identity a
c
weaveAwaitMaybeYield Weaver (Await (Maybe x)) (Yield x) Identity m r1 r2 (r1, r2)
_ (Right r1
r1) (Right r2
r2) = (r1, r2) -> Coroutine Identity m (r1, r2)
forall (m :: * -> *) a. Monad m => a -> m a
return (r1
r1, r2
r2)

-- | Weaves two complementary 'Request' coroutine suspensions into a coroutine 'yield'ing both requests. If one
-- coroutine terminates before the other, the remaining coroutine is fed the appropriate  default value argument.
weaveRequests :: Monad m => x -> y -> WeaveStepper (Request x y) (Request y x) (Yield (x, y)) m r1 r2 (r1, r2)
weaveRequests :: x
-> y
-> WeaveStepper
     (Request x y) (Request y x) (Yield (x, y)) m r1 r2 (r1, r2)
weaveRequests x
_ y
_ Weaver (Request x y) (Request y x) (Yield (x, y)) m r1 r2 (r1, r2)
weave (Left (Request x
x y -> Coroutine (Request x y) m r1
f)) (Left (Request y
y x -> Coroutine (Request y x) m r2
g)) = (x, y) -> Coroutine (Yield (x, y)) m ()
forall (m :: * -> *) x. Monad m => x -> Coroutine (Yield x) m ()
yield (x
x, y
y) Coroutine (Yield (x, y)) m ()
-> Coroutine (Yield (x, y)) m (r1, r2)
-> Coroutine (Yield (x, y)) m (r1, r2)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Weaver (Request x y) (Request y x) (Yield (x, y)) m r1 r2 (r1, r2)
weave (y -> Coroutine (Request x y) m r1
f y
y) (x -> Coroutine (Request y x) m r2
g x
x)
weaveRequests x
_ y
y Weaver (Request x y) (Request y x) (Yield (x, y)) m r1 r2 (r1, r2)
weave (Left Request x y (Coroutine (Request x y) m r1)
s1) (Right r2
r2) = (r1 -> (r1, r2))
-> Coroutine (Yield (x, y)) m r1
-> Coroutine (Yield (x, y)) m (r1, r2)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((r1 -> r2 -> (r1, r2)) -> r2 -> r1 -> (r1, r2)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) r2
r2) (Coroutine (Yield (x, y)) m r1
 -> Coroutine (Yield (x, y)) m (r1, r2))
-> Coroutine (Yield (x, y)) m r1
-> Coroutine (Yield (x, y)) m (r1, r2)
forall a b. (a -> b) -> a -> b
$ (forall y. Request x y y -> Yield (x, y) y)
-> Coroutine (Request x y) m r1 -> Coroutine (Yield (x, y)) m r1
forall (s :: * -> *) (m :: * -> *) (s' :: * -> *) x.
(Functor s, Monad m) =>
(forall y. s y -> s' y) -> Coroutine s m x -> Coroutine s' m x
mapSuspension (y -> Request x y y -> Yield (x, y) y
forall response a y.
response -> Request a response y -> Yield (a, response) y
defaultResponse y
y) (Request x y (Coroutine (Request x y) m r1)
-> Coroutine (Request x y) m r1
forall (m :: * -> *) (s :: * -> *) x.
(Monad m, Functor s) =>
s (Coroutine s m x) -> Coroutine s m x
suspend Request x y (Coroutine (Request x y) m r1)
s1)
   where defaultResponse :: response -> Request a response y -> Yield (a, response) y
defaultResponse response
a (Request a
b response -> y
f) = (a, response) -> y -> Yield (a, response) y
forall x y. x -> y -> Yield x y
Yield (a
b, response
a) (response -> y
f response
a)
weaveRequests x
x y
_ Weaver (Request x y) (Request y x) (Yield (x, y)) m r1 r2 (r1, r2)
weave (Right r1
r1) (Left Request y x (Coroutine (Request y x) m r2)
s2) = (r2 -> (r1, r2))
-> Coroutine (Yield (x, y)) m r2
-> Coroutine (Yield (x, y)) m (r1, r2)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((,) r1
r1) (Coroutine (Yield (x, y)) m r2
 -> Coroutine (Yield (x, y)) m (r1, r2))
-> Coroutine (Yield (x, y)) m r2
-> Coroutine (Yield (x, y)) m (r1, r2)
forall a b. (a -> b) -> a -> b
$ (forall y. Request y x y -> Yield (x, y) y)
-> Coroutine (Request y x) m r2 -> Coroutine (Yield (x, y)) m r2
forall (s :: * -> *) (m :: * -> *) (s' :: * -> *) x.
(Functor s, Monad m) =>
(forall y. s y -> s' y) -> Coroutine s m x -> Coroutine s' m x
mapSuspension (x -> Request y x y -> Yield (x, y) y
forall response b y.
response -> Request b response y -> Yield (response, b) y
defaultResponse x
x) (Request y x (Coroutine (Request y x) m r2)
-> Coroutine (Request y x) m r2
forall (m :: * -> *) (s :: * -> *) x.
(Monad m, Functor s) =>
s (Coroutine s m x) -> Coroutine s m x
suspend Request y x (Coroutine (Request y x) m r2)
s2)
   where defaultResponse :: response -> Request b response y -> Yield (response, b) y
defaultResponse response
a (Request b
b response -> y
f) = (response, b) -> y -> Yield (response, b) y
forall x y. x -> y -> Yield x y
Yield (response
a, b
b) (response -> y
f response
a)
weaveRequests x
_ y
_ Weaver (Request x y) (Request y x) (Yield (x, y)) m r1 r2 (r1, r2)
weave (Right r1
r1) (Right r2
r2) = (r1, r2) -> Coroutine (Yield (x, y)) m (r1, r2)
forall (m :: * -> *) a. Monad m => a -> m a
return (r1
r1, r2
r2)

-- | The consumer coroutine requests input through 'ReadRequest' and gets 'ReadingResult' in response. The producer
-- coroutine receives the unconsumed portion of its last requested chunk as response.
weaveReadWriteRequests :: (Monad m, Monoid x) => WeaveStepper (ReadRequest x) (Request x x) Identity m r1 r2 (r1, r2)
weaveReadWriteRequests :: WeaveStepper
  (ReadRequest x) (Request x x) Identity m r1 r2 (r1, r2)
weaveReadWriteRequests Weaver (ReadRequest x) (Request x x) Identity m r1 r2 (r1, r2)
_ (Right r1
r1) (Right r2
r2) = (r1, r2) -> Coroutine Identity m (r1, r2)
forall (m :: * -> *) a. Monad m => a -> m a
return (r1
r1, r2
r2)
weaveReadWriteRequests Weaver (ReadRequest x) (Request x x) Identity m r1 r2 (r1, r2)
_ (Left (ReadRequest Reader x py y
p y
eof ReadingResult x py y -> Coroutine (ReadRequest x) m r1
c)) (Right r2
r2) =
   (forall y. ReadRequest x y -> Identity y)
-> Coroutine (ReadRequest x) m (r1, r2)
-> Coroutine Identity m (r1, r2)
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. ReadRequest x y -> Identity y
forall x z. ReadRequest x z -> Identity z
eofRequest (Coroutine (ReadRequest x) m (r1, r2)
 -> Coroutine Identity m (r1, r2))
-> Coroutine (ReadRequest x) m (r1, r2)
-> Coroutine Identity m (r1, r2)
forall a b. (a -> b) -> a -> b
$ (r1 -> (r1, r2))
-> Coroutine (ReadRequest x) m r1
-> Coroutine (ReadRequest x) m (r1, r2)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (\r1
r1-> (r1
r1, r2
r2)) (Coroutine (ReadRequest x) m r1
 -> Coroutine (ReadRequest x) m (r1, r2))
-> Coroutine (ReadRequest x) m r1
-> Coroutine (ReadRequest x) m (r1, r2)
forall a b. (a -> b) -> a -> b
$ ReadingResult x py y -> Coroutine (ReadRequest x) m r1
c (ReadingResult x py y -> Coroutine (ReadRequest x) m r1)
-> ReadingResult x py y -> Coroutine (ReadRequest x) m r1
forall a b. (a -> b) -> a -> b
$ y -> ReadingResult x py y
forall x py y. y -> ReadingResult x py y
FinalResult y
eof
   where eofRequest :: ReadRequest x z -> Identity z
eofRequest (ReadRequest Reader x py y
_ y
eof ReadingResult x py y -> z
c) = z -> Identity z
forall a. a -> Identity a
Identity (ReadingResult x py y -> z
c (ReadingResult x py y -> z) -> ReadingResult x py y -> z
forall a b. (a -> b) -> a -> b
$ y -> ReadingResult x py y
forall x py y. y -> ReadingResult x py y
FinalResult y
eof)
weaveReadWriteRequests Weaver (ReadRequest x) (Request x x) Identity m r1 r2 (r1, r2)
_ (Right r1
r1) (Left (Request x
chunk x -> Coroutine (Request x x) m r2
c)) =
   (forall y. Request x x y -> Identity y)
-> Coroutine (Request x x) m (r1, r2)
-> Coroutine Identity m (r1, r2)
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. Request x x y -> Identity y
forall response a. Request response response a -> Identity a
reflectRequest (Coroutine (Request x x) m (r1, r2)
 -> Coroutine Identity m (r1, r2))
-> Coroutine (Request x x) m (r1, r2)
-> Coroutine Identity m (r1, r2)
forall a b. (a -> b) -> a -> b
$ (r2 -> (r1, r2))
-> Coroutine (Request x x) m r2
-> Coroutine (Request x x) m (r1, r2)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((,) r1
r1) (Coroutine (Request x x) m r2
 -> Coroutine (Request x x) m (r1, r2))
-> Coroutine (Request x x) m r2
-> Coroutine (Request x x) m (r1, r2)
forall a b. (a -> b) -> a -> b
$ x -> Coroutine (Request x x) m r2
c x
chunk
   where reflectRequest :: Request response response a -> Identity a
reflectRequest (Request response
chunk response -> a
c) = a -> Identity a
forall a. a -> Identity a
Identity (response -> a
c response
chunk)
weaveReadWriteRequests Weaver (ReadRequest x) (Request x x) Identity m r1 r2 (r1, r2)
weave (Left (ReadRequest Reader x py y
p y
_ ReadingResult x py y -> Coroutine (ReadRequest x) m r1
c1)) (Left (Request x
xs x -> Coroutine (Request x x) m r2
c2)) =
   case Reader x py y
p x
xs
   of Final x
s y
r -> Weaver (ReadRequest x) (Request x x) Identity m r1 r2 (r1, r2)
weave (ReadingResult x py y -> Coroutine (ReadRequest x) m r1
c1 (ReadingResult x py y -> Coroutine (ReadRequest x) m r1)
-> ReadingResult x py y -> Coroutine (ReadRequest x) m r1
forall a b. (a -> b) -> a -> b
$ y -> ReadingResult x py y
forall x py y. y -> ReadingResult x py y
FinalResult y
r) (Request x x (Coroutine (Request x x) m r2)
-> Coroutine (Request x x) m r2
forall (m :: * -> *) (s :: * -> *) x.
(Monad m, Functor s) =>
s (Coroutine s m x) -> Coroutine s m x
suspend (Request x x (Coroutine (Request x x) m r2)
 -> Coroutine (Request x x) m r2)
-> Request x x (Coroutine (Request x x) m r2)
-> Coroutine (Request x x) m r2
forall a b. (a -> b) -> a -> b
$ x
-> (x -> Coroutine (Request x x) m r2)
-> Request x x (Coroutine (Request x x) m r2)
forall request response x.
request -> (response -> x) -> Request request response x
Request x
s x -> Coroutine (Request x x) m r2
c2)
      Advance Reader x py y
p' y
_ py
rp -> Weaver (ReadRequest x) (Request x x) Identity m r1 r2 (r1, r2)
weave (ReadingResult x py y -> Coroutine (ReadRequest x) m r1
c1 (ReadingResult x py y -> Coroutine (ReadRequest x) m r1)
-> ReadingResult x py y -> Coroutine (ReadRequest x) m r1
forall a b. (a -> b) -> a -> b
$ py -> Reader x py y -> ReadingResult x py y
forall x py y. py -> Reader x py y -> ReadingResult x py y
ResultPart py
rp Reader x py y
p') (x -> Coroutine (Request x x) m r2
c2 x
forall a. Monoid a => a
mempty)
      Deferred Reader x py y
p' y
eof -> Weaver (ReadRequest x) (Request x x) Identity m r1 r2 (r1, r2)
weave (ReadRequest x (Coroutine (ReadRequest x) m r1)
-> Coroutine (ReadRequest x) m r1
forall (m :: * -> *) (s :: * -> *) x.
(Monad m, Functor s) =>
s (Coroutine s m x) -> Coroutine s m x
suspend (ReadRequest x (Coroutine (ReadRequest x) m r1)
 -> Coroutine (ReadRequest x) m r1)
-> ReadRequest x (Coroutine (ReadRequest x) m r1)
-> Coroutine (ReadRequest x) m r1
forall a b. (a -> b) -> a -> b
$ Reader x py y
-> y
-> (ReadingResult x py y -> Coroutine (ReadRequest x) m r1)
-> ReadRequest x (Coroutine (ReadRequest x) m r1)
forall x z a py y.
Reader x py y
-> y -> (ReadingResult x py y -> z) -> ReadRequest x z
ReadRequest Reader x py y
p' y
eof ReadingResult x py y -> Coroutine (ReadRequest x) m r1
c1) (x -> Coroutine (Request x x) m r2
c2 x
forall a. Monoid a => a
mempty)

-- | Like 'weaveReadWriteRequests' but for nested coroutines.
weaveNestedReadWriteRequests :: (Monad m, Functor s, Monoid x) =>
                                NestWeaveStepper s (ReadRequest x) (Request x x) m r1 r2 (r1, r2)
weaveNestedReadWriteRequests :: NestWeaveStepper s (ReadRequest x) (Request x x) m r1 r2 (r1, r2)
weaveNestedReadWriteRequests Weaver
  (Sum s (ReadRequest x)) (Sum s (Request x x)) s m r1 r2 (r1, r2)
_ (Right r1
r1) (Right r2
r2) = (r1, r2) -> Coroutine s m (r1, r2)
forall (m :: * -> *) a. Monad m => a -> m a
return (r1
r1, r2
r2)
weaveNestedReadWriteRequests Weaver
  (Sum s (ReadRequest x)) (Sum s (Request x x)) s m r1 r2 (r1, r2)
weave (Left (InL s (Coroutine (Sum s (ReadRequest x)) m r1)
s)) Either
  (Sum s (Request x x) (Coroutine (Sum s (Request x x)) m r2)) r2
cs2 =
   s (Coroutine s m (r1, r2)) -> Coroutine s m (r1, r2)
forall (m :: * -> *) (s :: * -> *) x.
(Monad m, Functor s) =>
s (Coroutine s m x) -> Coroutine s m x
suspend (s (Coroutine s m (r1, r2)) -> Coroutine s m (r1, r2))
-> s (Coroutine s m (r1, r2)) -> Coroutine s m (r1, r2)
forall a b. (a -> b) -> a -> b
$ (Coroutine (Sum s (ReadRequest x)) m r1 -> Coroutine s m (r1, r2))
-> s (Coroutine (Sum s (ReadRequest x)) m r1)
-> s (Coroutine s m (r1, r2))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Weaver
  (Sum s (ReadRequest x)) (Sum s (Request x x)) s m r1 r2 (r1, r2)
-> Coroutine (Sum s (Request x x)) m r2
-> Coroutine (Sum s (ReadRequest x)) m r1
-> Coroutine s m (r1, r2)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Weaver
  (Sum s (ReadRequest x)) (Sum s (Request x x)) s m r1 r2 (r1, r2)
weave (m (Either
     (Sum s (Request x x) (Coroutine (Sum s (Request x x)) m r2)) r2)
-> Coroutine (Sum s (Request x x)) m r2
forall (s :: * -> *) (m :: * -> *) r.
m (Either (s (Coroutine s m r)) r) -> Coroutine s m r
Coroutine (m (Either
      (Sum s (Request x x) (Coroutine (Sum s (Request x x)) m r2)) r2)
 -> Coroutine (Sum s (Request x x)) m r2)
-> m (Either
        (Sum s (Request x x) (Coroutine (Sum s (Request x x)) m r2)) r2)
-> Coroutine (Sum s (Request x x)) m r2
forall a b. (a -> b) -> a -> b
$ Either
  (Sum s (Request x x) (Coroutine (Sum s (Request x x)) m r2)) r2
-> m (Either
        (Sum s (Request x x) (Coroutine (Sum s (Request x x)) m r2)) r2)
forall (m :: * -> *) a. Monad m => a -> m a
return Either
  (Sum s (Request x x) (Coroutine (Sum s (Request x x)) m r2)) r2
cs2)) s (Coroutine (Sum s (ReadRequest x)) m r1)
s
weaveNestedReadWriteRequests Weaver
  (Sum s (ReadRequest x)) (Sum s (Request x x)) s m r1 r2 (r1, r2)
weave Either
  (Sum s (ReadRequest x) (Coroutine (Sum s (ReadRequest x)) m r1)) r1
cs1 (Left (InL s (Coroutine (Sum s (Request x x)) m r2)
s)) =
   s (Coroutine s m (r1, r2)) -> Coroutine s m (r1, r2)
forall (m :: * -> *) (s :: * -> *) x.
(Monad m, Functor s) =>
s (Coroutine s m x) -> Coroutine s m x
suspend (s (Coroutine s m (r1, r2)) -> Coroutine s m (r1, r2))
-> s (Coroutine s m (r1, r2)) -> Coroutine s m (r1, r2)
forall a b. (a -> b) -> a -> b
$ (Coroutine (Sum s (Request x x)) m r2 -> Coroutine s m (r1, r2))
-> s (Coroutine (Sum s (Request x x)) m r2)
-> s (Coroutine s m (r1, r2))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Weaver
  (Sum s (ReadRequest x)) (Sum s (Request x x)) s m r1 r2 (r1, r2)
weave (m (Either
     (Sum s (ReadRequest x) (Coroutine (Sum s (ReadRequest x)) m r1))
     r1)
-> Coroutine (Sum s (ReadRequest x)) m r1
forall (s :: * -> *) (m :: * -> *) r.
m (Either (s (Coroutine s m r)) r) -> Coroutine s m r
Coroutine (m (Either
      (Sum s (ReadRequest x) (Coroutine (Sum s (ReadRequest x)) m r1))
      r1)
 -> Coroutine (Sum s (ReadRequest x)) m r1)
-> m (Either
        (Sum s (ReadRequest x) (Coroutine (Sum s (ReadRequest x)) m r1))
        r1)
-> Coroutine (Sum s (ReadRequest x)) m r1
forall a b. (a -> b) -> a -> b
$ Either
  (Sum s (ReadRequest x) (Coroutine (Sum s (ReadRequest x)) m r1)) r1
-> m (Either
        (Sum s (ReadRequest x) (Coroutine (Sum s (ReadRequest x)) m r1))
        r1)
forall (m :: * -> *) a. Monad m => a -> m a
return Either
  (Sum s (ReadRequest x) (Coroutine (Sum s (ReadRequest x)) m r1)) r1
cs1)) s (Coroutine (Sum s (Request x x)) m r2)
s
weaveNestedReadWriteRequests Weaver
  (Sum s (ReadRequest x)) (Sum s (Request x x)) s m r1 r2 (r1, r2)
_ (Left (InR (ReadRequest Reader x py y
p y
eof ReadingResult x py y -> Coroutine (Sum s (ReadRequest x)) m r1
c))) (Right r2
r2) =
   (r1 -> (r1, r2)) -> Coroutine s m r1 -> Coroutine s m (r1, r2)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (\r1
r1-> (r1
r1, r2
r2)) (Coroutine s m r1 -> Coroutine s m (r1, r2))
-> Coroutine s m r1 -> Coroutine s m (r1, r2)
forall a b. (a -> b) -> a -> b
$ (ReadRequest x (Coroutine (Sum s (ReadRequest x)) m r1)
 -> Coroutine (Sum s (ReadRequest x)) m r1)
-> Coroutine (Sum s (ReadRequest x)) m r1 -> Coroutine s m r1
forall (s1 :: * -> *) (s2 :: * -> *) (m :: * -> *) x.
(Functor s1, Functor s2, Monad m) =>
(s2 (Coroutine (Sum s1 s2) m x) -> Coroutine (Sum s1 s2) m x)
-> Coroutine (Sum s1 s2) m x -> Coroutine s1 m x
pogoStickNested ReadRequest x (Coroutine (Sum s (ReadRequest x)) m r1)
-> Coroutine (Sum s (ReadRequest x)) m r1
forall x p. ReadRequest x p -> p
eofRequest (Coroutine (Sum s (ReadRequest x)) m r1 -> Coroutine s m r1)
-> Coroutine (Sum s (ReadRequest x)) m r1 -> Coroutine s m r1
forall a b. (a -> b) -> a -> b
$ ReadingResult x py y -> Coroutine (Sum s (ReadRequest x)) m r1
c (ReadingResult x py y -> Coroutine (Sum s (ReadRequest x)) m r1)
-> ReadingResult x py y -> Coroutine (Sum s (ReadRequest x)) m r1
forall a b. (a -> b) -> a -> b
$ y -> ReadingResult x py y
forall x py y. y -> ReadingResult x py y
FinalResult y
eof
   where eofRequest :: ReadRequest x p -> p
eofRequest (ReadRequest Reader x py y
_ y
eof ReadingResult x py y -> p
c) = ReadingResult x py y -> p
c (ReadingResult x py y -> p) -> ReadingResult x py y -> p
forall a b. (a -> b) -> a -> b
$ y -> ReadingResult x py y
forall x py y. y -> ReadingResult x py y
FinalResult y
eof
weaveNestedReadWriteRequests Weaver
  (Sum s (ReadRequest x)) (Sum s (Request x x)) s m r1 r2 (r1, r2)
_ (Right r1
r1) (Left (InR (Request x
chunk x -> Coroutine (Sum s (Request x x)) m r2
c))) =
   (r2 -> (r1, r2)) -> Coroutine s m r2 -> Coroutine s m (r1, r2)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((,) r1
r1) (Coroutine s m r2 -> Coroutine s m (r1, r2))
-> Coroutine s m r2 -> Coroutine s m (r1, r2)
forall a b. (a -> b) -> a -> b
$ (Request x x (Coroutine (Sum s (Request x x)) m r2)
 -> Coroutine (Sum s (Request x x)) m r2)
-> Coroutine (Sum s (Request x x)) m r2 -> Coroutine s m r2
forall (s1 :: * -> *) (s2 :: * -> *) (m :: * -> *) x.
(Functor s1, Functor s2, Monad m) =>
(s2 (Coroutine (Sum s1 s2) m x) -> Coroutine (Sum s1 s2) m x)
-> Coroutine (Sum s1 s2) m x -> Coroutine s1 m x
pogoStickNested Request x x (Coroutine (Sum s (Request x x)) m r2)
-> Coroutine (Sum s (Request x x)) m r2
forall response x. Request response response x -> x
reflectRequest (Coroutine (Sum s (Request x x)) m r2 -> Coroutine s m r2)
-> Coroutine (Sum s (Request x x)) m r2 -> Coroutine s m r2
forall a b. (a -> b) -> a -> b
$ x -> Coroutine (Sum s (Request x x)) m r2
c x
chunk
   where reflectRequest :: Request response response x -> x
reflectRequest (Request response
chunk response -> x
c) = response -> x
c response
chunk
weaveNestedReadWriteRequests Weaver
  (Sum s (ReadRequest x)) (Sum s (Request x x)) s m r1 r2 (r1, r2)
weave (Left (InR (ReadRequest Reader x py y
p y
_ ReadingResult x py y -> Coroutine (Sum s (ReadRequest x)) m r1
c1))) (Left (InR (Request x
xs x -> Coroutine (Sum s (Request x x)) m r2
c2))) =
   case Reader x py y
p x
xs
   of Final x
s y
r -> Weaver
  (Sum s (ReadRequest x)) (Sum s (Request x x)) s m r1 r2 (r1, r2)
weave (ReadingResult x py y -> Coroutine (Sum s (ReadRequest x)) m r1
c1 (ReadingResult x py y -> Coroutine (Sum s (ReadRequest x)) m r1)
-> ReadingResult x py y -> Coroutine (Sum s (ReadRequest x)) m r1
forall a b. (a -> b) -> a -> b
$ y -> ReadingResult x py y
forall x py y. y -> ReadingResult x py y
FinalResult y
r) (Sum s (Request x x) (Coroutine (Sum s (Request x x)) m r2)
-> Coroutine (Sum s (Request x x)) m r2
forall (m :: * -> *) (s :: * -> *) x.
(Monad m, Functor s) =>
s (Coroutine s m x) -> Coroutine s m x
suspend (Sum s (Request x x) (Coroutine (Sum s (Request x x)) m r2)
 -> Coroutine (Sum s (Request x x)) m r2)
-> Sum s (Request x x) (Coroutine (Sum s (Request x x)) m r2)
-> Coroutine (Sum s (Request x x)) m r2
forall a b. (a -> b) -> a -> b
$ Request x x (Coroutine (Sum s (Request x x)) m r2)
-> Sum s (Request x x) (Coroutine (Sum s (Request x x)) m r2)
forall k (f :: k -> *) (g :: k -> *) (a :: k). g a -> Sum f g a
InR (Request x x (Coroutine (Sum s (Request x x)) m r2)
 -> Sum s (Request x x) (Coroutine (Sum s (Request x x)) m r2))
-> Request x x (Coroutine (Sum s (Request x x)) m r2)
-> Sum s (Request x x) (Coroutine (Sum s (Request x x)) m r2)
forall a b. (a -> b) -> a -> b
$ x
-> (x -> Coroutine (Sum s (Request x x)) m r2)
-> Request x x (Coroutine (Sum s (Request x x)) m r2)
forall request response x.
request -> (response -> x) -> Request request response x
Request x
s x -> Coroutine (Sum s (Request x x)) m r2
c2)
      Advance Reader x py y
p' y
_ py
rp -> Weaver
  (Sum s (ReadRequest x)) (Sum s (Request x x)) s m r1 r2 (r1, r2)
weave (ReadingResult x py y -> Coroutine (Sum s (ReadRequest x)) m r1
c1 (ReadingResult x py y -> Coroutine (Sum s (ReadRequest x)) m r1)
-> ReadingResult x py y -> Coroutine (Sum s (ReadRequest x)) m r1
forall a b. (a -> b) -> a -> b
$ py -> Reader x py y -> ReadingResult x py y
forall x py y. py -> Reader x py y -> ReadingResult x py y
ResultPart py
rp Reader x py y
p') (x -> Coroutine (Sum s (Request x x)) m r2
c2 x
forall a. Monoid a => a
mempty)
      Deferred Reader x py y
p' y
eof -> Weaver
  (Sum s (ReadRequest x)) (Sum s (Request x x)) s m r1 r2 (r1, r2)
weave (Sum s (ReadRequest x) (Coroutine (Sum s (ReadRequest x)) m r1)
-> Coroutine (Sum s (ReadRequest x)) m r1
forall (m :: * -> *) (s :: * -> *) x.
(Monad m, Functor s) =>
s (Coroutine s m x) -> Coroutine s m x
suspend (Sum s (ReadRequest x) (Coroutine (Sum s (ReadRequest x)) m r1)
 -> Coroutine (Sum s (ReadRequest x)) m r1)
-> Sum s (ReadRequest x) (Coroutine (Sum s (ReadRequest x)) m r1)
-> Coroutine (Sum s (ReadRequest x)) m r1
forall a b. (a -> b) -> a -> b
$ ReadRequest x (Coroutine (Sum s (ReadRequest x)) m r1)
-> Sum s (ReadRequest x) (Coroutine (Sum s (ReadRequest x)) m r1)
forall k (f :: k -> *) (g :: k -> *) (a :: k). g a -> Sum f g a
InR (ReadRequest x (Coroutine (Sum s (ReadRequest x)) m r1)
 -> Sum s (ReadRequest x) (Coroutine (Sum s (ReadRequest x)) m r1))
-> ReadRequest x (Coroutine (Sum s (ReadRequest x)) m r1)
-> Sum s (ReadRequest x) (Coroutine (Sum s (ReadRequest x)) m r1)
forall a b. (a -> b) -> a -> b
$ Reader x py y
-> y
-> (ReadingResult x py y -> Coroutine (Sum s (ReadRequest x)) m r1)
-> ReadRequest x (Coroutine (Sum s (ReadRequest x)) m r1)
forall x z a py y.
Reader x py y
-> y -> (ReadingResult x py y -> z) -> ReadRequest x z
ReadRequest Reader x py y
p' y
eof ReadingResult x py y -> Coroutine (Sum s (ReadRequest x)) m r1
c1) (x -> Coroutine (Sum s (Request x x)) m r2
c2 x
forall a. Monoid a => a
mempty)