lexi-lambda/freer-simple
1
1
Fork 0
mirror of https://github.com/lexi-lambda/freer-simple.git synced 2024-12-24 22:54:27 +03:00
Code Issues Projects Releases Wiki Activity

Merge pull request #19 from 'fosskers/master'

Browse Source 
Addresses #5
This commit is contained in:
Peter Trško 2017-03-12 22:19:17 +01:00
commit 816e2eb842
2 changed files with 27 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
bench/Core.hs
View File

@ -39,6 +39,10 @@ import Control.Monad.Freer.Exception (runError, throwError)
import Control.Monad.Freer.State (get, put, runState) import Control.Monad.Freer.State (get, put, runState)
import Control.Monad.Freer.StateRW (ask, tell, runStateR) 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 -- -- State Benchmarks --
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
@ -49,18 +53,25 @@ oneGet = run . runState get
oneGetMTL :: Int -> (Int, Int) oneGetMTL :: Int -> (Int, Int)
oneGetMTL = MTL.runState MTL.get 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) countDown start = run (runState go start)
where go = get >>= (\n -> if n <= 0 then pure n else put (n-1) >> go) 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) countDownRW start = run (runStateR go start)
where go = ask >>= (\n -> if n <= 0 then pure n else tell (n-1) >> go) 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 countDownMTL = MTL.runState go
where go = MTL.get >>= (\n -> if n <= 0 then pure n else MTL.put (n-1) >> 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 -- -- Exception + State --
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
@ -72,6 +83,10 @@ countDownExcMTL :: Int -> Either String (Int,Int)
countDownExcMTL = MTL.runStateT go countDownExcMTL = MTL.runStateT go
where go = MTL.get >>= (\n -> if n <= (0 :: Int) then MTL.throwError "wat" else MTL.put (n-1) >> 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 -- -- Freer: Interpreter --
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
@ -154,15 +169,18 @@ main =
bgroup "State" [ bgroup "State" [
bench "freer.get" $ whnf oneGet 0 bench "freer.get" $ whnf oneGet 0
, bench "mtl.get" $ whnf oneGetMTL 0 , bench "mtl.get" $ whnf oneGetMTL 0
, bench "ee.get" $ whnf oneGetEE 0
], ],
bgroup "Countdown Bench" [ bgroup "Countdown Bench" [
bench "freer.State" $ whnf countDown 10000 bench "freer.State" $ whnf countDown 10000
, bench "freer.StateRW" $ whnf countDownRW 10000 , bench "freer.StateRW" $ whnf countDownRW 10000
, bench "mtl.State" $ whnf countDownMTL 10000 , bench "mtl.State" $ whnf countDownMTL 10000
, bench "ee.State" $ whnf countDownEE 10000
], ],
bgroup "Countdown+Except Bench" [ bgroup "Countdown+Except Bench" [
bench "freer.ExcState" $ whnf countDownExc 10000 bench "freer.ExcState" $ whnf countDownExc 10000
, bench "mtl.ExceptState" $ whnf countDownExcMTL 10000 , bench "mtl.ExceptState" $ whnf countDownExcMTL 10000
, bench "ee.ExcState" $ whnf countDownExcEE 10000
], ],
bgroup "HTTP Simple DSL" [ bgroup "HTTP Simple DSL" [
bench "freer" $ whnf (run . runHttp) prog bench "freer" $ whnf (run . runHttp) prog

11
freer-effects.cabal
View File

@ -179,11 +179,12 @@ benchmark core
default-language: Haskell2010 default-language: Haskell2010
build-depends: build-depends:
base base
, criterion , criterion
, free , free
, freer-effects , freer-effects
, mtl , mtl
, extensible-effects >= 1.11 && < 1.12
ghc-options: -Wall -O2 ghc-options: -Wall -O2