monad-coroutine 0.6 → 0.6.1

raw patch · 5 files changed

+30/−31 lines, 5 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Control/Cofunctor/Ticker.hs +2/−2
• Control/Monad/Coroutine.hs +14/−12
• Control/Monad/Coroutine/Nested.hs +7/−9
• Control/Monad/Coroutine/SuspensionFunctors.hs +6/−7
• monad-coroutine.cabal +1/−1

@@ -63,7 +63,7 @@ -- | 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 (p : rest) = Ticker $ \x-> if p x then Just (tickWhilePrefixOf rest) else Nothing tickWhilePrefixOf [] = tickNone  -- | A ticker that accepts all input as long as it matches the given predicate.@@ -82,4 +82,4 @@  -- | 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))+Ticker t1 `andThen` t@(Ticker t2) = Ticker (\x-> maybe (t2 x) (Just . (`andThen` t)) (t1 x))

@@ -68,10 +68,10 @@    ) where -import Control.Monad (liftM, when)+import Control.Monad (liftM) import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.Trans.Class (MonadTrans(..))-import Data.Either (either, partitionEithers)+import Data.Either (partitionEithers) import Data.Functor.Compose (Compose(..))  import Control.Monad.Parallel@@ -88,9 +88,11 @@ instance (Functor s, Monad m) => Monad (Coroutine s m) where    return x = Coroutine (return (Right x))    t >>= f = Coroutine (resume t >>= apply f)-      where apply f (Right x) = resume (f x)-            apply f (Left s) = return (Left (fmap (>>= f) s))---   t >>= f = Coroutine (resume t >>= either (return . Left . fmap (>>= f)) (resume . f))+      where apply fc (Right x) = resume (fc x)+            apply fc (Left s) = return (Left (fmap (>>= fc) s))+   t >> f = Coroutine (resume t >>= apply f)+      where apply fc (Right x) = resume fc+            apply fc (Left s) = return (Left (fmap (>> fc) s))  instance (Functor s, MonadParallel m) => MonadParallel (Coroutine s m) where    bindM2 = liftBinder bindM2@@ -105,7 +107,7 @@ -- coroutines. data Naught x instance Functor Naught where-   fmap f _ = undefined+   fmap _ _ = undefined  -- | Combines two functors into one, applying either or both of them. Used for coupled coroutines. data SomeFunctor l r x = LeftSome (l x) | RightSome (r x) | Both (Compose l r x)@@ -124,13 +126,13 @@  -- | Change the base monad of a 'Coroutine'. mapMonad :: forall s m m' x. (Functor s, Monad m, Monad m') =>-            (forall x. m x -> m' x) -> Coroutine s m x -> Coroutine s m' x+            (forall y. m y -> m' y) -> Coroutine s m x -> Coroutine s m' x mapMonad f cort = Coroutine {resume= liftM map' (f $ resume cort)}    where map' (Right r) = Right r          map' (Left s) = Left (fmap (mapMonad f) s)  -- | Change the suspension functor of a 'Coroutine'.-mapSuspension :: forall s s' m x. (Functor s, Monad m) => (forall x. s x -> s' x) -> Coroutine s m x -> Coroutine s' m x+mapSuspension :: forall s s' m x. (Functor s, Monad m) => (forall y. s y -> s' y) -> Coroutine s m x -> Coroutine s' m x mapSuspension f cort = Coroutine {resume= liftM map' (resume cort)}    where map' (Right r) = Right r          map' (Left s) = Left (f $ fmap (mapSuspension f) s)@@ -154,7 +156,7 @@ foldRun f a c = resume c                 >>= \s-> case s                           of Right result -> return (a, result)-                            Left c -> uncurry (foldRun f) (f a c)+                            Left c' -> uncurry (foldRun f) (f a c')  -- | 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@@ -177,7 +179,7 @@  -- | 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) => +couple :: forall s1 s2 m x y. (Monad m, Functor s1, Functor s2) =>            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@@ -192,7 +194,7 @@ -- | 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 x. [m x] -> m [x]) -> (forall x. [s x] -> s [x])+         (forall y. [m y] -> m [y]) -> (forall y. [s y] -> s [y])       -> [Coroutine s m x] -> Coroutine s m [x] merge sequence1 sequence2 corts = Coroutine{resume= liftM step $ sequence1 (map resume corts)} where    step :: [CoroutineStepResult s m x] -> CoroutineStepResult s m [x]@@ -232,5 +234,5 @@             -> ((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+seesawSteps runPair proceed = seesaw' where    seesaw' t1 t2 = runPair (proceed seesaw') (resume t1) (resume t2)

@@ -38,14 +38,11 @@    ) where -import Control.Monad (join, liftM)-import Control.Monad.Trans.Class (lift)+import Control.Monad (liftM)  import Control.Monad.Coroutine 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)@@ -54,11 +51,11 @@    Coroutine{resume= resume t                       >>= \s-> case s                                of Right result -> return (Right result)-                                  Left (LeftF s) -> return (Left (fmap (pogoStickNested reveal) s))+                                  Left (LeftF s') -> return (Left (fmap (pogoStickNested reveal) s'))                                   Left (RightF c) -> resume (pogoStickNested reveal (reveal c))}  -- | 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) => +coupleNested :: forall s0 s1 s2 m x y. (Monad m, Functor s0, Monad s0, Functor s1, Functor s2) =>                  PairBinder m              -> Coroutine (EitherFunctor s0 s1) m x -> Coroutine (EitherFunctor s0 s2) m y              -> Coroutine (EitherFunctor s0 (SomeFunctor s1 s2)) m (x, y)@@ -95,16 +92,17 @@                   -> ((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+seesawNestedSteps runPair proceed = seesaw' where    seesaw' t1 t2 = Coroutine{resume= bouncePair t1 t2}    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 :: forall s r. +            CoroutineStepResult (EitherFunctor s0 s) m r -> Either (s (Coroutine (EitherFunctor s0 s) m r)) r    local (Left (RightF s)) = Left s+   local (Left (LeftF _)) = undefined    local (Right r) = Right r  -- | Class of functors that can contain another functor.

@@ -34,7 +34,6 @@ where  import Prelude hiding (foldl, foldr)-import Control.Monad (Monad, liftM) import Control.Monad.Trans.Class (MonadTrans(..)) import Data.Foldable (Foldable, foldl, foldr) @@ -78,14 +77,14 @@ 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+         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))+concatAwaits c = lift (resume c) >>= either concatenate return+   where concatenate 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.@@ -181,14 +180,14 @@    (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 {+liftedLazyTickerRequestResolver lifter = 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)+                     next:_ -> cont (c1 (chunk, Left next)) (suspend $ lifter $ Request rest c2) }  -- | Feeds a single value to an awaiting coroutine.

@@ -1,5 +1,5 @@ Name:                monad-coroutine-Version:             0.6+Version:             0.6.1 Cabal-Version:       >= 1.2 Build-Type:          Simple Synopsis:            Coroutine monad transformer for suspending and resuming monadic computations