diff --git a/benchmark/Benchmarks.hs b/benchmark/Benchmarks.hs --- a/benchmark/Benchmarks.hs +++ b/benchmark/Benchmarks.hs @@ -71,7 +71,7 @@ if x > 0 then S.put (x-1) >> m else return () benchCnt_Eff :: Int -> ((),Int) -benchCnt_Eff n = run $ E.S.runState m n +benchCnt_Eff n = run $ E.S.runState n m where m = do x <- E.S.get @@ -131,10 +131,10 @@ f acc x = return $! max acc x -mainMax_Eff n = ((run $ E.S.runState (E.Er.runError (benchMax_Eff n)) 0) :: +mainMax_Eff n = ((run $ E.S.runState 0 (E.Er.runError (benchMax_Eff n))) :: (Either Int Int,Int)) -mainMax1_Eff n = ((run $ E.Er.runError (E.S.runState (benchMax_Eff n) 0)) :: +mainMax1_Eff n = ((run $ E.Er.runError (E.S.runState 0 (benchMax_Eff n))) :: Either Int (Int,Int)) -- ------------------------------------------------------------------------ @@ -213,4 +213,4 @@ in ((l::[(Int,Int,Int)]), (cnt::Int)) where pyth2Er :: Int -> ([(Int,Int,Int)],Int) - pyth2Er n = run . (`E.S.runState` 0) . E.ND.makeChoiceA $ pyth2E n + pyth2Er n = run . E.S.runState 0 . E.ND.makeChoiceA $ pyth2E n diff --git a/extensible-effects.cabal b/extensible-effects.cabal --- a/extensible-effects.cabal +++ b/extensible-effects.cabal @@ -6,7 +6,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change -version: 2.5.3.0 +version: 2.6.0.0 -- A short (one-line) description of the package. synopsis: An Alternative to Monad Transformers diff --git a/src/Control/Eff/Example.hs b/src/Control/Eff/Example.hs --- a/src/Control/Eff/Example.hs +++ b/src/Control/Eff/Example.hs @@ -58,7 +58,7 @@ -- | Sum a list of numbers. sumEff :: (Num a) => [a] -> a -sumEff l = let ((), s) = run $ runState (sumAll l) 0 +sumEff l = let ((), s) = run $ runState 0 (sumAll l) in s -- | Safely get the last element of a list. @@ -70,7 +70,8 @@ -- | Get the last element and sum of a list lastAndSum :: (Num a) => [a] -> (Maybe a, a) -lastAndSum l = let (((), total), lst) = run $ runLastWriter $ runState (writeAndAdd l) 0 +lastAndSum l = let (((), total), lst) = + run $ runLastWriter $ runState 0 (writeAndAdd l) in (lst, total) diff --git a/src/Control/Eff/Reader/Lazy.hs b/src/Control/Eff/Reader/Lazy.hs --- a/src/Control/Eff/Reader/Lazy.hs +++ b/src/Control/Eff/Reader/Lazy.hs @@ -53,11 +53,10 @@ -- | The handler of Reader requests. The return type shows that all Reader -- requests are fully handled. -runReader :: Eff (Reader e ': r) w -> e -> Eff r w -runReader m e = handle_relay +runReader :: e -> Eff (Reader e ': r) w -> Eff r w +runReader e = handle_relay return (\Ask -> ($ e)) - m -- | Locally rebind the value in the dynamic environment This function is like a -- relay; it is both an admin for Reader requests, and a requestor of them. @@ -81,5 +80,5 @@ type StM (Eff (Reader e ': s)) a = StM (Eff s) a liftBaseWith f = do e <- ask raise $ liftBaseWith $ \runInBase -> - f (\k -> runInBase $ runReader k e) + f (runInBase . runReader e) restoreM = raise . restoreM diff --git a/src/Control/Eff/Reader/Strict.hs b/src/Control/Eff/Reader/Strict.hs --- a/src/Control/Eff/Reader/Strict.hs +++ b/src/Control/Eff/Reader/Strict.hs @@ -54,11 +54,10 @@ -- | The handler of Reader requests. The return type shows that all Reader -- requests are fully handled. -runReader :: Eff (Reader e ': r) w -> e -> Eff r w -runReader m !e = handle_relay +runReader :: e -> Eff (Reader e ': r) w -> Eff r w +runReader !e = handle_relay return (\Ask -> ($ e)) - m -- | Locally rebind the value in the dynamic environment This function is like a -- relay; it is both an admin for Reader requests, and a requestor of them @@ -82,5 +81,5 @@ type StM (Eff (Reader e ': s)) a = StM (Eff s) a liftBaseWith f = do !e <- ask raise $ liftBaseWith $ \runInBase -> - f (\k -> runInBase $ runReader k e) + f (runInBase . runReader e) restoreM = raise . restoreM diff --git a/src/Control/Eff/State/Lazy.hs b/src/Control/Eff/State/Lazy.hs --- a/src/Control/Eff/State/Lazy.hs +++ b/src/Control/Eff/State/Lazy.hs @@ -47,7 +47,7 @@ type StM (Eff (State s ': r)) a = StM (Eff r) (a,s) liftBaseWith f = do s <- get raise $ liftBaseWith $ \runInBase -> - f (\k -> runInBase $ runState k s) + f (runInBase . runState s) restoreM x = do (a, s :: s) <- raise (restoreM x) put s return a @@ -76,36 +76,35 @@ -- inline get/put, even if I put the INLINE directives and play with phases. -- (Inlining works if I use 'inline' explicitly). -runState' :: Eff (State s ': r) w -> s -> Eff r (w,s) -runState' m s = +runState' :: s -> Eff (State s ': r) w -> Eff r (w,s) +runState' s = handle_relay_s s (\s0 x -> return (x,s0)) (\s0 sreq k -> case sreq of Get -> k s0 s0 Put s1 -> k s1 ()) - m -- Since State is so frequently used, we optimize it a bit -- | Run a State effect -runState :: Eff (State s ': r) w -- ^ Effect incorporating State - -> s -- ^ Initial state +runState :: s -- ^ Initial state + -> Eff (State s ': r) w -- ^ Effect incorporating State -> Eff r (w,s) -- ^ Effect containing final state and a return value -runState (Val x) s = return (x,s) -runState (E u q) s = case decomp u of - Right Get -> runState (q ^$ s) s - Right (Put s1) -> runState (q ^$ ()) s1 - Left u1 -> E u1 (singleK (\x -> runState (q ^$ x) s)) +runState s (Val x) = return (x,s) +runState s (E u q) = case decomp u of + Right Get -> runState s (q ^$ s) + Right (Put s1) -> runState s1 (q ^$ ()) + Left u1 -> E u1 (singleK (\x -> runState s (q ^$ x))) -- | Transform the state with a function. modify :: (Member (State s) r) => (s -> s) -> Eff r () modify f = get >>= put . f -- | Run a State effect, discarding the final state. -evalState :: Eff (State s ': r) w -> s -> Eff r w -evalState m s = fmap fst . flip runState s $ m +evalState :: s -> Eff (State s ': r) w -> Eff r w +evalState s = fmap fst . runState s -- | Run a State effect and return the final state. -execState :: Eff (State s ': r) w -> s -> Eff r s -execState m s = fmap snd . flip runState s $ m +execState :: s -> Eff (State s ': r) w -> Eff r s +execState s = fmap snd . runState s -- | An encapsulated State handler, for transactional semantics -- The global state is updated only if the transactionState finished @@ -125,8 +124,8 @@ -- | A different representation of State: decomposing State into mutation -- (Writer) and Reading. We don't define any new effects: we just handle the -- existing ones. Thus we define a handler for two effects together. -runStateR :: Eff (Writer s ': Reader s ': r) w -> s -> Eff r (w,s) -runStateR m s = loop s m +runStateR :: s -> Eff (Writer s ': Reader s ': r) w -> Eff r (w,s) +runStateR s m = loop s m where loop :: s -> Eff (Writer s ': Reader s ': r) w -> Eff r (w,s) loop s0 (Val x) = return (x,s0) diff --git a/src/Control/Eff/State/OnDemand.hs b/src/Control/Eff/State/OnDemand.hs --- a/src/Control/Eff/State/OnDemand.hs +++ b/src/Control/Eff/State/OnDemand.hs @@ -38,7 +38,7 @@ type StM (Eff (OnDemandState s ': r)) a = StM (Eff r) (a,s) liftBaseWith f = do s <- get raise $ liftBaseWith $ \runInBase -> - f (\k -> runInBase $ runState k s) + f (runInBase . runState s) restoreM x = do (a, s :: s) <- raise (restoreM x) put s return a @@ -71,47 +71,46 @@ onDemand :: Member (OnDemandState s) r => Eff '[OnDemandState s] v -> Eff r v onDemand = send . Delay -runState' :: Eff (OnDemandState s ': r) w -> s -> Eff r (w,s) -runState' m s = +runState' :: s -> Eff (OnDemandState s ': r) w -> Eff r (w,s) +runState' s = handle_relay_s s (\s0 x -> return (x,s0)) (\s0 sreq k -> case sreq of Get -> k s0 s0 Put s1 -> k s1 () - Delay m1 -> let ~(x,s1) = run $ runState' m1 s0 + Delay m1 -> let ~(x,s1) = run $ runState' s0 m1 in k s1 x) - m -- Since State is so frequently used, we optimize it a bit -- | Run a State effect -runState :: Eff (OnDemandState s ': r) w -- ^ Effect incorporating State - -> s -- ^ Initial state - -> Eff r (w,s) -- ^ Effect containing final state and a return value -runState (Val x) s = return (x,s) -runState (E u0 q) s0 = case decomp u0 of - Right Get -> runState (q ^$ s0) s0 - Right (Put s1) -> runState (q ^$ ()) s1 - Right (Delay m1) -> let ~(x,s1) = run $ runState m1 s0 - in runState (q ^$ x) s1 - Left u -> E u (singleK (\x -> runState (q ^$ x) s0)) +runState :: s -- ^ Initial state + -> Eff (OnDemandState s ': r) w -- ^ Effect incorporating State + -> Eff r (w,s) -- ^ Effect containing final state and a return value +runState s (Val x) = return (x,s) +runState s0 (E u0 q) = case decomp u0 of + Right Get -> runState s0 (q ^$ s0) + Right (Put s1) -> runState s1 (q ^$ ()) + Right (Delay m1) -> let ~(x,s1) = run $ runState s0 m1 + in runState s1 (q ^$ x) + Left u -> E u (singleK (\x -> runState s0 (q ^$ x))) -- | Transform the state with a function. modify :: (Member (OnDemandState s) r) => (s -> s) -> Eff r () modify f = get >>= put . f -- | Run a State effect, discarding the final state. -evalState :: Eff (OnDemandState s ': r) w -> s -> Eff r w -evalState m s = fmap fst . flip runState s $ m +evalState :: s -> Eff (OnDemandState s ': r) w -> Eff r w +evalState s = fmap fst . runState s -- | Run a State effect and return the final state. -execState :: Eff (OnDemandState s ': r) w -> s -> Eff r s -execState m s = fmap snd . flip runState s $ m +execState :: s -> Eff (OnDemandState s ': r) w -> Eff r s +execState s = fmap snd . runState s -- | A different representation of State: decomposing State into mutation -- (Writer) and Reading. We don't define any new effects: we just handle the -- existing ones. Thus we define a handler for two effects together. -runStateR :: Eff (Writer s ': Reader s ': r) w -> s -> Eff r (w,s) -runStateR m0 s0 = loop s0 m0 +runStateR :: s -> Eff (Writer s ': Reader s ': r) w -> Eff r (w,s) +runStateR s0 m0 = loop s0 m0 where loop :: s -> Eff (Writer s ': Reader s ': r) w -> Eff r (w,s) loop s (Val x) = return (x,s) diff --git a/src/Control/Eff/State/Strict.hs b/src/Control/Eff/State/Strict.hs --- a/src/Control/Eff/State/Strict.hs +++ b/src/Control/Eff/State/Strict.hs @@ -48,7 +48,7 @@ type StM (Eff (State s ': r)) a = StM (Eff r) (a,s) liftBaseWith f = do s <- get raise $ liftBaseWith $ \runInBase -> - f (\k -> runInBase $ runState k s) + f (runInBase . runState s) restoreM x = do !(a, s :: s) <- raise (restoreM x) put s return a @@ -78,36 +78,37 @@ -- inline get/put, even if I put the INLINE directives and play with phases. -- (Inlining works if I use 'inline' explicitly). -runState' :: Eff (State s ': r) w -> s -> Eff r (w,s) -runState' m !s = +runState' :: s -> Eff (State s ': r) w -> Eff r (w,s) +runState' !s = handle_relay_s s (\s0 x -> return (x,s0)) (\s0 sreq k -> case sreq of Get -> k s0 s0 Put s1 -> k s1 ()) - m -- Since State is so frequently used, we optimize it a bit -- | Run a State effect -runState :: Eff (State s ': r) w -- ^ Effect incorporating State - -> s -- ^ Initial state +runState :: s -- ^ Effect incorporating State + -> Eff (State s ': r) w -- ^ Initial state -> Eff r (w,s) -- ^ Effect containing final state and a return value -runState (Val x) !s = return (x,s) -runState (E u q) !s = case decomp u of - Right Get -> runState (q ^$ s) s - Right (Put s1) -> runState (q ^$ ()) s1 - Left u1 -> E u1 (singleK (\x -> runState (q ^$ x) s)) +runState !s (Val x) = return (x,s) +runState !s (E u q) = case decomp u of + Right Get -> runState s (q ^$ s) + Right (Put s1) -> runState s1 (q ^$ ()) + Left u1 -> E u1 (singleK (\x -> runState s (q ^$ x))) -- | Transform the state with a function. modify :: (Member (State s) r) => (s -> s) -> Eff r () modify f = get >>= put . f -- | Run a State effect, discarding the final state. -evalState :: Eff (State s ': r) w -> s -> Eff r w -evalState m !s = fmap fst . flip runState s $ m +evalState :: s -> Eff (State s ': r) w -> Eff r w +evalState !s = fmap fst . runState s +{-# INLINE evalState #-} -- | Run a State effect and return the final state. -execState :: Eff (State s ': r) w -> s -> Eff r s -execState m !s = fmap snd . flip runState s $ m +execState :: s -> Eff (State s ': r) w -> Eff r s +execState !s = fmap snd . runState s +{-# INLINE execState #-} -- | An encapsulated State handler, for transactional semantics -- The global state is updated only if the transactionState finished @@ -127,8 +128,8 @@ -- | A different representation of State: decomposing State into mutation -- (Writer) and Reading. We don't define any new effects: we just handle the -- existing ones. Thus we define a handler for two effects together. -runStateR :: Eff (Writer s ': Reader s ': r) w -> s -> Eff r (w,s) -runStateR m !s = loop s m +runStateR :: s -> Eff (Writer s ': Reader s ': r) w -> Eff r (w,s) +runStateR !s m = loop s m where loop :: s -> Eff (Writer s ': Reader s ': r) w -> Eff r (w,s) loop s0 (Val x) = return (x,s0) diff --git a/src/Control/Eff/Writer/Lazy.hs b/src/Control/Eff/Writer/Lazy.hs --- a/src/Control/Eff/Writer/Lazy.hs +++ b/src/Control/Eff/Writer/Lazy.hs @@ -17,6 +17,11 @@ , runLastWriter , runListWriter , runMonoidWriter + , execWriter + , execFirstWriter + , execLastWriter + , execListWriter + , execMonoidWriter ) where import Control.Eff.Internal @@ -89,3 +94,33 @@ -- | Handle Writer requests by overwriting previous values. runLastWriter :: Eff (Writer w ': r) a -> Eff r (a, Maybe w) runLastWriter = runWriter (\w b -> b <|> Just w) Nothing + +-- | Handle Writer requests, using a user-provided function to accumulate +-- values and returning the final accumulated values. +execWriter :: (w -> b -> b) -> b -> Eff (Writer w ': r) a -> Eff r b +execWriter accum b = fmap snd . runWriter accum b +{-# INLINE execWriter #-} + +-- | Handle Writer requests, using a List to accumulate values and returning +-- the final accumulated values. +execListWriter :: Eff (Writer w ': r) a -> Eff r [w] +execListWriter = fmap snd . runListWriter +{-# INLINE execListWriter #-} + +-- | Handle Writer requests, using a Monoid instance to accumulate values and +-- returning the final accumulated values. +execMonoidWriter :: (Monoid w) => Eff (Writer w ': r) a -> Eff r w +execMonoidWriter = fmap snd . runMonoidWriter +{-# INLINE execMonoidWriter #-} + +-- | Handle Writer requests by taking the first value provided and and returning +-- the final accumulated values. +execFirstWriter :: Eff (Writer w ': r) a -> Eff r (Maybe w) +execFirstWriter = fmap snd . runFirstWriter +{-# INLINE execFirstWriter #-} + +-- | Handle Writer requests by overwriting previous values and returning +-- the final accumulated values. +execLastWriter :: Eff (Writer w ': r) a -> Eff r (Maybe w) +execLastWriter = fmap snd . runLastWriter +{-# INLINE execLastWriter #-} diff --git a/src/Control/Eff/Writer/Strict.hs b/src/Control/Eff/Writer/Strict.hs --- a/src/Control/Eff/Writer/Strict.hs +++ b/src/Control/Eff/Writer/Strict.hs @@ -18,6 +18,11 @@ , runLastWriter , runListWriter , runMonoidWriter + , execWriter + , execFirstWriter + , execLastWriter + , execListWriter + , execMonoidWriter ) where import Control.Eff.Internal @@ -90,3 +95,33 @@ -- | Handle Writer requests by overwriting previous values. runLastWriter :: Eff (Writer w ': r) a -> Eff r (a, Maybe w) runLastWriter = runWriter (\w b -> b <|> Just w) Nothing + +-- | Handle Writer requests, using a user-provided function to accumulate +-- values and returning the final accumulated values. +execWriter :: (w -> b -> b) -> b -> Eff (Writer w ': r) a -> Eff r b +execWriter accum b = fmap snd . runWriter accum b +{-# INLINE execWriter #-} + +-- | Handle Writer requests, using a List to accumulate values and returning +-- the final accumulated values. +execListWriter :: Eff (Writer w ': r) a -> Eff r [w] +execListWriter = fmap snd . runListWriter +{-# INLINE execListWriter #-} + +-- | Handle Writer requests, using a Monoid instance to accumulate values and +-- returning the final accumulated values. +execMonoidWriter :: (Monoid w) => Eff (Writer w ': r) a -> Eff r w +execMonoidWriter = fmap snd . runMonoidWriter +{-# INLINE execMonoidWriter #-} + +-- | Handle Writer requests by taking the first value provided and and returning +-- the final accumulated values. +execFirstWriter :: Eff (Writer w ': r) a -> Eff r (Maybe w) +execFirstWriter = fmap snd . runFirstWriter +{-# INLINE execFirstWriter #-} + +-- | Handle Writer requests by overwriting previous values and returning +-- the final accumulated values. +execLastWriter :: Eff (Writer w ': r) a -> Eff r (Maybe w) +execLastWriter = fmap snd . runLastWriter +{-# INLINE execLastWriter #-} diff --git a/test/Control/Eff/Coroutine/Test.hs b/test/Control/Eff/Coroutine/Test.hs --- a/test/Control/Eff/Coroutine/Test.hs +++ b/test/Control/Eff/Coroutine/Test.hs @@ -53,12 +53,12 @@ th2 = ask >>= yieldInt >> (ask >>= yieldInt) -- Code is essentially the same as in transf.hs; no liftIO though - c2 = runTrace $ runReader (loop =<< runC th2) (10::Int) + c2 = runTrace $ runReader (10::Int) (loop =<< runC th2) where loop (Y x k) = trace (show (x::Int)) >> k () >>= loop loop Done = trace "Done" -- locally changing the dynamic environment for the suspension - c21 = runTrace $ runReader (loop =<< runC th2) (10::Int) + c21 = runTrace $ runReader (10::Int) (loop =<< runC th2) where loop (Y x k) = trace (show (x::Int)) >> local (+(1::Int)) (k ()) >>= loop loop Done = trace "Done" @@ -79,20 +79,20 @@ th3 = ay >> ay >> local (+(10::Int)) (ay >> ay) where ay = ask >>= yieldInt - c3 = runTrace $ runReader (loop =<< runC th3) (10::Int) + c3 = runTrace $ runReader (10::Int) (loop =<< runC th3) where loop (Y x k) = trace (show (x::Int)) >> k () >>= loop loop Done = trace "Done" -- The desired result: the coroutine shares the dynamic environment with its -- parent; however, when the environment is locally rebound, it becomes -- private to coroutine. - c31 = runTrace $ runReader (loop =<< runC th3) (10::Int) + c31 = runTrace $ runReader (10::Int) (loop =<< runC th3) where loop (Y x k) = trace (show (x::Int)) >> local (+(1::Int)) (k ()) >>= loop loop Done = trace "Done" -- We now make explicit that the client computation, run by th4, -- is abstract. We abstract it out of th4 - c4 = runTrace $ runReader (loop =<< runC (th4 client)) (10::Int) + c4 = runTrace $ runReader (10::Int) (loop =<< runC (th4 client)) where loop (Y x k) = trace (show (x::Int)) >> local (+(1::Int)) (k ()) >>= loop loop Done = trace "Done" @@ -121,7 +121,7 @@ assertEqual "Corountine: Even more dynamic example" expected actual where - c5 = runTrace $ runReader (loop =<< runC (th client)) (10::Int) + c5 = runTrace $ runReader (10::Int) (loop =<< runC (th client)) where loop (Y x k) = trace (show (x::Int)) >> local (\_y->x+1) (k ()) >>= loop loop Done = trace "Done" @@ -163,7 +163,7 @@ expected actual where c7 = runTrace $ - runReader (runReader (loop =<< runC (th client)) (10::Int)) (1000::Double) + runReader (1000::Double) (runReader (10::Int) (loop =<< runC (th client))) where loop (Y x k) = trace (show (x::Int)) >> local (\_y->fromIntegral (x+1)::Double) (k ()) >>= loop loop Done = trace "Done" @@ -207,7 +207,7 @@ expected actual where c7' = runTrace $ - runReader (runReader (loop =<< runC (th client)) (10::Int)) (1000::Double) + runReader (1000::Double) (runReader (10::Int) (loop =<< runC (th client))) where loop (Y x k) = trace (show (x::Int)) >> local (\_y->fromIntegral (x+1)::Double) (k ()) >>= loop loop Done = trace "Done" diff --git a/test/Control/Eff/Example/Test.hs b/test/Control/Eff/Example/Test.hs --- a/test/Control/Eff/Example/Test.hs +++ b/test/Control/Eff/Example/Test.hs @@ -30,33 +30,33 @@ case_Exception1_ex2r :: Assertion case_Exception1_ex2r = (Right 5) @=? (run ex2r) where - ex2r = runReader (runErrBig (ex2 ask)) (5::Int) + ex2r = runReader (5::Int) (runErrBig (ex2 ask)) case_Exception1_ex2r1 :: Assertion case_Exception1_ex2r1 = (Left (TooBig 7)) @=? (run ex2r1) where - ex2r1 = runReader (runErrBig (ex2 ask)) (7::Int) + ex2r1 = runReader (7::Int) (runErrBig (ex2 ask)) -- Different order of handlers (layers) case_Exception1_ex2r2 :: Assertion case_Exception1_ex2r2 = (Left (TooBig 7)) @=? (run ex2r2) where - ex2r2 = runErrBig (runReader (ex2 ask) (7::Int)) + ex2r2 = runErrBig (runReader (7::Int) (ex2 ask)) case_multiple_eff_sum2 :: Assertion case_multiple_eff_sum2 = assertEqual "Int : Float" 33 intThenFloat >> assertEqual "Float : Int" intThenFloat floatThenInt where - intThenFloat = run $ runReader (runReader sum2 (10::Int)) (20::Float) - floatThenInt = run $ runReader (runReader sum2 (20::Float)) (10::Int) + intThenFloat = run $ runReader (20::Float) (runReader (10::Int) sum2) + floatThenInt = run $ runReader (10::Int) (runReader (20::Float) sum2) prop_Documentation_example :: [Integer] -> Property prop_Documentation_example l = let - ((), total1) = run $ runState (sumAll l) 0 + ((), total1) = run $ runState 0 (sumAll l) ((), last1) = run $ runLastWriter $ writeAll l - (((), last2), total2) = run $ runState (runLastWriter (writeAndAdd l)) 0 - (((), total3), last3) = run $ runLastWriter $ runState (writeAndAdd l) 0 + (((), last2), total2) = run $ runState 0 (runLastWriter (writeAndAdd l)) + (((), total3), last3) = run $ runLastWriter $ runState 0 (writeAndAdd l) in allEqual [safeLast l, last1, last2, last3] .&&. allEqual [sum l, total1, total2, total3] diff --git a/test/Control/Eff/Lift/Test.hs b/test/Control/Eff/Lift/Test.hs --- a/test/Control/Eff/Lift/Test.hs +++ b/test/Control/Eff/Lift/Test.hs @@ -33,7 +33,7 @@ where input = (5::Int) -- tl1r :: IO () - tl1r = runLift (runReader tl1 input) + tl1r = runLift (runReader input tl1) where tl1 = ask >>= \(x::Int) -> lift . print $ x @@ -47,7 +47,7 @@ val = (10::Int) output = map (+ val) input - tMd' = runLift $ runReader (mapMdebug' f input) val + tMd' = runLift $ runReader val $ mapMdebug' f input where f x = ask `add` return x -- Re-implemenation of mapMdebug using Lifting @@ -83,7 +83,7 @@ -- exception is caught. Here, the state is preserved! -- So, this is an advantage over MTL! test1 = do runLift (tf True) >>= print; runLift (tf False) >>= print - tf x = runReader (runState (testc m) ([]::[String])) (x::Bool) + tf x = runReader (x::Bool) . runState ([]::[String]) $ testc m m = do modify ("begin":) x <- ask @@ -105,7 +105,7 @@ -- exception is caught. Here, the state is preserved! -- So, this is an advantage over MTL! test1' = do runLift (tf True) >>= print; runLift (tf False) >>= print - tf x = runReader (runState (runErrorStr (testc m)) ([]::[String])) (x::Bool) + tf x = runReader (x::Bool) . runState ([]::[String]) $ runErrorStr (testc m) m = do modify ("begin":) x <- ask @@ -130,7 +130,7 @@ expected actual where test2 = do runLift (tf True) >>= print; runLift (tf False) >>= print - tf x = runReader (runState (runErrorStr (testc m)) ([]::[String])) (x::Bool) + tf x = runReader (x::Bool) . runState ([]::[String]) $ runErrorStr (testc m) runErrorStr = asEStr . runError asEStr :: m (Either String a) -> m (Either String a) asEStr = id @@ -151,7 +151,7 @@ expected actual where test2' = do runLift (tf True) >>= print; runLift (tf False) >>= print - tf x = runReader (runState (runErrorStr (testc m)) ([]::[String])) (x::Bool) + tf x = runReader (x::Bool) . runState ([]::[String]) $ runErrorStr (testc m) runErrorStr = asEStr . runError asEStr :: m (Either String a) -> m (Either String a) asEStr = id @@ -172,7 +172,7 @@ expected actual where test3 = do runLift (tf True) >>= print; runLift (tf False) >>= print - tf x = runReader (runState (runErrorStr (testc m)) ([]::[String])) (x::Bool) + tf x = runReader (x::Bool) . runState ([]::[String]) $ runErrorStr (testc m) runErrorStr = asEStr . runError asEStr :: m (Either String a) -> m (Either String a) asEStr = id @@ -198,7 +198,7 @@ expected actual where tran = do runLift (tf True) >>= print; runLift (tf False) >>= print - tf x = runReader (runState m1 ([]::[String])) (x::Bool) + tf x = runReader (x :: Bool) . runState ([]::[String]) $ m1 m1 = do modify ("init":) testc (transactionState (TxState :: TxState [String]) m) diff --git a/test/Control/Eff/Operational/Test.hs b/test/Control/Eff/Operational/Test.hs --- a/test/Control/Eff/Operational/Test.hs +++ b/test/Control/Eff/Operational/Test.hs @@ -23,7 +23,7 @@ , Member (Writer String) r) => Eff r () comp = runProgram Eg.adventPure Eg.prog - go = snd . run . runMonoidWriter $ evalState comp ["foo", "bar"] + go = snd . run . runMonoidWriter $ evalState ["foo", "bar"] comp in assertEqual "Evaluating Operational Monad example" diff --git a/test/Control/Eff/Reader/Lazy/Test.hs b/test/Control/Eff/Reader/Lazy/Test.hs --- a/test/Control/Eff/Reader/Lazy/Test.hs +++ b/test/Control/Eff/Reader/Lazy/Test.hs @@ -23,7 +23,7 @@ case_Lazy1_Reader_t1 :: Assertion case_Lazy1_Reader_t1 = let t1' = do v <- ask; return (v + 1 :: Int) - t1r = runReader t1 (10::Int) + t1r = runReader (10::Int) t1 in -- 'run t1' should result in type-error 11 @=? (run t1r) @@ -36,8 +36,8 @@ case_Lazy1_Reader_t2 :: Assertion case_Lazy1_Reader_t2 = let - t2r = runReader t2 (10::Int) - t2rr = flip runReader (20::Float) . flip runReader (10::Int) $ t2 + t2r = runReader (10::Int) t2 + t2rr = runReader (20::Float) . runReader (10::Int) $ t2 in 33.0 @=? (run t2rr) @@ -49,14 +49,14 @@ -} case_Lazy1_Reader_t2' :: Assertion case_Lazy1_Reader_t2' = 33.0 @=? - (run $ runReader (runReader t2 (20::Float)) (10::Int)) + (run $ runReader (10 :: Int) . runReader (20 :: Float) $ t2) case_Lazy1_Reader_t3 :: Assertion case_Lazy1_Reader_t3 = let t3 = t1 `add` local (+ (10::Int)) t1 in - 212 @=? (run $ runReader t3 (100::Int)) + 212 @=? (run $ runReader (100::Int) t3) -- The following example demonstrates true interleaving of Reader Int -- and Reader Float layers @@ -70,12 +70,12 @@ case_Lazy1_Reader_t4 :: Assertion case_Lazy1_Reader_t4 = 106.0 @=? - (run $ runReader (runReader t4 (20::Float)) (10::Int)) + (run $ runReader (10::Int) . runReader (20::Float) $ t4) -- The opposite order of layers gives the same result case_Lazy1_Reader_t4' :: Assertion case_Lazy1_Reader_t4' = 106.0 @=? - (run $ runReader (runReader t4 (20::Float)) (10::Int)) + (run $ runReader (10::Int) . runReader (20::Float) $ t4) -- Map an effectful function case_Lazy1_Reader_tmap :: Assertion @@ -83,13 +83,13 @@ tmap = mapM f [1..5] in ([11,12,13,14,15] :: [Int]) @=? - (run $ runReader tmap (10::Int)) + (run $ runReader (10::Int) tmap) where f x = ask `add` return x case_Lazy1_Reader_runReader :: Assertion case_Lazy1_Reader_runReader = let - e = run $ runReader voidReader (undefined :: ()) + e = run $ runReader (undefined :: ()) voidReader in assertNoUndefined (e :: ()) where @@ -99,7 +99,7 @@ case_Lazy1_Reader_monadBaseControl :: Assertion case_Lazy1_Reader_monadBaseControl = - runLift (runReader act i) @=? (Just i) + runLift (runReader i act) @=? (Just i) where act = doThing ask i = 10 :: Int diff --git a/test/Control/Eff/Reader/Strict/Test.hs b/test/Control/Eff/Reader/Strict/Test.hs --- a/test/Control/Eff/Reader/Strict/Test.hs +++ b/test/Control/Eff/Reader/Strict/Test.hs @@ -18,7 +18,7 @@ case_Strict1_Reader_runReader :: Assertion case_Strict1_Reader_runReader = let - e = run $ runReader voidReader (undefined :: ()) + e = run $ runReader (undefined :: ()) voidReader in assertUndefined (e :: ()) where @@ -28,7 +28,7 @@ case_Strict1_Reader_monadBaseControl :: Assertion case_Strict1_Reader_monadBaseControl = - runLift (runReader act i) @=? (Just i) + runLift (runReader i act) @=? (Just i) where act = doThing ask i = 10 :: Int diff --git a/test/Control/Eff/State/Lazy/Test.hs b/test/Control/Eff/State/Lazy/Test.hs --- a/test/Control/Eff/State/Lazy/Test.hs +++ b/test/Control/Eff/State/Lazy/Test.hs @@ -19,7 +19,7 @@ case_Lazy1_State_runState :: Assertion case_Lazy1_State_runState = let (r, ()) = run - $ flip runState undefined + $ runState undefined $ getVoid >> putVoid undefined >> putVoid () @@ -33,7 +33,7 @@ putVoid = put case_Lazy1_State_monadBaseControl :: Assertion -case_Lazy1_State_monadBaseControl = runLift (runState (doThing $ modify f) i) @=? Just ((), i + 1) +case_Lazy1_State_monadBaseControl = runLift (runState i (doThing $ modify f)) @=? Just ((), i + 1) where i = 0 :: Int f = succ :: Int -> Int diff --git a/test/Control/Eff/State/OnDemand/Test.hs b/test/Control/Eff/State/OnDemand/Test.hs --- a/test/Control/Eff/State/OnDemand/Test.hs +++ b/test/Control/Eff/State/OnDemand/Test.hs @@ -20,7 +20,7 @@ case_LazierState_ex1 :: Assertion case_LazierState_ex1 = - let actual = run $ runState lex1 0 + let actual = run $ runState 0 lex1 in assertEqual "OnDemandState: ex1" ((), 1::Int) actual @@ -31,7 +31,7 @@ case_LazierState_ex3 :: Assertion case_LazierState_ex3 = - let (x,s) = run $ runState lex3 (undefined::[Int]) + let (x,s) = run $ runState (undefined::[Int]) lex3 in assertEqual "OnDemandState: ex3" ((),[1,1,1,1,1]) (x,take 5 s) where @@ -41,7 +41,7 @@ -- a bit more interesting case_LazierState_ex4 = - let (x,s) = run $ runState lex4 [] + let (x,s) = run $ runState [] lex4 in assertEqual "OnDemandState: ex4" expect (take 7 $ x,take 5 $ s) where @@ -62,8 +62,8 @@ case_LazierState_ex5 = let -- the annotations below are needed for assertEqual - ex5Run :: Either [Int] () = fst . run $ runState (runError lex5) (undefined::[Int]) - ex51Run :: Either [Int] ((), [Int]) = run $ runError $ runState lex5 (undefined::[Int]) + ex5Run :: Either [Int] () = fst . run $ runState (undefined::[Int]) (runError lex5) + ex51Run :: Either [Int] ((), [Int]) = run $ runError $ runState (undefined::[Int]) lex5 in assertEqual "OnDemandState ex5" (Left ones) ex5Run >> assertEqual "OnDemandState ex51" (Left ones) ex51Run @@ -81,7 +81,7 @@ case_LazierState_st :: Assertion case_LazierState_st = let - stF :: ((Int,Int,Int),Int) = run $ runState st (0::Int) + stF :: ((Int,Int,Int),Int) = run $ runState (0::Int) st stB0 :: ((Int,Int,Int),Int) = runStateBack0 st stB :: ((Int,Int,Int),Int) = runStateBack st in @@ -110,7 +110,7 @@ assertEqual "OnDemandState ones" [1,1,1,1,1] (take 5 ones) case_LazierState_monadBaseControl :: Assertion -case_LazierState_monadBaseControl = runLift (runState (doThing $ modify f) i) @=? Just ((), i + 1) +case_LazierState_monadBaseControl = runLift (runState i (doThing $ modify f)) @=? Just ((), i + 1) where i = 0 :: Int f = succ :: Int -> Int diff --git a/test/Control/Eff/State/Strict/Test.hs b/test/Control/Eff/State/Strict/Test.hs --- a/test/Control/Eff/State/Strict/Test.hs +++ b/test/Control/Eff/State/Strict/Test.hs @@ -22,7 +22,7 @@ case_Strict1_State_runState :: Assertion case_Strict1_State_runState = let (r, ()) = run - $ (flip runState) undefined + $ runState undefined $ getVoid >> putVoid undefined >> putVoid () @@ -36,7 +36,7 @@ putVoid = put case_Strict1_State_ts1 :: Assertion -case_Strict1_State_ts1 = (10,10) @=? (run (runState ts1 (0::Int))) +case_Strict1_State_ts1 = (10,10) @=? (run (runState (0::Int) ts1)) where ts1 = do put (10 ::Int) @@ -45,7 +45,7 @@ case_Strict1_State_ts11 :: Assertion case_Strict1_State_ts11 = - (10,10) @=? (run (runStateR ts11 (0::Int))) + (10,10) @=? (run (runStateR (0::Int) ts11)) where ts11 = do tell (10 ::Int) @@ -54,7 +54,7 @@ case_Strict1_State_ts2 :: Assertion case_Strict1_State_ts2 = (30::Int,20::Int) @=? - (run (runState ts2 (0::Int))) + (run (runState (0::Int) ts2)) where ts2 = do put (10::Int) @@ -65,7 +65,7 @@ case_Strict1_State_ts21 :: Assertion case_Strict1_State_ts21 = (30::Int,20::Int) @=? - (run (runStateR ts21 (0::Int))) + (run (runStateR (0::Int) ts21)) where ts21 = do tell (10::Int) @@ -84,25 +84,26 @@ case_Strict1_State_ter1 :: Assertion case_Strict1_State_ter1 = (Left "exc" :: Either String Int,2) @=? - (run $ runState (runError tes1) (1::Int)) + (run $ runState (1::Int) (runError tes1)) case_Strict1_State_ter2 :: Assertion case_Strict1_State_ter2 = (Left "exc" :: Either String (Int,Int)) @=? - (run $ runError (runState tes1 (1::Int))) + (run $ runError (runState (1::Int) tes1)) teCatch :: Member (Exc String) r => Eff r a -> Eff r [Char] teCatch m = catchError (m >> return "done") (\e -> return (e::String)) case_Strict1_State_ter3 :: Assertion case_Strict1_State_ter3 = (Right "exc" :: Either String String,2) @=? - (run $ runState (runError (teCatch tes1)) (1::Int)) + (run $ runState (1::Int) (runError (teCatch tes1))) case_Strict1_State_ter4 :: Assertion case_Strict1_State_ter4 = (Right ("exc",2) :: Either String (String,Int)) @=? - (run $ runError (runState (teCatch tes1) (1::Int))) + (run $ runError (runState (1::Int) (teCatch tes1))) case_Strict1_State_monadBaseControl :: Assertion -case_Strict1_State_monadBaseControl = runLift (runState (doThing $ modify f) i) @=? Just ((), i + 1) +case_Strict1_State_monadBaseControl = runLift (runState i (doThing $ modify f)) @=? + Just ((), i + 1) where i = 0 :: Int f = succ :: Int -> Int diff --git a/test/Control/Eff/Test.hs b/test/Control/Eff/Test.hs --- a/test/Control/Eff/Test.hs +++ b/test/Control/Eff/Test.hs @@ -18,12 +18,12 @@ prop_NestedEff = forAll arbitrary (\x -> property (qu x == x)) where qu :: Bool -> Bool - qu x = run $ runReader (readerAp x) readerId + qu x = run $ runReader readerId (readerAp x) readerAp :: Bool -> Eff '[Reader (Eff '[Reader Bool] Bool)] Bool readerAp x = do f <- ask - return . run $ runReader f x + return . run $ runReader x f readerId :: Eff '[Reader Bool] Bool readerId = do diff --git a/test/Control/Eff/Trace/Test.hs b/test/Control/Eff/Trace/Test.hs --- a/test/Control/Eff/Trace/Test.hs +++ b/test/Control/Eff/Trace/Test.hs @@ -22,10 +22,10 @@ assertEqual "Trace: duplicate layers" (unlines ["Asked: 20", "Asked: 10"]) actual where - tdup = runTrace $ runReader m (10::Int) + tdup = runTrace $ runReader (10::Int) m where m = do - runReader tr (20::Int) + runReader (20::Int) tr tr tr = do v <- ask @@ -39,7 +39,7 @@ where val = (10::Int) input = [1..5] - tMd = runTrace $ runReader (mapMdebug f input) val + tMd = runTrace $ runReader val (mapMdebug f input) where f x = ask `add` return x diff --git a/test/Control/Eff/Writer/Lazy/Test.hs b/test/Control/Eff/Writer/Lazy/Test.hs --- a/test/Control/Eff/Writer/Lazy/Test.hs +++ b/test/Control/Eff/Writer/Lazy/Test.hs @@ -28,7 +28,7 @@ case_Lazy1_Writer_rdwr :: Assertion case_Lazy1_Writer_rdwr = (10, ["begin", "end"]) @=? - (run . (`runReader` (1::Int)) . runListWriter $ rdwr) + (run . runReader (1::Int) . runListWriter $ rdwr) where rdwr = do tell "begin"