monad-coroutine 0.8.0.1 → 0.9

raw patch · 5 files changed

+48/−45 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Control/Monad/Coroutine.hs +10/−4
• Control/Monad/Coroutine/Nested.hs +20/−25
• Control/Monad/Coroutine/SuspensionFunctors.hs +11/−10
• Test/BenchmarkCoroutine.hs +5/−4
• monad-coroutine.cabal +2/−2

@@ -1,5 +1,5 @@ {- -    Copyright 2009-2012 Mario Blazevic+    Copyright 2009-2014 Mario Blazevic      This file is part of the Streaming Component Combinators (SCC) project. @@ -63,7 +63,7 @@     -- * Coroutine operations     mapMonad, mapSuspension, mapFirstSuspension,     -- * Running coroutines-    Naught, runCoroutine, bounce, pogoStick, foldRun,+    Naught, runCoroutine, bounce, pogoStick, pogoStickM, foldRun,     -- * Weaving coroutines together     PairBinder, sequentialBinder, parallelBinder, liftBinder,     Weaver, WeaveStepper, weave, merge@@ -71,7 +71,7 @@ where  import Control.Applicative (Applicative(..))-import Control.Monad (Monad(..), ap, liftM)+import Control.Monad (Monad(..), ap, liftM, (<=<)) import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.Trans.Class (MonadTrans(..)) import Data.Either (partitionEithers)@@ -157,7 +157,13 @@  -- | 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 spring c = resume c >>= either (pogoStick spring . spring) return+pogoStick spring = loop+   where loop c = resume c >>= either (loop . spring) 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 spring = loop+   where loop c = resume c >>= either (loop <=< spring) return  -- | Runs a suspendable coroutine much like 'pogoStick', but allows the resumption function to thread an arbitrary -- state as well.

@@ -1,5 +1,5 @@ {- -    Copyright 2010-2012 Mario Blazevic+    Copyright 2010-2014 Mario Blazevic      This file is part of the Streaming Component Combinators (SCC) project. @@ -19,7 +19,7 @@ -- coroutine can be automatically suspended as well. A single suspension can thus suspend an entire chain of nested -- coroutines. -- --- Nestable coroutines of this kind should group their suspension functors into an 'EitherFunctor'. A simple coroutine+-- Nestable coroutines of this kind should group their suspension functors into a 'Sum'. A simple coroutine -- suspension can be converted to a nested one using functions 'mapSuspension' and 'liftAncestor'. To run nested -- coroutines, use 'pogoStickNested', or 'weave' with a 'NestWeaveStepper'. @@ -29,8 +29,7 @@  module Control.Monad.Coroutine.Nested    (-      EitherFunctor(..), eitherFunctor, mapNestedSuspension,-      pogoStickNested,+      eitherFunctor, mapNestedSuspension, pogoStickNested,       NestWeaveStepper,       ChildFunctor(..), AncestorFunctor(..),       liftParent, liftAncestor@@ -38,49 +37,45 @@ where  import Control.Monad (liftM)-import Control.Monad.Coroutine+import Data.Functor.Sum (Sum(InL, InR)) --- | Combines two alternative functors into one, applying one or the other. Used for nested coroutines.-data EitherFunctor l r x = LeftF (l x) | RightF (r x)-instance (Functor l, Functor r) => Functor (EitherFunctor l r) where-   fmap f (LeftF l) = LeftF (fmap f l)-   fmap f (RightF r) = RightF (fmap f r)+import Control.Monad.Coroutine --- | Like 'either' for the EitherFunctor data type.-eitherFunctor :: (l x -> y) -> (r x -> y) -> EitherFunctor l r x -> y-eitherFunctor left _ (LeftF f) = left f-eitherFunctor _ right (RightF f) = right f+-- | Like 'either' for the 'Sum' data type.+eitherFunctor :: (l x -> y) -> (r x -> y) -> Sum l r x -> y+eitherFunctor left _ (InL f) = left f+eitherFunctor _ right (InR f) = right f  -- | Change the suspension functor of a nested 'Coroutine'. mapNestedSuspension :: (Functor s0, Functor s, Monad m) => (forall y. s y -> s' y) ->-                       Coroutine (EitherFunctor s0 s) m x -> Coroutine (EitherFunctor s0 s') m x+                       Coroutine (Sum s0 s) m x -> Coroutine (Sum s0 s') m x mapNestedSuspension f cort = Coroutine {resume= liftM map' (resume cort)}    where map' (Right r) = Right r-         map' (Left (LeftF s)) = Left (LeftF $ fmap (mapNestedSuspension f) s)-         map' (Left (RightF s)) = Left (RightF (f $ fmap (mapNestedSuspension f) s))+         map' (Left (InL s)) = Left (InL $ fmap (mapNestedSuspension f) s)+         map' (Left (InR s)) = Left (InR (f $ fmap (mapNestedSuspension f) s))  -- | 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)-                   -> Coroutine (EitherFunctor s1 s2) m x -> Coroutine s1 m x+                   (s2 (Coroutine (Sum s1 s2) m x) -> Coroutine (Sum s1 s2) m x)+                   -> Coroutine (Sum s1 s2) m x -> Coroutine s1 m x pogoStickNested reveal t =     Coroutine{resume= resume t                       >>= \s-> case s                                of Right result -> return (Right result)-                                  Left (LeftF s') -> return (Left (fmap (pogoStickNested reveal) s'))-                                  Left (RightF c) -> resume (pogoStickNested reveal (reveal c))}+                                  Left (InL s') -> return (Left (fmap (pogoStickNested reveal) s'))+                                  Left (InR c) -> resume (pogoStickNested reveal (reveal c))}  -- | Type of functions capable of combining two child coroutines' 'CoroutineStepResult' values into a parent coroutine. -- Use with the function 'weave'.-type NestWeaveStepper s0 s1 s2 m x y z = WeaveStepper (EitherFunctor s0 s1) (EitherFunctor s0 s2) s0 m x y z+type NestWeaveStepper s0 s1 s2 m x y z = WeaveStepper (Sum s0 s1) (Sum s0 s2) s0 m x y z  -- | Class of functors that can contain another functor. class Functor c => ChildFunctor c where    type Parent c :: * -> *    wrap :: Parent c x -> c x-instance (Functor p, Functor s) => ChildFunctor (EitherFunctor p s) where-   type Parent (EitherFunctor p s) = p-   wrap = LeftF+instance (Functor p, Functor s) => ChildFunctor (Sum p s) where+   type Parent (Sum p s) = p+   wrap = InL  -- | Class of functors that can be lifted. class (Functor a, Functor d) => AncestorFunctor a d where

@@ -1,5 +1,5 @@ {- -    Copyright 2010-2012 Mario Blazevic+    Copyright 2010-2014 Mario Blazevic      This file is part of the Streaming Component Combinators (SCC) project. @@ -24,7 +24,7 @@     -- * Suspension functors     Yield(Yield), Await(Await), Request(Request),     ReadRequest, ReadingResult(..), Reader, Reading(..),-    EitherFunctor(LeftF, RightF), eitherFunctor,+    eitherFunctor,     yield, await, request, requestRead,     -- * Utility functions     concatYields, concatAwaits,@@ -39,10 +39,11 @@ 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(..), eitherFunctor, NestWeaveStepper, pogoStickNested)+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.@@ -162,18 +163,18 @@ weaveNestedReadWriteRequests :: (Monad m, Functor s, Monoid x) =>                                 NestWeaveStepper s (ReadRequest x) (Request x x) m r1 r2 (r1, r2) weaveNestedReadWriteRequests _ (Right r1) (Right r2) = return (r1, r2)-weaveNestedReadWriteRequests weave (Left (LeftF s)) cs2 =+weaveNestedReadWriteRequests weave (Left (InL s)) cs2 =    suspend $ fmap (flip weave (Coroutine $ return cs2)) s-weaveNestedReadWriteRequests weave cs1 (Left (LeftF s)) =+weaveNestedReadWriteRequests weave cs1 (Left (InL s)) =    suspend $ fmap (weave (Coroutine $ return cs1)) s-weaveNestedReadWriteRequests _ (Left (RightF (ReadRequest p eof c))) (Right r2) =+weaveNestedReadWriteRequests _ (Left (InR (ReadRequest p eof c))) (Right r2) =    liftM (\r1-> (r1, r2)) $ pogoStickNested eofRequest $ c $ FinalResult eof    where eofRequest (ReadRequest _ eof c) = c $ FinalResult eof-weaveNestedReadWriteRequests _ (Right r1) (Left (RightF (Request chunk c))) =+weaveNestedReadWriteRequests _ (Right r1) (Left (InR (Request chunk c))) =    liftM ((,) r1) $ pogoStickNested reflectRequest $ c chunk    where reflectRequest (Request chunk c) = c chunk-weaveNestedReadWriteRequests weave (Left (RightF (ReadRequest p _ c1))) (Left (RightF (Request xs c2))) =+weaveNestedReadWriteRequests weave (Left (InR (ReadRequest p _ c1))) (Left (InR (Request xs c2))) =    case p xs-   of Final s r -> weave (c1 $ FinalResult r) (suspend $ RightF $ Request s c2)+   of Final s r -> weave (c1 $ FinalResult r) (suspend $ InR $ Request s c2)       Advance p' _ rp -> weave (c1 $ ResultPart rp p') (c2 mempty)-      Deferred p' eof -> weave (suspend $ RightF $ ReadRequest p' eof c1) (c2 mempty)+      Deferred p' eof -> weave (suspend $ InR $ ReadRequest p' eof c1) (c2 mempty)

@@ -26,6 +26,7 @@ import Control.Parallel (pseq) import Data.Functor.Compose (Compose(..)) import Data.Functor.Identity (Identity(Identity), runIdentity)+import Data.Functor.Sum (Sum(InL, InR)) import Data.List (find) import Data.Maybe (fromJust) import System.Environment (getArgs)@@ -97,16 +98,16 @@ replicateIx n f = map f [1..n]  nested :: (Monad m, Functor p) =>-          Int -> (Integer -> Coroutine p m ()) -> Coroutine (EitherFunctor p (Yield Integer)) m ()-nested level suspendParent = do mapSuspension RightF (yield 1)+          Int -> (Integer -> Coroutine p m ()) -> Coroutine (Sum p (Yield Integer)) m ()+nested level suspendParent = do mapSuspension InR (yield 1)                                 liftAncestor (suspendParent 2)                                 when (level > 0) (pogoStickNested cont $                                                   nested (pred level) (liftAncestor . suspendParent))    where cont (Yield x c) = c  runNested size = liftM fst $ foldRun add 0 (nested size yield)-   where add s (LeftF (Yield n c)) = (s + n, c)-         add s (RightF (Yield n c)) = (s + 10 * n, c)+   where add s (InL (Yield n c)) = (s + n, c)+         add s (InR (Yield n c)) = (s + 10 * n, c)   main = defaultMain ([bgroup "Identity" [bench name (nf (runIdentity . task name) size) | (name, size) <- tasks],

@@ -1,5 +1,5 @@ Name:                monad-coroutine-Version:             0.8.0.1+Version:             0.9 Cabal-Version:       >= 1.10 Build-Type:          Simple Synopsis:            Coroutine monad transformer for suspending and resuming monadic computations@@ -12,7 +12,7 @@    License:             GPL License-file:        LICENSE.txt-Copyright:           (c) 2010-2014 Mario Blazevic+Copyright:           (c) 2010-2015 Mario Blazevic Author:              Mario Blazevic Maintainer:          blamario@yahoo.com Homepage:            http://trac.haskell.org/SCC/wiki/monad-coroutine