simple-effects 0.6.0.1 → 0.6.0.2

raw patch · 10 files changed

+353/−61 lines, 10 filesdep +arraydep −ghc-prim

Dependencies added: array

Dependencies removed: ghc-prim

Files

• bench/Bench.hs +10/−7
• simple-effects.cabal +5/−3
• src/Control/Effects.hs +12/−3
• src/Control/Effects/Early.hs +17/−1
• src/Control/Effects/Parallel.hs +46/−0
• src/Control/Effects/Signal.hs +6/−5
• src/Control/Effects/State.hs +42/−35
• src/Control/Effects1.hs +11/−1
• src/Control/Monad/Runnable.hs +180/−0
• test/Main.hs +24/−6

@@ -1,24 +1,27 @@ {-# LANGUAGE FlexibleContexts, TypeApplications #-}
-import Interlude
+import Interlude hiding (modify', execStateT)
 
-import GHC.IO.Encoding (setLocaleEncoding, utf16)
-import Control.Effects
-import Control.Effects.State hiding (mtlSimple, effectsSimple)
+import GHC.IO.Encoding (setLocaleEncoding, utf8)
+import Control.Effects.State
 
+import Control.Monad.State.Strict
+import Control.Monad.Trans.State.Strict (execStateT)
+
 import Criterion.Main
 
 mtlSimple :: MonadState Int m => m ()
 mtlSimple = replicateM_ 1000000 mtlSimple'
     where mtlSimple' = modify' (+ 1)
 
-effectsSimple :: (MonadEffect (GetState Int) m, MonadEffect (SetState Int) m) => m ()
+effectsSimple :: (MonadEffectState Int m) => m ()
 effectsSimple = replicateM_ 1000000 effectsSimple'
     where effectsSimple' = modifyState (+ (1 :: Int))
 
 main :: IO ()
-main =
+main = do
+    setLocaleEncoding utf8
     defaultMain
         [ bench "MTL state" $ nfIO (execStateT mtlSimple 0)
         , bench "Effects state" $ nfIO effState
         ]
-    where effState = handleStateIO @_ @Int @Int 0 (effectsSimple >> getState)
+    where effState = handleStateT (0 :: Int) (effectsSimple >> getState @Int)

@@ -1,5 +1,5 @@ name:                simple-effects
-version:             0.6.0.1
+version:             0.6.0.2
 synopsis:            A simple effect system that integrates with MTL
 description:         Please see README.md
 homepage:            https://gitlab.com/LukaHorvat/simple-effects
@@ -20,6 +20,8 @@                      , Control.Effects.List
                      , Control.Effects.Signal
                      , Control.Effects.Early
+                     , Control.Effects.Parallel
+                     , Control.Monad.Runnable
   hs-source-dirs:      src
   default-language:    Haskell2010
   build-depends:       base >= 4.7 && < 5
@@ -30,7 +32,7 @@                      , transformers-base == 0.4.*
                      , list-t
                      , lens
-                     , ghc-prim
+                     , array
   default-extensions:  NoImplicitPrelude
   ghc-options:         -Wall
 
@@ -42,7 +44,7 @@     build-depends:     base >= 4.7 && < 5
                      , simple-effects
                      , interlude-l >= 0.1.0.6
-    ghc-options:       -Wall
+    ghc-options:       -Wall -threaded -with-rtsopts=-N
     default-extensions:NoImplicitPrelude
 
 benchmark bench-effects

@@ -9,6 +9,7 @@ import Control.Monad.Trans.Control
 import Control.Monad.Base
 
+import Control.Monad.Runnable
 import Control.Effects1
 
 type family EffectMsg eff :: *
@@ -22,18 +23,26 @@ --   handle the effect.
 newtype EffectHandler eff m a = EffectHandler
     { unpackEffectHandler :: ReaderT (EffectMsg eff -> m (EffectRes eff)) m a }
-    deriving (Functor, Applicative, Monad, MonadState s, MonadIO, MonadCatch, MonadThrow, MonadRandom)
+    deriving ( Functor, Applicative, Monad, Alternative, MonadState s, MonadIO, MonadCatch
+             , MonadThrow, MonadRandom )
 
 instance MonadTrans (EffectHandler eff) where
     lift = EffectHandler . lift
 
+instance RunnableTrans (EffectHandler eff) where
+    type TransformerState (EffectHandler eff) m = EffectMsg eff -> m (EffectRes eff)
+    type TransformerResult (EffectHandler eff) m a = a
+    currentTransState = EffectHandler ask
+    restoreTransState = return
+    runTransformer m = runReaderT (unpackEffectHandler m)
+
 instance MonadReader s m => MonadReader s (EffectHandler eff m) where
     ask = EffectHandler (lift ask)
     local f (EffectHandler rdr) = EffectHandler (ReaderT $ local f . runReaderT rdr)
 
-deriving instance MonadBase IO m => MonadBase IO (EffectHandler eff m)
+deriving instance MonadBase b m => MonadBase b (EffectHandler eff m)
 
-instance MonadBaseControl IO m => MonadBaseControl IO (EffectHandler eff m) where
+instance MonadBaseControl b m => MonadBaseControl b (EffectHandler eff m) where
     type StM (EffectHandler eff m) a = StM (ReaderT (EffectMsg eff -> m (EffectRes eff)) m) a
     liftBaseWith f = EffectHandler $ liftBaseWith $ \q -> f (q . unpackEffectHandler)
     restoreM = EffectHandler . restoreM

@@ -1,5 +1,7 @@ {-# LANGUAGE RankNTypes, TypeFamilies, FlexibleContexts, ScopedTypeVariables, MultiParamTypeClasses #-}
-module Control.Effects.Early (module Control.Effects, Early, earlyReturn, handleEarly) where
+module Control.Effects.Early
+    ( module Control.Effects, Early
+    , earlyReturn, handleEarly, onlyDo, ifNothingEarlyReturn, ifNothingDo ) where
 
 import Interlude
 import Control.Monad.Trans.Except
@@ -26,3 +28,17 @@ handleEarly :: Monad m => ExceptT a m a -> m a
 handleEarly = fmap collapseEither
             . runExceptT
+
+-- | Only do the given action and exit early with it's result.
+onlyDo :: MonadEffect (Early a) m => m a -> m b
+onlyDo m = m >>= earlyReturn
+
+-- | Early return the given value if the 'Maybe' is 'Nothing'. Otherwise, contnue with the value
+--   inside of it.
+ifNothingEarlyReturn :: MonadEffect (Early a) m => a -> Maybe b -> m b
+ifNothingEarlyReturn a = maybe (earlyReturn a) return
+
+-- | Only do the given action and early return with it's result if the given value is 'Nothing'.
+--   Otherwise continue with the value inside of the 'Maybe'.
+ifNothingDo :: MonadEffect (Early a) m => m a -> Maybe b -> m b
+ifNothingDo m = maybe (onlyDo m) return

@@ -0,0 +1,46 @@+{-# LANGUAGE ScopedTypeVariables, FlexibleContexts #-}
+module Control.Effects.Parallel where
+
+import Interlude hiding (toList)
+
+import GHC.IO.Unsafe
+import Data.Array.IO
+
+import Control.Monad.Runnable
+import Control.Effects.State
+
+forkThread :: IO () -> IO (MVar ())
+forkThread proc = do
+    h <- newEmptyMVar
+    _ <- forkFinally proc (\_ -> putMVar h ())
+    return h
+
+appendState :: forall s m a proxy. (Semigroup s, MonadEffectState s m)
+            => proxy s -> m a -> m a
+appendState _ m = do
+    s :: s <- getState
+    a <- m
+    s' :: s <- getState
+    setState (s <> s')
+    return a
+
+parallelWithRestore :: forall m a. Runnable m => (m a -> m a) -> [m a] -> m [a]
+parallelWithRestore combine tasks = do
+    ress <- parallel tasks
+    mapM (combine . restoreMonadicState) ress
+
+parallelWithSequence :: Runnable m => [m a] -> m [a]
+parallelWithSequence = mapM restoreMonadicState <=< parallel
+
+parallel :: forall m a. Runnable m => [m a] -> m [MonadicResult m a]
+parallel tasks = do
+    st <- currentMonadicState
+    let ress = unsafePerformIO $ do
+            arr :: IOArray Int (MonadicResult m a) <- newArray_ (0, n - 1)
+            threads <- forM (zip [0..] tasks) $ \(i, t) -> forkThread $ do
+                res <- runMonad st t
+                writeArray arr i res
+            mapM_ takeMVar threads
+            getElems arr
+    ress `seq` return ress
+    where n = length tasks

@@ -14,7 +14,7 @@ import qualified GHC.TypeLits as TL
 import GHC.TypeLits (TypeError, ErrorMessage(..))
 import Control.Effects
-import Control.Monad.Trans.Control
+import Control.Monad.Runnable
 
 data Signal a b
 type instance EffectMsg (Signal a b) = a
@@ -118,7 +118,7 @@ showAllExceptions = fmap (mapLeft getSomeSignal) . runExceptT
 
 -- | A class of monads that throw and catch exceptions of type @e@. An overlappable instance is
---   given so you just need to make sure your transformers have a 'MonadTransControl' instance.
+--   given so you just need to make sure your transformers have a 'RunnableTrans' instance.
 class Throws e m => Handles e m where
     -- | Use this function to handle exceptions without discarding the 'Throws' constraint.
     --   You'll want to use this if you're writing a recursive function. Using the regular handlers
@@ -150,11 +150,12 @@     handleRecursive f = ExceptT . (either (runExceptT . f) (return . Right) <=< runExceptT)
     {-# INLINE handleRecursive #-}
 
-instance {-# OVERLAPPABLE #-} (Monad m, Monad (t m), Handles e m, MonadTransControl t)
+instance {-# OVERLAPPABLE #-} (Monad m, Monad (t m), Handles e m, RunnableTrans t)
          => Handles e (t m) where
     handleRecursive f e = do
-        st <- liftWith (\run -> handleRecursive (run . f) (run e))
-        restoreT (return st)
+        st <- currentTransState
+        res <- lift (handleRecursive (\ex -> runTransformer (f ex) st) (runTransformer e st))
+        restoreTransState res
     {-# INLINE handleRecursive #-}
 
 -- | 'handleToEither' that doesn't discard 'Throws' constraints. See documentation for

@@ -1,61 +1,68 @@ {-# LANGUAGE TypeFamilies, ScopedTypeVariables, FlexibleContexts, Rank2Types, ConstraintKinds #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-module Control.Effects.State (module Control.Effects.State, module Control.Effects) where
+{-# LANGUAGE MultiParamTypeClasses, GADTs, BangPatterns #-}
+module Control.Effects.State (module Control.Effects.State, module Control.Effects1) where
 
-import Interlude
+import Interlude hiding (Set, State)
 
 import Data.IORef
 
-import Control.Effects
-
-data GetState s
-data SetState s
+import Control.Effects1
 
-type instance EffectMsg (GetState s) = ()
-type instance EffectRes (GetState s) = s
+data State s
+data Get
+data Set
+data StateMessage s a where
+    GetMessage :: StateMessage s Get
+    SetMessage :: !s -> StateMessage s Set
+data StateResult s a where
+    GetResult :: { getGetResult :: !s } -> StateResult s Get
+    SetResult :: StateResult s Set
 
-type instance EffectMsg (SetState s) = s
-type instance EffectRes (SetState s) = ()
+type instance EffectMsg1 (State s) = StateMessage s
+type instance EffectRes1 (State s) = StateResult s
+type instance EffectCon1 (State s) a = ()
 
-instance Monad m => MonadEffect (GetState s) (StateT s m) where
-    effect _ _ = get
+instance Monad m => MonadEffect1 (State s) (StateT s m) where
+    effect1 _ GetMessage = GetResult <$> get
+    effect1 _ (SetMessage s) = SetResult <$ put s
+    {-# INLINE effect1 #-}
 
-instance Monad m => MonadEffect (SetState s) (StateT s m) where
-    effect _ = put
+type MonadEffectState s m = MonadEffect1 (State s) m
 
-type MonadEffectState s m = (MonadEffect (GetState s) m, MonadEffect (SetState s) m)
-type EffectHandlerState s m = EffectHandler (GetState s) (EffectHandler (SetState s) m)
+stateEffect :: forall s a m. MonadEffectState s m
+            => StateMessage s a -> m (StateResult s a)
+stateEffect = effect1 (Proxy :: Proxy (State s))
+{-# INLINE stateEffect #-}
 
-getState :: forall s m. MonadEffect (GetState s) m => m s
+getState :: forall s m. MonadEffectState s m => m s
+getState = getGetResult <$> stateEffect GetMessage
 {-# INLINE getState #-}
-getState = effect (Proxy :: Proxy (GetState s)) ()
 
-setState :: forall s m. MonadEffect (SetState s) m => s -> m ()
+setState :: forall s m. MonadEffectState s m => s -> m ()
+setState s = void $ stateEffect (SetMessage s)
 {-# INLINE setState #-}
-setState = effect (Proxy :: Proxy (SetState s))
 
 modifyState :: forall s m. MonadEffectState s m => (s -> s) -> m ()
+modifyState f = do
+    s <- getState
+    let s' = f s in s' `seq` setState s'
 {-# INLINE modifyState #-}
-modifyState f = setState . f =<< getState
 
-handleGetState :: m s -> EffectHandler (GetState s) m a -> m a
-{-# INLINE handleGetState #-}
-handleGetState = handleEffect . const
-
-handleSetState :: (s -> m ()) -> EffectHandler (SetState s) m a -> m a
-{-# INLINE handleSetState #-}
-handleSetState = handleEffect
-
-handleState :: Monad m => m s -> (s -> m ()) -> EffectHandlerState s m a -> m a
+handleState :: forall m s a. Monad m => m s -> (s -> m ())
+            -> EffectHandler1 (State s) m a -> m a
+handleState getter setter =
+    handleEffect1 handler
+    where handler :: forall b. StateMessage s b -> m (StateResult s b)
+          handler GetMessage = GetResult <$> getter
+          handler (SetMessage s) = SetResult <$ setter s
 {-# INLINE handleState #-}
-handleState getter setter = handleSetState setter . handleGetState (lift getter)
 
-handleStateIO :: MonadIO m => s -> EffectHandlerState s m a -> m a
-{-# INLINE handleStateIO #-}
+handleStateIO :: MonadIO m => s -> EffectHandler1 (State s) m a -> m a
 handleStateIO initial m = do
     ref <- liftIO (newIORef initial)
     m & handleState (liftIO (readIORef  ref)) (liftIO . writeIORef ref)
+{-# INLINE handleStateIO #-}
 
 handleStateT :: Monad m => s -> StateT s m a -> m a
-{-# INLINE handleStateT #-}
 handleStateT = flip evalStateT
+{-# INLINE handleStateT #-}

@@ -9,6 +9,8 @@ import Control.Monad.Trans.Control
 import Control.Monad.Base
 
+import Control.Monad.Runnable
+
 type family EffectMsg1 eff :: * -> *
 type family EffectRes1 eff :: * -> *
 type family EffectCon1 eff a :: Constraint
@@ -24,10 +26,18 @@ --   handle the effect.
 newtype EffectHandler1 eff m a = EffectHandler1
     { unpackEffectHandler1 :: ReaderT (EffHandling1 eff m) m a }
-    deriving (Functor, Applicative, Monad, MonadState s, MonadIO, MonadCatch, MonadThrow, MonadRandom)
+    deriving ( Functor, Applicative, Monad, Alternative, MonadState s, MonadIO, MonadCatch
+             , MonadThrow, MonadRandom )
 
 instance MonadTrans (EffectHandler1 eff) where
     lift = EffectHandler1 . lift
+
+instance RunnableTrans (EffectHandler1 eff) where
+    type TransformerState (EffectHandler1 eff) m = EffHandling1 eff m
+    type TransformerResult (EffectHandler1 eff) m a = a
+    currentTransState = EffectHandler1 ask
+    restoreTransState = return
+    runTransformer m = runReaderT (unpackEffectHandler1 m)
 
 instance MonadReader s m => MonadReader s (EffectHandler1 eff m) where
     ask = EffectHandler1 (lift ask)

@@ -0,0 +1,180 @@+{-# LANGUAGE TypeFamilies, UndecidableInstances, ScopedTypeVariables, FlexibleInstances #-}
+{-# LANGUAGE ExistentialQuantification #-}
+{-# OPTIONS_GHC -Wno-warnings-deprecations #-}
+module Control.Monad.Runnable where
+
+import Interlude hiding (toList, throwError)
+
+import ListT
+import qualified Control.Monad.Trans.State.Strict as SS
+import qualified Control.Monad.Trans.State.Lazy as LS
+import qualified Control.Monad.Trans.Writer.Strict as SW
+import qualified Control.Monad.Trans.Writer.Lazy as LW
+import qualified Control.Monad.Trans.RWS.Strict as SR
+import qualified Control.Monad.Trans.RWS.Lazy as LR
+import Control.Monad.Trans.Identity
+import Control.Monad.Trans.Error
+import Control.Monad.Trans.Except
+import Control.Monad.Trans.Maybe
+-- import Control.Monad.Trans.Cont -- may be impossible to write
+
+-- | A class of monads that have a run function.
+--
+--   The 'runMonad' function gives the result inside of IO. The only reason for this is to allow
+--   an instance for IO to be written. Other instances do not perform any aditional IO.
+--
+--   Instances for 'Identity', 'IO' and
+--   @('Runnable' m, 'RunnableTrans' t, 'Monad' (t m)) => 'Runnable' (t m)@ are given so users
+--   should only provide additional 'RunnableTrans' instances instead of 'Runnable' ones.
+class Monad m => Runnable m where
+    -- | The type of value that needs to be provided to run this monad.
+    type MonadicState m :: *
+    -- | The type of the result you get when you run this monad.
+    type MonadicResult m a :: *
+    -- | Get the current state value.
+    currentMonadicState :: m (MonadicState m)
+    -- | If given a result, reconstruct a monadic compitation.
+    restoreMonadicState :: MonadicResult m a -> m a
+    -- | Given the required state value and a computation, run the computation up to the IO effect.
+    --   This should effectively run each layer in the transformer stack. The 'MonadicState' should
+    --   hold all the needed information to do so.
+    --
+    --   A more formal description of what it means to run a transformer is given for the
+    --   'runTransformer' function.
+    runMonad :: MonadicState m -> m a -> IO (MonadicResult m a)
+
+-- | A class of transformers that can run their effects in the underlying monad.
+--
+--   The following laws need to hold.
+--
+-- @
+--   \t -> do st <- 'currentTransState'
+--            res <- 'lift' ('runTransformer' t st)
+--            'restoreTransState' res
+--   == 'id'
+-- @
+--
+-- @
+--   f :: (forall a. m a -> m a)
+--   \m s -> runTransformer (lift (f m)) s == \m s -> f (runTransformer (lift m) s)
+-- @
+class MonadTrans t => RunnableTrans t where
+    -- | The type of value that needs to be provided to run this transformer.
+    type TransformerState t (m :: * -> *) :: *
+    -- | The type of the result you get when you run this transformer.
+    type TransformerResult t (m :: * -> *) a :: *
+    -- | Get the current state value.
+    currentTransState :: Monad m => t m (TransformerState t m)
+    -- | If given a result, reconstruct the compitation.
+    restoreTransState :: Monad m => TransformerResult t m a -> t m a
+    -- | Given the required state value and a computation, run the effects of the transformer
+    --   in the underlying monad.
+    runTransformer :: Monad m => t m a -> TransformerState t m -> m (TransformerResult t m a)
+
+instance Runnable Identity where
+    type MonadicState Identity = ()
+    type MonadicResult Identity a = a
+    currentMonadicState = return ()
+    restoreMonadicState = return
+    runMonad _ (Identity a) = return a
+
+instance Runnable IO where
+    type MonadicState IO = ()
+    type MonadicResult IO a = a
+    currentMonadicState = return ()
+    restoreMonadicState = return
+    runMonad _ m = m
+
+instance (Runnable m, RunnableTrans t, Monad (t m)) => Runnable (t m) where
+    type MonadicState (t m) = (TransformerState t m, MonadicState m)
+    type MonadicResult (t m) a = MonadicResult m (TransformerResult t m a)
+    currentMonadicState = (,) <$> currentTransState <*> lift currentMonadicState
+    restoreMonadicState s = lift (restoreMonadicState s) >>= restoreTransState
+    runMonad (s, s') t = runMonad s' (runTransformer t s)
+
+instance RunnableTrans (SS.StateT s) where
+    type TransformerState (SS.StateT s) m = s
+    type TransformerResult (SS.StateT s) m a = (a, s)
+    currentTransState = get
+    restoreTransState (a, s) = put s >> return a
+    runTransformer = SS.runStateT
+
+instance RunnableTrans (LS.StateT s) where
+    type TransformerState (LS.StateT s) m = s
+    type TransformerResult (LS.StateT s) m a = (a, s)
+    currentTransState = get
+    restoreTransState (a, s) = put s >> return a
+    runTransformer = LS.runStateT
+
+instance Monoid s => RunnableTrans (SW.WriterT s) where
+    type TransformerState (SW.WriterT s) m = ()
+    type TransformerResult (SW.WriterT s) m a = (a, s)
+    currentTransState = return ()
+    restoreTransState (a, s) = SW.tell s >> return a
+    runTransformer m _ = SW.runWriterT m
+
+instance Monoid s => RunnableTrans (LW.WriterT s) where
+    type TransformerState (LW.WriterT s) m = ()
+    type TransformerResult (LW.WriterT s) m a = (a, s)
+    currentTransState = return ()
+    restoreTransState (a, s) = LW.tell s >> return a
+    runTransformer m _ = LW.runWriterT m
+
+instance RunnableTrans (ReaderT s) where
+    type TransformerState (ReaderT s) m = s
+    type TransformerResult (ReaderT s) m a = a
+    currentTransState = ask
+    restoreTransState = return
+    runTransformer = runReaderT
+
+instance Monoid w => RunnableTrans (SR.RWST r w s) where
+    type TransformerState (SR.RWST r w s) m = (r, s)
+    type TransformerResult (SR.RWST r w s) m a = (a, s, w)
+    currentTransState = (,) <$> ask <*> get
+    restoreTransState (a, s, w) = SR.tell w >> put s >> return a
+    runTransformer m (r, s) = SR.runRWST m r s
+
+instance Monoid w => RunnableTrans (LR.RWST r w s) where
+    type TransformerState (LR.RWST r w s) m = (r, s)
+    type TransformerResult (LR.RWST r w s) m a = (a, s, w)
+    currentTransState = (,) <$> ask <*> get
+    restoreTransState (a, s, w) = LR.tell w >> put s >> return a
+    runTransformer m (r, s) = LR.runRWST m r s
+
+instance RunnableTrans IdentityT where
+    type TransformerState IdentityT m = ()
+    type TransformerResult IdentityT m a = a
+    currentTransState = return ()
+    restoreTransState = return
+    runTransformer m () = runIdentityT m
+
+instance Error e => RunnableTrans (ErrorT e) where
+    type TransformerState (ErrorT e) m = ()
+    type TransformerResult (ErrorT e) m a = Either e a
+    currentTransState = return ()
+    restoreTransState (Left e) = throwError e
+    restoreTransState (Right a) = return a
+    runTransformer m () = runErrorT m
+
+instance RunnableTrans (ExceptT e) where
+    type TransformerState (ExceptT e) m = ()
+    type TransformerResult (ExceptT e) m a = Either e a
+    currentTransState = return ()
+    restoreTransState (Left e) = throwE e
+    restoreTransState (Right a) = return a
+    runTransformer m () = runExceptT m
+
+instance RunnableTrans MaybeT where
+    type TransformerState MaybeT m = ()
+    type TransformerResult MaybeT m a = Maybe a
+    currentTransState = return ()
+    restoreTransState Nothing = mzero
+    restoreTransState (Just a) = return a
+    runTransformer m () = runMaybeT m
+
+instance RunnableTrans ListT where
+     type TransformerState ListT m = ()
+     type TransformerResult ListT m a = [a]
+     currentTransState = return ()
+     restoreTransState = fromFoldable
+     runTransformer m _ = toList m

@@ -1,10 +1,11 @@-{-# LANGUAGE NoMonomorphismRestriction, FlexibleContexts, ScopedTypeVariables #-}
+{-# LANGUAGE NoMonomorphismRestriction, FlexibleContexts, ScopedTypeVariables, BangPatterns #-}
 module Main where
 
 import Interlude
 
 import Control.Effects.Signal
 import Control.Effects.State
+import Control.Effects.Parallel
 
 -- Should infer
 ex1 = signal True
@@ -14,24 +15,41 @@ ex2 = throwSignal False
 
 ex3 = do
-    discardAllExceptions ex1
-    showAllExceptions ex2
-    handleException (\(b :: Bool) -> return ()) ex2
+    void $ discardAllExceptions ex1
+    void $ showAllExceptions ex2
+    handleException (\(_ :: Bool) -> return ()) ex2
     handleSignal (\(_ :: Bool) -> Resume 5) ex1
 
-orderTest :: (Test Bool m, MonadEffectState Int m, MonadIO m) => m ()
+orderTest :: (Handles Bool m, MonadEffectState Int m, MonadIO m) => m ()
 orderTest = do
     setState (1 :: Int)
-    _ :: Either Bool () <- handleE $ do
+    _ :: Either Bool () <- handleToEitherRecursive $ do
         setState (2 :: Int)
         void $ throwSignal True
         setState (3 :: Int)
     st :: Int <- getState
     print st
 
+inc :: Int -> Int
+inc !x = x + 1
+
+task :: (MonadEffectState Int m, MonadIO m) => m Int
+task = do
+    replicateM_ 10000000 (modifyState inc)
+    st <- getState
+    st `seq` return st
+
 main :: IO ()
 main = do
     orderTest & handleException (\(_ :: Bool) -> return ())
               & handleStateT (0 :: Int)
     orderTest & handleStateT (0 :: Int)
               & handleException (\(_ :: Bool) -> return ())
+    putStrLn "Starting sequential test"
+    replicateM_ 8 (handleStateT (0 :: Int) task >>= print)
+    putStrLn "Sequential test done"
+    putStrLn "Starting parallel test"
+    handleStateT (0 :: Int) $ do
+        res <- parallelWithSequence (replicate 8 task)
+        mapM_ print res
+    putStrLn "Parallel test done"