git.iko.soy/effects-benchmarks
on master help sign in
Added effectful
39d9ac1iko
effects-benchmarks.cabal+11
@@ -14,6 +14,15 @@ benchmark effects-benchmarks
14 type: exitcode-stdio-1.0
14 type: exitcode-stdio-1.0
15 main-is: Main.hs
15 main-is: Main.hs
16 other-modules:
16 other-modules:
17+ Effectful.Bench
18+ Effectful.Dynamic.Bench
19+ Effectful.Dynamic.HTTP
20+ Effectful.Dynamic.Stateful
21+ Effectful.Dynamic.StatefulExcept
22+ Effectful.Static.Bench
23+ Effectful.Static.HTTP
24+ Effectful.Static.Stateful
25+ Effectful.Static.StatefulExcept
17 ExtEff.Bench
26 ExtEff.Bench
18 ExtEff.HTTP
27 ExtEff.HTTP
19 ExtEff.Stateful
28 ExtEff.Stateful
@@ -62,6 +71,8 @@ benchmark effects-benchmarks
62 DerivingStrategies
71 DerivingStrategies
63 build-depends:
72 build-depends:
64 base
73 base
74+ , effectful
75+ , effectful-core
65 , extensible-effects
76 , extensible-effects
66 , freer-simple
77 , freer-simple
67 , fused-effects
78 , fused-effects
instances/Effectful/Dynamic/Bench.hsnew file+18
@@ -0,0 +1,18 @@
1+module Effectful.Dynamic.Bench where
2+
3+import Effectful
4+import Effectful.Dynamic.HTTP
5+import Effectful.Dynamic.Stateful
6+import Effectful.Dynamic.StatefulExcept
7+import Effectful.Error.Dynamic
8+import Effectful.State.Dynamic
9+import GHC.Stack (CallStack)
10+
11+countDownBench :: Int -> (Int, Int)
12+countDownBench start = runPureEff . runLocalState start $ countDownPut
13+
14+countDownExcBench :: Int -> Either (CallStack, String) (Int, Int)
15+countDownExcBench start = runPureEff . runError . runLocalState start $ countDownExc
16+
17+httpBench :: Int -> IO Int
18+httpBench n = runEff $ runHTTP (doHTTP n)
instances/Effectful/Dynamic/HTTP.hsnew file+39
@@ -0,0 +1,39 @@
1+module Effectful.Dynamic.HTTP where
2+
3+import Control.Monad
4+import Data.Kind
5+import Effectful
6+import Effectful.Dispatch.Static
7+import Effectful.Internal.Monad
8+
9+data HTTP :: Effect where
10+ Open :: String -> HTTP m ()
11+ Close :: HTTP m ()
12+ Post :: String -> HTTP m String
13+ Get :: HTTP m String
14+
15+runHTTP :: Eff (HTTP : es) a -> Eff es a
16+runHTTP = interpret $ \_ -> \case
17+ Open _ -> pure ()
18+ Close -> pure ()
19+ Post a -> pure ("posted" <> a)
20+ Get -> pure "gotten"
21+
22+open :: HTTP :> es => String -> Eff es ()
23+open = send . Open
24+
25+close :: HTTP :> es => Eff es ()
26+close = send Close
27+
28+post :: HTTP :> es => String -> Eff es String
29+post = send . Post
30+
31+get :: HTTP :> es => Eff es String
32+get = send Get
33+
34+doHTTP :: HTTP :> es => Int -> Eff es Int
35+doHTTP n = do
36+ open "cats"
37+ replicateM_ n (get *> post "cats")
38+ close
39+ pure n
instances/Effectful/Dynamic/Stateful.hsnew file+7
@@ -0,0 +1,7 @@
1+module Effectful.Dynamic.Stateful where
2+
3+import Effectful
4+import Effectful.State.Dynamic
5+
6+countDownPut :: State Int :> es => Eff es Int
7+countDownPut = get >>= (\n -> if n < 0 then pure n else put (n - 1) *> countDownPut)
instances/Effectful/Dynamic/StatefulExcept.hsnew file+10
@@ -0,0 +1,10 @@
1+module Effectful.Dynamic.StatefulExcept where
2+
3+import Effectful
4+import Effectful.Error.Dynamic
5+import Effectful.State.Dynamic
6+
7+countDownExc :: (State Int :> es, Error String :> es) => Eff es b
8+countDownExc = go
9+ where
10+ go = get @Int >>= (\n -> if n <= 0 then throwError "what" else put @Int (n - 1) *> go)
instances/Effectful/Static/Bench.hsnew file+17
@@ -0,0 +1,17 @@
1+module Effectful.Static.Bench where
2+
3+import Effectful
4+import Effectful.Error
5+import Effectful.State.Local
6+import Effectful.Static.HTTP
7+import Effectful.Static.Stateful
8+import Effectful.Static.StatefulExcept
9+
10+countDownBench :: Int -> (Int, Int)
11+countDownBench start = runPureEff . runState start $ countDownPut
12+
13+countDownExcBench :: Int -> Either (CallStack, String) (Int, Int)
14+countDownExcBench start = runPureEff . runError . runState start $ countDownExc
15+
16+httpBench :: Int -> IO Int
17+httpBench n = runEff $ runHTTP (doHTTP n)
instances/Effectful/Static/HTTP.hsnew file+30
@@ -0,0 +1,30 @@
1+module Effectful.Static.HTTP where
2+
3+import Control.Monad
4+import Data.Kind
5+import Effectful
6+import Effectful.Dispatch.Static
7+
8+data HTTP (m :: Type -> Type) r = HTTP
9+
10+runHTTP :: Eff (HTTP : es) a -> Eff es a
11+runHTTP = evalData (DataA HTTP)
12+
13+open :: HTTP :> es => String -> Eff es ()
14+open _ = pure ()
15+
16+close :: HTTP :> es => Eff es ()
17+close = pure ()
18+
19+post :: HTTP :> es => String -> Eff es String
20+post a = pure ("posted" <> a)
21+
22+get :: HTTP :> es => Eff es String
23+get = pure "gotten"
24+
25+doHTTP :: HTTP :> es => Int -> Eff es Int
26+doHTTP n = do
27+ open "cats"
28+ replicateM_ n (get *> post "cats")
29+ close
30+ pure n
instances/Effectful/Static/Stateful.hsnew file+7
@@ -0,0 +1,7 @@
1+module Effectful.Static.Stateful where
2+
3+import Effectful
4+import Effectful.State.Local
5+
6+countDownPut :: State Int :> es => Eff es Int
7+countDownPut = get >>= (\n -> if n < 0 then pure n else put (n - 1) *> countDownPut)
instances/Effectful/Static/StatefulExcept.hsnew file+10
@@ -0,0 +1,10 @@
1+module Effectful.Static.StatefulExcept where
2+
3+import Effectful
4+import Effectful.Error
5+import Effectful.State.Local
6+
7+countDownExc :: (State Int :> es, Error String :> es) => Eff es b
8+countDownExc = go
9+ where
10+ go = get @Int >>= (\n -> if n <= 0 then throwError "what" else put @Int (n - 1) *> go)
package.yaml+2
@@ -12,6 +12,8 @@ benchmarks:
12 - extensible-effects
12 - extensible-effects
13 - gauge
13 - gauge
14 - weigh
14 - weigh
15+ - effectful
16+ - effectful-core
15 source-dirs:
17 source-dirs:
16 - instances
18 - instances
17 - src
19 - src
src/Main.hs+17−5
@@ -4,6 +4,8 @@
4
4
5module Main where
5module Main where
6
6
7+import qualified Effectful.Dynamic.Bench as EffectfulDynamic
8+import qualified Effectful.Static.Bench as EffectfulStatic
7import qualified ExtEff.Bench as ExtEff
9import qualified ExtEff.Bench as ExtEff
8import qualified Freer.Bench as Freer
10import qualified Freer.Bench as Freer
9import qualified Fused.Bench as Fused
11import qualified Fused.Bench as Fused
@@ -33,7 +35,9 @@ main = do
33 bench "polysemy" (nf Poly.countDownBench runs),
35 bench "polysemy" (nf Poly.countDownBench runs),
34 bench "freer-simple" (nf Freer.countDownBench runs),
36 bench "freer-simple" (nf Freer.countDownBench runs),
35 bench "extensible-effects" (nf ExtEff.countDownBench runs),
37 bench "extensible-effects" (nf ExtEff.countDownBench runs),
36− bench "shallow" (nf Shallow.countDownBench runs)
38+ bench "shallow" (nf Shallow.countDownBench runs),
39+ bench "effectful - static" (nf EffectfulStatic.countDownBench runs),
40+ bench "effectful - dynamic" (nf EffectfulDynamic.countDownBench runs)
37 ],
41 ],
38 bgroup
42 bgroup
39 "Put+Exc"
43 "Put+Exc"
@@ -42,7 +46,9 @@ main = do
42 bench "polysemy" (nf Poly.countDownExcBench runs),
46 bench "polysemy" (nf Poly.countDownExcBench runs),
43 bench "freer-simple" (nf Freer.countDownExcBench runs),
47 bench "freer-simple" (nf Freer.countDownExcBench runs),
44 bench "extensible-effects" (nf ExtEff.countDownExcBench runs),
48 bench "extensible-effects" (nf ExtEff.countDownExcBench runs),
45− bench "shallow" (nf Shallow.countDownExcBench runs)
49+ bench "shallow" (nf Shallow.countDownExcBench runs),
50+ bench "effectful - static" (nf EffectfulStatic.countDownExcBench runs),
51+ bench "effectful - dynamic" (nf EffectfulDynamic.countDownExcBench runs)
46 ]
52 ]
47 ],
53 ],
48 bgroup
54 bgroup
@@ -52,7 +58,9 @@ main = do
52 bench "extensible-effects" (nfAppIO ExtEff.httpBench runs),
58 bench "extensible-effects" (nfAppIO ExtEff.httpBench runs),
53 bench "Deep embedding" (nfAppIO MTL.httpBench runs),
59 bench "Deep embedding" (nfAppIO MTL.httpBench runs),
54 bench "Shallow embedding" (nfAppIO Shallow.httpBench runs),
60 bench "Shallow embedding" (nfAppIO Shallow.httpBench runs),
55− bench "freer-simple" (nfAppIO Freer.httpBench runs)
61+ bench "freer-simple" (nfAppIO Freer.httpBench runs),
62+ bench "effectful - static" (nfAppIO EffectfulStatic.httpBench runs),
63+ bench "effectful - dynamic" (nfAppIO EffectfulDynamic.httpBench runs)
56 ]
64 ]
57 ]
65 ]
58
66
@@ -65,7 +73,9 @@ main = do
65 Weigh.func "polysemy" Poly.countDownBench wruns,
73 Weigh.func "polysemy" Poly.countDownBench wruns,
66 Weigh.func "freer-simple" Freer.countDownBench wruns,
74 Weigh.func "freer-simple" Freer.countDownBench wruns,
67 Weigh.func "extensible-effects" ExtEff.countDownBench wruns,
75 Weigh.func "extensible-effects" ExtEff.countDownBench wruns,
68− Weigh.func "shallow" Shallow.countDownBench wruns
76+ Weigh.func "shallow" Shallow.countDownBench wruns,
77+ Weigh.func "effectful - static" EffectfulStatic.countDownBench runs,
78+ Weigh.func "effectful - dynamic" EffectfulDynamic.countDownBench runs
69 ]
79 ]
70 Weigh.wgroup "Countdown + exc" $
80 Weigh.wgroup "Countdown + exc" $
71 sequence_
81 sequence_
@@ -74,5 +84,7 @@ main = do
74 Weigh.func "polysemy" Poly.countDownExcBench wruns,
84 Weigh.func "polysemy" Poly.countDownExcBench wruns,
75 Weigh.func "freer-simple" Freer.countDownExcBench wruns,
85 Weigh.func "freer-simple" Freer.countDownExcBench wruns,
76 Weigh.func "extensible-effects" ExtEff.countDownExcBench wruns,
86 Weigh.func "extensible-effects" ExtEff.countDownExcBench wruns,
77− Weigh.func "shallow" Shallow.countDownExcBench wruns
87+ Weigh.func "shallow" Shallow.countDownExcBench wruns,
88+ Weigh.func "effectful - static" EffectfulStatic.countDownExcBench runs,
89+ Weigh.func "effectful - dynamic" EffectfulDynamic.countDownExcBench runs
78 ]
90 ]
stack.yaml+7
@@ -41,6 +41,13 @@ packages:
41#
41#
42extra-deps:
42extra-deps:
43 - fused-effects-1.1.1.1
43 - fused-effects-1.1.1.1
44+ - git: https://github.com/arybczak/effectful.git
45+ commit: 0d0283948ddd3204f69cdc60871978efe21452ae
46+ subdir: effectful
47+ - git: https://github.com/arybczak/effectful.git
48+ commit: 0d0283948ddd3204f69cdc60871978efe21452ae
49+ subdir: effectful-core
50+
44# Override default flag values for local packages and extra-deps
51# Override default flag values for local packages and extra-deps
45# flags: {}
52# flags: {}
46
53