diff --git a/bench/Core.hs b/bench/Core.hs index 7861f40..7ba01cd 100644 --- a/bench/Core.hs +++ b/bench/Core.hs @@ -39,6 +39,10 @@ import Control.Monad.Freer.Exception (runError, throwError) import Control.Monad.Freer.State (get, put, runState) import Control.Monad.Freer.StateRW (ask, tell, runStateR) +import qualified Control.Eff as EE +import qualified Control.Eff.Exception as EE +import qualified Control.Eff.State.Lazy as EE + -------------------------------------------------------------------------------- -- State Benchmarks -- -------------------------------------------------------------------------------- @@ -49,18 +53,25 @@ oneGet = run . runState get oneGetMTL :: Int -> (Int, Int) oneGetMTL = MTL.runState MTL.get -countDown :: Int -> (Int,Int) +oneGetEE :: Int -> (Int, Int) +oneGetEE n = EE.run $ EE.runState n EE.get + +countDown :: Int -> (Int, Int) countDown start = run (runState go start) where go = get >>= (\n -> if n <= 0 then pure n else put (n-1) >> go) -countDownRW :: Int -> (Int,Int) +countDownRW :: Int -> (Int, Int) countDownRW start = run (runStateR go start) where go = ask >>= (\n -> if n <= 0 then pure n else tell (n-1) >> go) -countDownMTL :: Int -> (Int,Int) +countDownMTL :: Int -> (Int, Int) countDownMTL = MTL.runState go where go = MTL.get >>= (\n -> if n <= 0 then pure n else MTL.put (n-1) >> go) +countDownEE :: Int -> (Int, Int) +countDownEE start = EE.run $ EE.runState start go + where go = EE.get >>= (\n -> if n <= 0 then pure n else EE.put (n-1) >> go) + -------------------------------------------------------------------------------- -- Exception + State -- -------------------------------------------------------------------------------- @@ -72,6 +83,10 @@ countDownExcMTL :: Int -> Either String (Int,Int) countDownExcMTL = MTL.runStateT go where go = MTL.get >>= (\n -> if n <= (0 :: Int) then MTL.throwError "wat" else MTL.put (n-1) >> go) +countDownExcEE :: Int -> Either String (Int,Int) +countDownExcEE start = EE.run $ EE.runExc (EE.runState start go) + where go = EE.get >>= (\n -> if n <= (0 :: Int) then EE.throwExc "wat" else EE.put (n-1) >> go) + -------------------------------------------------------------------------------- -- Freer: Interpreter -- -------------------------------------------------------------------------------- @@ -154,15 +169,18 @@ main = bgroup "State" [ bench "freer.get" $ whnf oneGet 0 , bench "mtl.get" $ whnf oneGetMTL 0 + , bench "ee.get" $ whnf oneGetEE 0 ], bgroup "Countdown Bench" [ bench "freer.State" $ whnf countDown 10000 , bench "freer.StateRW" $ whnf countDownRW 10000 , bench "mtl.State" $ whnf countDownMTL 10000 + , bench "ee.State" $ whnf countDownEE 10000 ], bgroup "Countdown+Except Bench" [ bench "freer.ExcState" $ whnf countDownExc 10000 , bench "mtl.ExceptState" $ whnf countDownExcMTL 10000 + , bench "ee.ExcState" $ whnf countDownExcEE 10000 ], bgroup "HTTP Simple DSL" [ bench "freer" $ whnf (run . runHttp) prog diff --git a/freer-effects.cabal b/freer-effects.cabal index b07e315..ffefdbe 100644 --- a/freer-effects.cabal +++ b/freer-effects.cabal @@ -179,11 +179,12 @@ benchmark core default-language: Haskell2010 build-depends: - base - , criterion - , free - , freer-effects - , mtl + base + , criterion + , free + , freer-effects + , mtl + , extensible-effects >= 1.11 && < 1.12 ghc-options: -Wall -O2