diff --git a/Control/Cofunctor/Ticker.hs b/Control/Cofunctor/Ticker.hs
new file mode 100644
--- /dev/null
+++ b/Control/Cofunctor/Ticker.hs
@@ -0,0 +1,85 @@
+{- 
+    Copyright 2010 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 Ticker cofunctor, useful for 'ticking off' a prefix of the input.
+-- 
+
+module Control.Cofunctor.Ticker
+   (
+    -- * The Ticker type
+    Ticker(Ticker), 
+    -- * Using a Ticker
+    cofmap, splitTicked, 
+    -- * Various Ticker constructors
+    tickNone, tickOne, tickCount, tickPrefixOf, tickWhilePrefixOf, tickWhile, tickUntil, tickAll, andThen
+   )
+where
+
+-- | This is a cofunctor data type for selecting a prefix of an input stream. If the next input item is acceptable, the
+-- ticker function returns the ticker for the rest of the stream. If not, it returns 'Nothing'.
+newtype Ticker x = Ticker (x -> Maybe (Ticker x))
+
+-- | 'Ticker' happens to be a cofunctor, but there is no standard class declaration to declare it an instance of.
+cofmap :: (x -> y) -> Ticker y -> Ticker x
+cofmap f (Ticker g) = Ticker (fmap (cofmap f) . g . f)
+
+-- | Extracts a list prefix accepted by the 'Ticker' argument. Returns the modified ticker, the prefix, and the
+-- remainder of the list.
+splitTicked :: Ticker x -> [x] -> (Ticker x, [x], [x])
+splitTicked t [] = (t, [], [])
+splitTicked t@(Ticker f) l@(x:rest) =
+   maybe (t, [], l) (\t' -> let (t'', xs1, xs2) = splitTicked t' rest in (t'', x:xs1, xs2)) (f x)
+
+-- | A ticker that accepts no input.
+tickNone :: Ticker x
+tickNone = Ticker (const Nothing)
+
+-- | A ticker that accepts a single input item.
+tickOne :: Ticker x
+tickOne = Ticker (const $ Just tickNone)
+
+-- | A ticker that accepts a given number of input items.
+tickCount :: Int -> Ticker x
+tickCount n | n > 0 = Ticker (const $ Just $ tickCount (pred n))
+            | otherwise = tickNone
+
+-- | A ticker that accepts the longest prefix of input that matches a prefix of the argument list.
+tickPrefixOf :: Eq x => [x] -> Ticker x
+tickPrefixOf list = tickWhilePrefixOf (map (==) list)
+
+-- | A ticker that accepts a prefix of input as long as each item satisfies the predicate at the same position in the
+-- argument list. The length of the predicate list thus determines the maximum number of acepted values.
+tickWhilePrefixOf :: [x -> Bool] -> Ticker x
+tickWhilePrefixOf (p : tail) = Ticker $ \x-> if p x then Just (tickWhilePrefixOf tail) else Nothing
+tickWhilePrefixOf [] = tickNone
+
+-- | A ticker that accepts all input as long as it matches the given predicate.
+tickWhile :: (x -> Bool) -> Ticker x
+tickWhile p = t
+   where t = Ticker (\x-> if p x then Just t else Nothing)
+
+-- | A ticker that accepts all input items until one matches the given predicate.
+tickUntil :: (x -> Bool) -> Ticker x
+tickUntil p = t
+   where t = Ticker (\x-> if p x then Nothing else Just t)
+
+-- | A ticker that accepts all input.
+tickAll :: Ticker x
+tickAll = Ticker (const $ Just tickAll)
+
+-- | Sequential ticker combinator: when the first argument ticker stops ticking, the second takes over.
+andThen :: Ticker x -> Ticker x -> Ticker x
+andThen (Ticker t1) t@(Ticker t2) = Ticker (\x-> maybe (t2 x) (\t1'-> Just (andThen t1' t)) (t1 x))
diff --git a/Control/Monad/Coroutine.hs b/Control/Monad/Coroutine.hs
--- a/Control/Monad/Coroutine.hs
+++ b/Control/Monad/Coroutine.hs
@@ -38,9 +38,10 @@
 -- 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. The function 'seesaw'
--- can be used to run two interleaved computations. Another possible way is to use the functions 'couple' or 'merge' to
--- weave together steps of different coroutines into a single coroutine, which can then be executed by 'pogoStick'.
+-- Multiple concurrent coroutines can be run as well, and this module provides two different ways. Functions 'seesaw'
+-- and 'seesawSteps' can be used to run two interleaved computations. Another possible way is to use the functions
+-- 'couple' or 'merge' to weave together steps of different coroutines into a single coroutine, which can then be
+-- executed by 'pogoStick'.
 -- 
 -- For other uses of trampoline-style coroutines, see
 -- 
@@ -56,14 +57,13 @@
 module Control.Monad.Coroutine
    (
     -- * Coroutine definition
-    Coroutine(Coroutine),
-    resume, suspend,
+    Coroutine(Coroutine, resume), CoroutineStepResult, suspend,
     -- * Coroutine operations
     mapMonad, mapSuspension, 
     -- * Running Coroutine computations
-    Naught, runCoroutine, pogoStick, foldRun, seesaw, SeesawResolver(..),
+    Naught, runCoroutine, bounce, pogoStick, foldRun, seesaw, SeesawResolver(..), seesawSteps,
     -- * Coupled Coroutine computations
-    SomeFunctor(..), composePair,
+    PairBinder, sequentialBinder, parallelBinder, liftBinder, SomeFunctor(..), composePair,
     couple, merge
    )
 where
@@ -93,11 +93,7 @@
 --   t >>= f = Coroutine (resume t >>= either (return . Left . fmap (>>= f)) (resume . f))
 
 instance (Functor s, MonadParallel m) => MonadParallel (Coroutine s m) where
-   bindM2 f t1 t2 = Coroutine (bindM2 combine (resume t1) (resume t2)) where
-      combine (Right x) (Right y) = resume (f x y)
-      combine (Left s) (Right y) = return $ Left (fmap (flip f y =<<) s)
-      combine (Right x) (Left s) = return $ Left (fmap (f x =<<) s)
-      combine (Left s1) (Left s2) = return $ Left (fmap (bindM2 f $ suspend s1) s2)
+   bindM2 = liftBinder bindM2
 
 instance Functor s => MonadTrans (Coroutine s) where
    lift = Coroutine . liftM Right
@@ -143,31 +139,55 @@
 runCoroutine :: Monad m => Coroutine Naught m x -> m x
 runCoroutine = pogoStick (error "runCoroutine can run only a non-suspending coroutine!")
 
--- | Run a suspendable 'Coroutine', using a function that extracts the coroutine resumption from each suspension.
+-- | 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 spring c = lift (resume c) >>= either spring 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 reveal t = resume t
-                     >>= \s-> case s 
-                              of Right result -> return result
-                                 Left c -> pogoStick reveal (reveal c)
+pogoStick spring c = resume c >>= either (pogoStick spring . spring) 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 f a t = resume t
+foldRun f a c = resume c
                 >>= \s-> case s 
                          of Right result -> return (a, result)
                             Left c -> uncurry (foldRun f) (f a c)
 
--- | Weaves two coroutines into one. The two coroutines suspend and resume in lockstep.
+-- | Type of functions that can bind two monadic values together; used to combine two coroutines' step results.
+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 f mx my = do {x <- mx; y <- my; f x y}
+
+-- | A 'PairBinder' that runs the two steps in parallel.
+parallelBinder :: MonadParallel m => PairBinder m
+parallelBinder = bindM2
+
+-- | Lifting a 'PairBinder' onto a 'Coroutine' monad transformer.
+liftBinder :: forall s m. (Functor s, Monad m) => PairBinder m -> PairBinder (Coroutine s m)
+liftBinder binder f t1 t2 = Coroutine (binder combine (resume t1) (resume t2)) where
+   combine (Right x) (Right y) = resume (f x y)
+   combine (Left s) (Right y) = return $ Left (fmap (flip f y =<<) s)
+   combine (Right x) (Left s) = return $ Left (fmap (f x =<<) s)
+   combine (Left s1) (Left s2) = return $ Left (fmap (liftBinder binder f $ suspend s1) s2)
+
+-- | Weaves two coroutines into one. The two coroutines suspend and resume in lockstep. The combined coroutine suspends
+-- as long as either argument coroutine suspends, and it completes execution when both arguments do.
 couple :: forall s1 s2 m x y r. (Monad m, Functor s1, Functor s2) => 
-          (forall x y r. (x -> y -> m r) -> m x -> m y -> m r)
-       -> Coroutine s1 m x -> Coroutine s2 m y -> Coroutine (SomeFunctor s1 s2) m (x, y)
+          PairBinder m -> Coroutine s1 m x -> Coroutine s2 m y -> Coroutine (SomeFunctor s1 s2) m (x, y)
 couple runPair t1 t2 = Coroutine{resume= runPair proceed (resume t1) (resume t2)} where
-   proceed :: CoroutineStepResult s1 m x -> CoroutineStepResult s2 m y -> m (CoroutineStepResult (SomeFunctor s1 s2) m (x, y))
+   proceed :: CoroutineStepResult s1 m x -> CoroutineStepResult s2 m y
+           -> m (CoroutineStepResult (SomeFunctor s1 s2) m (x, y))
    proceed (Right x) (Right y) = return $ Right (x, y)
-   proceed (Left s1) (Left s2) = return $ Left $ fmap (uncurry (couple runPair)) (Both $ composePair s1 s2)
+   proceed (Left s1) (Left s2) = return $ Left
+                                 $ fmap (uncurry (couple runPair)) (Both $ composePair s1 s2)
    proceed (Right x) (Left s2) = return $ Left $ fmap (couple runPair (return x)) (RightSome s2)
-   proceed (Left s1) (Right y) = return $ Left $ fmap (flip (couple runPair) (return y)) (LeftSome s1)
+   proceed (Left s1) (Right y) = return $ Left
+                                 $ fmap (flip (couple runPair) (return y)) (LeftSome s1)
 
 -- | Weaves a list of coroutines with the same suspension functor type into a single coroutine. The coroutines suspend
 -- and resume in lockstep.
@@ -182,15 +202,15 @@
                                          sequence2 suspensions
 
 -- | A simple record containing the resolver functions for all possible coroutine pair suspensions.
-data SeesawResolver s1 s2 = SeesawResolver {
-   resumeLeft  :: forall t. s1 t -> t,    -- ^ resolves the left suspension functor into the resumption it contains
-   resumeRight :: forall t. s2 t -> t,    -- ^ resolves the right suspension into its resumption
-   resumeAny   :: forall t1 t2 r.
-                  (t1 -> r)       --  ^ continuation to resume only the left suspended coroutine
-               -> (t2 -> r)       --  ^ continuation to resume the right coroutine only
-               -> (t1 -> t2 -> r) --  ^ continuation to resume both coroutines
-               -> s1 t1           --  ^ left suspension
-               -> s2 t2           --  ^ right suspension
+data SeesawResolver s1 s2 s1' s2' = SeesawResolver {
+   resumeLeft  :: forall m t. (Monad m) => s1 (Coroutine s1' m t) -> Coroutine s1' m t,
+   -- ^ resolves the left suspension functor into the resumption it contains
+   resumeRight :: forall m t. (Monad m) => s2 (Coroutine s2' m t) -> Coroutine s2' m t,
+   -- ^ resolves the right suspension into its resumption
+   resumeBoth  :: forall m t1 t2 r. (Monad m) =>
+                  (Coroutine s1' m t1 -> Coroutine s2' m t2 -> r) --  ^ continuation to resume both coroutines
+               -> s1 (Coroutine s1' m t1)                         --  ^ left suspension
+               -> s2 (Coroutine s2' m t2)                         --  ^ right suspension
                -> r
    -- ^ invoked when both coroutines are suspended, resolves both suspensions or either one
 }
@@ -198,13 +218,19 @@
 -- | Runs two coroutines concurrently. The first argument is used to run the next step of each coroutine, the next to
 -- convert the left, right, or both suspensions into the corresponding resumptions.
 seesaw :: (Monad m, Functor s1, Functor s2) => 
-          (forall x y r. (x -> y -> m r) -> m x -> m y -> m r)
-       -> SeesawResolver s1 s2
-       -> Coroutine s1 m x -> Coroutine s2 m y -> m (x, y)
-seesaw runPair resolver t1 t2 = seesaw' t1 t2 where
-   seesaw' t1 t2 = runPair proceed (resume t1) (resume t2)
-   proceed (Right x) (Right y) = return (x, y)
-   proceed (Right x) (Left s2) = seesaw' (return x) (resumeRight resolver s2)
-   proceed (Left s1) (Right y) = seesaw' (resumeLeft resolver s1) (return y)
-   proceed (Left s1) (Left s2) =
-      resumeAny resolver (flip seesaw' (suspend s2)) (seesaw' (suspend s1)) seesaw' s1 s2
+          PairBinder m -> SeesawResolver s1 s2 s1 s2 -> Coroutine s1 m x -> Coroutine s2 m y -> m (x, y)
+seesaw runPair resolver t1 t2 = seesawSteps runPair proceed t1 t2 where
+   proceed cont (Left s1) (Left s2) = resumeBoth resolver cont s1 s2
+   proceed _ (Right x) (Left s2) = liftM ((,) x) $ pogoStick (resumeRight resolver) (resumeRight resolver s2)
+   proceed _ (Left s1) (Right y) = liftM (flip (,) y) $ pogoStick (resumeLeft resolver) (resumeLeft resolver s1)
+   proceed _ (Right x) (Right y) = return (x, y)
+
+-- | Runs two coroutines concurrently. The first argument is used to run the next step of each coroutine, the next to
+-- convert their step results into the corresponding resumptions.
+seesawSteps :: (Monad m, Functor s1, Functor s2) => 
+               PairBinder m
+            -> ((Coroutine s1 m x -> Coroutine s2 m y -> m (x, y)) 
+                -> CoroutineStepResult s1 m x -> CoroutineStepResult s2 m y -> m (x, y))
+            -> Coroutine s1 m x -> Coroutine s2 m y -> m (x, y)
+seesawSteps runPair proceed t1 t2 = seesaw' t1 t2 where
+   seesaw' t1 t2 = runPair (proceed seesaw') (resume t1) (resume t2)
diff --git a/Control/Monad/Coroutine/Nested.hs b/Control/Monad/Coroutine/Nested.hs
--- a/Control/Monad/Coroutine/Nested.hs
+++ b/Control/Monad/Coroutine/Nested.hs
@@ -23,7 +23,7 @@
 -- coroutines.
 -- 
 -- Nestable coroutines of this kind should group their suspension functors into an 'EitherFunctor'. You can adjust a
--- normal suspension, such as the one produced by 'yield', using functions 'mapSuspension' and 'liftOut'. To run nested
+-- normal suspension, such as the one produced by 'yield', using functions 'mapSuspension' and 'liftAncestor'. To run nested
 -- coroutines, use functions 'pogoStickNested', 'seesawNested', and 'coupleNested'.
 
 {-# LANGUAGE ScopedTypeVariables, Rank2Types, MultiParamTypeClasses, TypeFamilies,
@@ -32,9 +32,9 @@
 
 module Control.Monad.Coroutine.Nested
    (
-    pogoStickNested, coupleNested, seesawNested, 
-    AncestorFunctor,
-    liftOut
+    pogoStickNested, coupleNested, seesawNested, seesawNestedSteps,
+    ChildFunctor(..), AncestorFunctor(..),
+    liftParent, liftAncestor
    )
 where
 
@@ -42,8 +42,10 @@
 import Control.Monad.Trans.Class (lift)
 
 import Control.Monad.Coroutine
-import Control.Monad.Coroutine.SuspensionFunctors
+import Control.Monad.Coroutine.SuspensionFunctors (EitherFunctor(..))
 
+import Data.Functor.Compose (Compose(..))
+
 -- | Run a nested 'Coroutine' that can suspend both itself and the current 'Coroutine'.
 pogoStickNested :: forall s1 s2 m x. (Functor s1, Functor s2, Monad m) => 
                    (s2 (Coroutine (EitherFunctor s1 s2) m x) -> Coroutine (EitherFunctor s1 s2) m x)
@@ -55,9 +57,9 @@
                                   Left (LeftF s) -> return (Left (fmap (pogoStickNested reveal) s))
                                   Left (RightF c) -> resume (pogoStickNested reveal (reveal c))}
 
--- | Weaves two nested coroutines into one.
+-- | Much like 'couple', but with two nested coroutines.
 coupleNested :: forall s0 s1 s2 m x y r. (Monad m, Functor s0, Monad s0, Functor s1, Functor s2) => 
-                (forall x y r. (x -> y -> m r) -> m x -> m y -> m r)
+                PairBinder m
              -> Coroutine (EitherFunctor s0 s1) m x -> Coroutine (EitherFunctor s0 s2) m y
              -> Coroutine (EitherFunctor s0 (SomeFunctor s1 s2)) m (x, y)
 coupleNested runPair = coupleNested' where
@@ -65,8 +67,7 @@
    proceed (Right x) (Right y) = Right (x, y)
    proceed (Left (RightF s)) (Right y) = Left $ RightF $ fmap (flip coupleNested' (return y)) (LeftSome s)
    proceed (Right x) (Left (RightF s)) = Left $ RightF $ fmap (coupleNested' (return x)) (RightSome s)
-   proceed (Left (RightF s1)) (Left (RightF s2)) =
-      Left $ RightF $ fmap (uncurry coupleNested') (Both $ composePair s1 s2)
+   proceed (Left (RightF s1)) (Left (RightF s2)) = Left $ RightF $ fmap (uncurry coupleNested') (Both $ composePair s1 s2)
    proceed l (Left (LeftF s)) = Left $ LeftF $ fmap (coupleNested' (Coroutine $ return l)) s
    proceed (Left (LeftF s)) r = Left $ LeftF $ fmap (flip coupleNested' (Coroutine $ return r)) s
 
@@ -74,19 +75,37 @@
 -- If both coroutines try to suspend the current coroutine in the same step, the left coroutine's suspension will have
 -- precedence.
 seesawNested :: (Monad m, Functor s0, Functor s1, Functor s2) =>
-                (forall x y r. (x -> y -> m r) -> m x -> m y -> m r)
-             -> SeesawResolver s1 s2
+                PairBinder m
+             -> SeesawResolver s1 s2 (EitherFunctor s0 s1) (EitherFunctor s0 s2)
              -> Coroutine (EitherFunctor s0 s1) m x -> Coroutine (EitherFunctor s0 s2) m y -> Coroutine s0 m (x, y)
-seesawNested runPair resolver t1 t2 = seesaw' t1 t2 where
+seesawNested runPair resolver t1 t2 = seesawNestedSteps runPair proceed t1 t2 where
+   proceed cont (Left s1) (Left s2) = resumeBoth resolver cont s1 s2
+   proceed _ (Left s) (Right y) = liftM (flip (,) y) $ pogoStickNested (resumeLeft resolver) (resumeLeft resolver s)
+   proceed _ (Right x) (Left s) = liftM ((,) x) $ pogoStickNested (resumeRight resolver) (resumeRight resolver s)
+   proceed _ (Right x) (Right y) = return (x, y)
+
+-- | Like 'seesawSteps', but for nested coroutines that are allowed to suspend the current coroutine as well
+-- as themselves.  If both coroutines try to suspend the current coroutine in the same step, the left coroutine's
+-- suspension will have precedence.
+seesawNestedSteps :: forall m c1 c2 s0 s1 s2 s1' s2' x y. 
+                     (Monad m, Functor s0, Functor s1, Functor s2, 
+                      s1' ~ EitherFunctor s0 s1, s2' ~ EitherFunctor s0 s2,
+                      c1 ~ Coroutine s1' m x, c2 ~ Coroutine s2' m y) =>
+                     PairBinder m
+                  -> ((c1 -> c2 -> Coroutine s0 m (x, y)) 
+                      -> Either (s1 c1) x -> Either (s2 c2) y -> Coroutine s0 m (x, y))
+                  -> c1 -> c2 -> Coroutine s0 m (x, y)
+seesawNestedSteps runPair proceed t1 t2 = seesaw' t1 t2 where
    seesaw' t1 t2 = Coroutine{resume= bouncePair t1 t2}
-   bouncePair t1 t2 = runPair proceed (resume t1) (resume t2)
-   proceed (Left (LeftF s1)) state2 = return $ Left $ fmap ((flip seesaw' (Coroutine $ return state2))) s1
-   proceed state1 (Left (LeftF s2)) = return $ Left $ fmap (seesaw' (Coroutine $ return state1)) s2
-   proceed (Right x) (Right y) = return $ Right (x, y)
-   proceed state1@(Right x) (Left (RightF s2)) = proceed state1 =<< resume (resumeRight resolver s2)
-   proceed (Left (RightF s1)) state2@(Right y) = flip proceed state2 =<< resume (resumeLeft resolver s1)
-   proceed state1@(Left (RightF s1)) state2@(Left (RightF s2)) =
-      resumeAny resolver ((flip proceed state2 =<<) . resume) ((proceed state1 =<<) . resume) bouncePair s1 s2
+   bouncePair t1 t2 = runPair proceed' (resume t1) (resume t2)
+   proceed' :: CoroutineStepResult s1' m x -> CoroutineStepResult s2' m y -> m (CoroutineStepResult s0 m (x, y))
+   proceed' (Left (LeftF s1)) step2 = return $ Left $ fmap ((flip seesaw' (Coroutine $ return step2))) s1
+   proceed' step1 (Left (LeftF s2)) = return $ Left $ fmap (seesaw' (Coroutine $ return step1)) s2
+   proceed' step1 step2 = resume $ proceed seesaw' (local step1) (local step2)
+   local :: forall s x. 
+            CoroutineStepResult (EitherFunctor s0 s) m x -> Either (s (Coroutine (EitherFunctor s0 s) m x)) x
+   local (Left (RightF s)) = Left s
+   local (Right r) = Right r
 
 -- | Class of functors that can contain another functor.
 class Functor c => ChildFunctor c where
@@ -106,6 +125,10 @@
 instance (Functor a, ChildFunctor d, d' ~ Parent d, AncestorFunctor a d') => AncestorFunctor a d where
    liftFunctor = wrap . (liftFunctor :: a x -> d' x)
 
+-- | Converts a coroutine into a child nested coroutine.
+liftParent :: forall m p c x. (Monad m, Functor p, ChildFunctor c, p ~ Parent c) => Coroutine p m x -> Coroutine c m x
+liftParent cort = mapSuspension wrap cort
+
 -- | Converts a coroutine into a descendant nested coroutine.
-liftOut :: forall m a d x. (Monad m, Functor a, AncestorFunctor a d) => Coroutine a m x -> Coroutine d m x
-liftOut cort = mapSuspension liftFunctor cort
+liftAncestor :: forall m a d x. (Monad m, Functor a, AncestorFunctor a d) => Coroutine a m x -> Coroutine d m x
+liftAncestor cort = mapSuspension liftFunctor cort
diff --git a/Control/Monad/Coroutine/SuspensionFunctors.hs b/Control/Monad/Coroutine/SuspensionFunctors.hs
--- a/Control/Monad/Coroutine/SuspensionFunctors.hs
+++ b/Control/Monad/Coroutine/SuspensionFunctors.hs
@@ -14,20 +14,33 @@
     <http://www.gnu.org/licenses/>.
 -}
 
--- | This module defines suspension functors for use with the "Control.Monad.Coroutine" module.
+-- | This module defines some common suspension functors for use with the "Control.Monad.Coroutine" module.
 -- 
 
+{-# LANGUAGE Rank2Types #-}
+
 module Control.Monad.Coroutine.SuspensionFunctors
    (
     -- * Suspension functors
     Yield(Yield), Await(Await), Request(Request), EitherFunctor(LeftF, RightF),
-    yield, await, request
+    yield, await, request,
+    -- * Utility functions
+    concatYields, concatAwaits,
+    -- * Resolvers for running pairs of coroutines
+    awaitYieldResolver, awaitMaybeYieldResolver, awaitYieldChunkResolver, requestsResolver, 
+    tickerYieldResolver, tickerRequestResolver, lazyTickerRequestResolver,
+    liftedTickerYieldResolver, liftedTickerRequestResolver, liftedLazyTickerRequestResolver,
    )
 where
 
-import Control.Monad (Monad)
-import Control.Monad.Coroutine (Coroutine, resume, suspend)
+import Prelude hiding (foldl, foldr)
+import Control.Monad (Monad, liftM)
+import Control.Monad.Trans.Class (MonadTrans(..))
+import Data.Foldable (Foldable, foldl, foldr)
 
+import Control.Monad.Coroutine
+import Control.Cofunctor.Ticker (Ticker, splitTicked)
+
 -- | The 'Yield' functor instance is equivalent to (,) but more descriptive.
 data Yield x y = Yield x y
 instance Functor (Yield x) where
@@ -49,14 +62,139 @@
    fmap f (LeftF l) = LeftF (fmap f l)
    fmap f (RightF r) = RightF (fmap f r)
 
--- | Suspend yielding a value.
+-- | Suspend the current coroutine yielding a value.
 yield :: Monad m => x -> Coroutine (Yield x) m ()
 yield x = suspend (Yield x (return ()))
 
--- | Suspend until a value is provided.
+-- | Suspend the current coroutine until a value is provided.
 await :: Monad m => Coroutine (Await x) m x
 await = suspend (Await return)
 
 -- | Suspend yielding a request and awaiting the response.
 request :: Monad m => x -> Coroutine (Request x y) m y
 request x = suspend (Request x return)
+
+-- | 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 c = Coroutine{resume= resume c >>= foldChunk}
+   where foldChunk (Right r) = return (Right r)
+         foldChunk (Left (Yield s c)) = foldr f (resume $ concatYields c) s
+         f x rest = return (Left $ Yield x (Coroutine 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 c = lift (resume c) >>= either concat return
+   where concat s = do chunk <- await
+                       concatAwaits (feedAll chunk (suspend s))
+
+-- | A 'SeesawResolver' for running two coroutines in parallel, one of which 'await's values while the other 'yield's
+-- them. The yielding coroutine must not terminate before the other one.
+awaitYieldResolver :: SeesawResolver (Await x) (Yield x) s1 s2
+awaitYieldResolver = SeesawResolver {
+   resumeLeft= undefined,
+   resumeRight= \(Yield _ c)-> c,
+   resumeBoth= \cont (Await f) (Yield x c2)-> cont (f x) c2
+}
+
+-- | A 'SeesawResolver' for running two coroutines in parallel, one of which 'await's values while the other 'yield's
+-- them. If the yielding coroutine terminates before the awaiting one, the latter will receive 'Nothing'.
+awaitMaybeYieldResolver :: SeesawResolver (Await (Maybe x)) (Yield x) s1 s2
+awaitMaybeYieldResolver = SeesawResolver {
+   resumeLeft= \(Await f)-> f Nothing,
+   resumeRight= \(Yield _ c)-> c,
+   resumeBoth= \cont (Await f) (Yield x c2)-> cont (f $ Just x) c2
+}
+
+-- | A 'SeesawResolver' for running two coroutines in parallel, one of which 'await's non-empty lists of values while
+-- the other 'yield's them. If the yielding coroutine dies, the awaiting coroutine receives empty lists.
+awaitYieldChunkResolver :: SeesawResolver (Await [x]) (Yield [x]) s1 s2
+awaitYieldChunkResolver = SeesawResolver {
+   resumeLeft= \(Await f)-> f [],
+   resumeRight= \(Yield _ c)-> c,
+   resumeBoth= \cont (Await f) (Yield chunk c2)-> cont (f chunk) c2
+}
+
+-- | A 'SeesawResolver' for running two 'request'ing coroutines in parallel. One coroutine's request becomes the other's
+-- response, and vice versa.
+requestsResolver :: SeesawResolver (Request x y) (Request y x) s1 s2
+requestsResolver = SeesawResolver {
+   resumeLeft= undefined,
+   resumeRight= undefined,
+   resumeBoth= \cont (Request x c1) (Request y c2)-> cont (c1 y) (c2 x)
+}
+
+-- | A 'SeesawResolver' for running two coroutines in parallel. One coroutine produces data in chunks, the other
+-- consumes data in chunks. The boundaries of the two kinds of chunks need not be the same, as the consumed chunks
+-- are determined by a 'Ticker' provided by the consumer's input request.
+tickerYieldResolver :: SeesawResolver (Request (Ticker x) [x]) (Yield [x]) (Request (Ticker x) [x]) (Yield [x])
+tickerYieldResolver = liftedTickerYieldResolver id id
+
+-- | A generic version of 'tickerYieldResolver', allowing coroutines with 'Request' and 'Yield' functors embedded in
+-- other functors.
+liftedTickerYieldResolver :: (Functor s1, Functor s2) =>
+                             (forall a. Request (Ticker x) [x] a -> s1 a) -> (forall a. Yield [x] a -> s2 a)
+                             -> SeesawResolver (Request (Ticker x) [x]) (Yield [x]) s1 s2
+liftedTickerYieldResolver lift1 lift2 = SeesawResolver {
+   resumeLeft= \(Request _ c)-> c [],
+   resumeRight= \(Yield _ c)-> c,
+   resumeBoth= \cont (Request t c1) (Yield xs c2)->
+               let (t', chunk, rest) = splitTicked t xs
+               in case rest
+                  of [] -> cont (suspend $ lift1 $ Request t' c1) c2
+                     _ -> cont (c1 chunk) (suspend $ lift2 $ Yield rest c2)
+}
+
+-- | Like 'tickerYieldResolver', the only difference being that the producing coroutine sends its chunks using 'request'
+-- rather than 'yield'. The feedback received from 'request' is the unconsumed remainder of the chunk, which lets the
+-- coroutine know when its sibling terminates.
+tickerRequestResolver :: SeesawResolver (Request (Ticker x) [x]) (Request [x] [x])
+                                        (Request (Ticker x) [x]) (Request [x] [x])
+tickerRequestResolver = liftedTickerRequestResolver id id
+
+-- | A generic version of 'tickerRequestResolver', allowing coroutines with 'Request' functors embedded in other
+-- functors.
+liftedTickerRequestResolver :: (Functor s1, Functor s2) =>
+                               (forall a. Request (Ticker x) [x] a -> s1 a) -> (forall a. Request [x] [x] a -> s2 a)
+                               -> SeesawResolver (Request (Ticker x) [x]) (Request [x] [x]) s1 s2
+liftedTickerRequestResolver lift1 lift2 = SeesawResolver {
+   resumeLeft= \(Request _ c)-> c [],
+   resumeRight= \(Request chunk c)-> c chunk,
+   resumeBoth= \cont (Request t c1) (Request xs c2)->
+               let (t', chunk, rest) = splitTicked t xs
+               in case rest
+                  of [] -> cont (suspend $ lift1 $ Request t' c1) (c2 [])
+                     _ -> cont (c1 chunk) (suspend $ lift2 $ Request rest c2)
+}
+
+-- | Like 'tickerRequestResolver', except the consuming coroutine requests receive both the selected prefix of the input
+-- chunk and a peek at either the next unconsumed input item, if any, or the final 'Ticker' value. Chunks sent by the
+-- producing coroutine never get combined for the consuming coroutine. This allows better synchronization between the
+-- two coroutines. It also leaks the information about the produced chunk boundaries into the consuming coroutine, so
+-- this resolver should be used with caution.
+lazyTickerRequestResolver :: SeesawResolver (Request (Ticker x) ([x], Either x (Ticker x))) (Request [x] [x])
+                                            (Request (Ticker x) ([x], Either x (Ticker x))) (Request [x] [x])
+lazyTickerRequestResolver = liftedLazyTickerRequestResolver id
+
+-- | A generic version of 'lazyTickerRequestResolver', allowing coroutines with 'Request' functors embedded in other
+-- functors.
+liftedLazyTickerRequestResolver :: 
+   (Functor s1, Functor s2) => 
+   (forall a. Request [x] [x] a -> s2 a)
+   -> SeesawResolver (Request (Ticker x) ([x], Either x (Ticker x))) (Request [x] [x]) s1 s2
+liftedLazyTickerRequestResolver lift = SeesawResolver {
+   resumeLeft= \(Request t c)-> c ([], Right t),
+   resumeRight= \(Request chunk c)-> c chunk,
+   resumeBoth= \cont (Request t c1) (Request xs c2)->
+               let (t', chunk, rest) = splitTicked t xs
+               in case rest
+                  of [] -> cont (c1 (chunk, Right t')) (c2 [])
+                     next:_ -> cont (c1 (chunk, Left next)) (suspend $ lift $ Request rest c2)
+}
+
+-- | Feeds a single value to an awaiting coroutine.
+feed :: Monad m => x -> Coroutine (Await x) m r -> Coroutine (Await x) m r
+feed x c = bounce (\(Await f)-> f x) c
+
+-- | Feeds a collection of values to an awaiting coroutine.
+feedAll :: (Foldable f, Monad m) => f x -> Coroutine (Await x) m r -> Coroutine (Await x) m r
+feedAll chunk c = foldl (flip feed) c chunk
diff --git a/TestCoroutine.hs b/TestCoroutine.hs
--- a/TestCoroutine.hs
+++ b/TestCoroutine.hs
@@ -31,7 +31,7 @@
 import Control.Monad.Coroutine
 import Control.Monad.Coroutine.SuspensionFunctors
 import Control.Monad.Coroutine.Nested
-import Control.Monad.Parallel (MonadParallel(..), sequence)
+import Control.Monad.Parallel (MonadParallel, bindM2, liftM2, sequence)
 
 factors n = maybe [n] (\k-> (k : factors (n `div` k))) (find (\k-> n `mod` k == 0) [2 .. n - 1])
 
@@ -41,7 +41,7 @@
 
 factorFibs :: MonadParallel m => [Int] -> m Integer
 factorFibs nums = liftM snd $
-                  seesaw bindM2 (SeesawResolver resumeLeft resumeRight resumeAny)
+                  seesaw bindM2 (SeesawResolver resumeLeft resumeRight resumeBoth)
                      (mapM_ (yieldApply (fib 0)) nums)
                      (factorize 0)
    where factorize :: MonadParallel m => Integer -> Coroutine (Await (Maybe Integer)) m Integer
@@ -51,16 +51,14 @@
                                 (\n-> factorize (sum + n {-product (factors n)-}))
          resumeLeft (Yield _ c) = c
          resumeRight (Await c) = c Nothing
-         resumeAny _ _ c (Yield x c1) (Await c2) = c c1 (c2 (Just x))
+         resumeBoth c (Yield x c1) (Await c2) = c c1 (c2 (Just x))
 
 twoFibs :: MonadParallel m => [Int] -> m Integer
-twoFibs nums = liftM (uncurry (+)) $
-               pogoStick
-                  resume
-                  (couple bindM2 (fibs 1) (fibs 2))
+twoFibs nums = pogoStick resume (couple bindM2 (fibs 1) (fibs 2))
+               >>= \(x, y)-> return (x + y)
    where resume :: SomeFunctor (Yield Integer) (Yield Integer) c -> c
          resume (Both (Compose (Yield n1 (Yield n2 c)))) = assert (n1 == n2) c
-         fibs ix = mapM_ (yieldApply (fib ix)) nums >> return (fib ix $ last nums)
+         fibs ix = mapM_ (yieldApply (fib ix)) nums >> applyM (fib ix) (last nums)
 
 twoFibsSeesaw :: MonadParallel m => [Int] -> m Integer
 twoFibsSeesaw nums = liftM (uncurry (+)) $
@@ -68,10 +66,9 @@
    where resolver = SeesawResolver{
                       resumeLeft= undefined,
                       resumeRight= undefined,
-                      resumeAny= \resumeLeft resumeRight resumeBoth (Yield left c1) (Yield right c2)->
-                                 assert (left == right) $ resumeBoth c1 c2
+                      resumeBoth= \cont (Yield left c1) (Yield right c2)-> assert (left == right) $ cont c1 c2
                     }
-         fibs ix = mapM_ (yieldApply (fib ix)) nums >> return (fib ix $ last nums)
+         fibs ix = mapM_ (yieldApply (fib ix)) nums >> applyM (fib ix) (last nums)
 
 fibs :: MonadParallel m => Int -> [Int] -> m Integer
 fibs coroutineCount nums = liftM sum $
@@ -80,11 +77,12 @@
                               (merge sequence appendYields $ replicateIx coroutineCount fibs)
    where resume :: Yield [Integer] (Coroutine (Yield [Integer]) m [Integer]) -> Coroutine (Yield [Integer]) m [Integer]
          resume (Yield (x:xs) c) = assert (all (==x) xs) c
-         fibs ix = mapM_ (yieldApply ((:[]) . fib ix)) nums >> return (fib ix $ last nums)
+         fibs ix = mapM_ (yieldApply ((:[]) . fib ix)) nums >> applyM (fib ix) (last nums)
          appendYields :: [Yield [s] x] -> Yield [s] [x]
          appendYields yields = uncurry Yield $ foldr (\(Yield s x) (ss, xs)-> (s ++ ss, x:xs)) ([], []) yields
 
 yieldApply f n = let result = f n in result `pseq` yield result
+applyM f n = let result = f n in result `pseq` return result
 
 replicateIx :: Int -> (Int -> x) -> [x]
 replicateIx n f = map f [1..n]
@@ -92,8 +90,8 @@
 nested :: (Monad m, Functor p) =>
           Int -> (Integer -> Coroutine p m ()) -> Coroutine (EitherFunctor p (Yield Integer)) m ()
 nested level suspendParent = do mapSuspension RightF (yield 1)
-                                liftOut (suspendParent 2)
-                                when (level > 0) (pogoStickNested cont $ nested (pred level) (liftOut . suspendParent))
+                                liftAncestor (suspendParent 2)
+                                when (level > 0) (pogoStickNested cont $ nested (pred level) (liftAncestor . suspendParent))
    where cont (Yield x c) = c
 
 main = do args <- getArgs
diff --git a/monad-coroutine.cabal b/monad-coroutine.cabal
--- a/monad-coroutine.cabal
+++ b/monad-coroutine.cabal
@@ -1,5 +1,5 @@
 Name:                monad-coroutine
-Version:             0.5.1
+Version:             0.6
 Cabal-Version:       >= 1.2
 Build-Type:          Simple
 Synopsis:            Coroutine monad transformer for suspending and resuming monadic computations
@@ -22,6 +22,7 @@
 --   location:          http://code.haskell.org/SCC/
 
 Library
-  Exposed-Modules:   Control.Monad.Coroutine, Control.Monad.Coroutine.SuspensionFunctors, Control.Monad.Coroutine.Nested
+  Exposed-Modules:   Control.Cofunctor.Ticker,
+                     Control.Monad.Coroutine, Control.Monad.Coroutine.SuspensionFunctors, Control.Monad.Coroutine.Nested
   Build-Depends:     base < 5, monad-parallel, transformers >= 0.2 && < 0.3
   GHC-prof-options:  -auto-all