git.iko.soy/effects-benchmarks
on master help sign in
Make everything equally polymorphic (fair)
commit0ced5cc470833412cae08ae0288a9e7f151aa666 authoriko <ilyakooo0@gmail.com> dateTue 4 Jan 2022, 22:58 (5 years ago) parent39d9ac1
6 files changed+24−31
compare with master
unifiedsplit
effects-benchmarks.cabal−1 instances/ExtEff/HTTP.hs+6−8 instances/Freer/HTTP.hs+6−8 instances/Freer/StatefulExcept.hs+1−1 instances/Fused/HTTP.hs+6−8 instances/Poly/HTTP.hs+5−5
effects-benchmarks.cabal−1
@@ -14,7 +14,6 @@ benchmark effects-benchmarks
1414 type: exitcode-stdio-1.0
1515 main-is: Main.hs
1616 other-modules:
17− Effectful.Bench
1817 Effectful.Dynamic.Bench
1918 Effectful.Dynamic.HTTP
2019 Effectful.Dynamic.Stateful
instances/ExtEff/HTTP.hs+6−8
@@ -5,24 +5,22 @@ import Control.Eff.Extend
55import Control.Monad
66import Data.Function
77
8−type HttpM = Eff '[HTTP, Lift IO]
9−
108data HTTP a where
119 Open :: String -> HTTP ()
1210 Close :: HTTP ()
1311 Post :: String -> HTTP String
1412 HGet :: HTTP String
1513
16−open' :: String -> HttpM ()
14+open' :: Member HTTP e => String -> Eff e ()
1715open' = send . Open
1816
19−close' :: HttpM ()
17+close' :: Member HTTP e => Eff e ()
2018close' = send Close
2119
22−post' :: String -> HttpM String
20+post' :: Member HTTP e => String -> Eff e String
2321post' = send . Post
2422
25−get' :: HttpM String
23+get' :: Member HTTP e => Eff e String
2624get' = send HGet
2725
2826instance Handle HTTP r b (Eff e b) where
@@ -35,10 +33,10 @@ instance Handle HTTP r b (Eff e b) where
3533doHttp :: Eff (HTTP ': e) b -> Eff e b
3634doHttp = fix (handle_relay pure)
3735
38−runHttp :: HttpM a -> IO a
36+runHttp :: Eff '[HTTP, Lift IO] a -> IO a
3937runHttp = runLift . doHttp
4038
41−doHTTP :: Int -> Eff '[HTTP, Lift IO] Int
39+doHTTP :: Member HTTP e => Int -> Eff e Int
4240doHTTP n = do
4341 open' "cats"
4442 replicateM_ n (get' *> post' "cats")
instances/Freer/HTTP.hs+6−8
@@ -3,24 +3,22 @@ module Freer.HTTP where
33import Control.Monad
44import Control.Monad.Freer
55
6−type HttpM = Eff '[HTTP, IO]
7−
86data HTTP a where
97 Open :: String -> HTTP ()
108 Close :: HTTP ()
119 Post :: String -> HTTP String
1210 HGet :: HTTP String
1311
14−open' :: String -> HttpM ()
12+open' :: Member HTTP e => String -> Eff e ()
1513open' = send . Open
1614
17−close' :: HttpM ()
15+close' :: Member HTTP e => Eff e ()
1816close' = send Close
1917
20−post' :: String -> HttpM String
18+post' :: Member HTTP e => String -> Eff e String
2119post' = send . Post
2220
23−get' :: HttpM String
21+get' :: Member HTTP e => Eff e String
2422get' = send HGet
2523
2624doHttp :: Eff (HTTP ': e) b -> Eff e b
@@ -33,10 +31,10 @@ doHttp =
3331 HGet -> pure "gotten"
3432 )
3533
36−runHttp :: HttpM a -> IO a
34+runHttp :: Eff '[HTTP, IO] a -> IO a
3735runHttp = runM . doHttp
3836
39−doHTTP :: Int -> Eff '[HTTP, IO] Int
37+doHTTP :: Member HTTP e => Int -> Eff e Int
4038doHTTP n = do
4139 open' "cats"
4240 replicateM_ n (get' *> post' "cats")
instances/Freer/StatefulExcept.hs+1−1
@@ -4,7 +4,7 @@ import Control.Monad.Freer
44import Control.Monad.Freer.Error
55import Control.Monad.Freer.State
66
7−countDownExc :: Eff '[State Int, Error String] b
7+countDownExc :: (Member (State Int) e, Member (Error String) e) => Eff e b
88countDownExc = go
99 where
1010 go = get @Int >>= (\n -> if n <= 0 then throwError "what" else put @Int (n - 1) *> go)
instances/Fused/HTTP.hs+6−8
@@ -16,20 +16,18 @@ data HTTP (m :: * -> *) k where
1616 Post :: String -> HTTP m String
1717 HGet :: HTTP m String
1818
19−open' :: String -> HttpM ()
19+open' :: Has HTTP sig m => String -> m ()
2020open' s = send (Open s)
2121
22−close' :: HttpM ()
22+close' :: Has HTTP sig m => m ()
2323close' = send Close
2424
25−post' :: String -> HttpM String
25+post' :: Has HTTP sig m => String -> m String
2626post' s = send (Post s)
2727
28−get' :: HttpM String
28+get' :: Has HTTP sig m => m String
2929get' = send HGet
3030
31−type HttpM = HttpC (LiftC IO)
32−
3331instance (Algebra sig m) => Algebra (HTTP :+: sig) (HttpC m) where
3432 alg hdl (L act) ctx = case act of
3533 Open _ -> pure ctx
@@ -38,10 +36,10 @@ instance (Algebra sig m) => Algebra (HTTP :+: sig) (HttpC m) where
3836 HGet -> pure $ ctx $> "lmao"
3937 alg hdl (R other) ctx = HttpC (alg (runHttpC . hdl) other ctx)
4038
41−runHttp :: HttpM a -> IO a
39+runHttp :: HttpC (LiftC IO) a -> IO a
4240runHttp = runM . runHttpC
4341
44−doHTTP :: Int -> HttpC (LiftC IO) Int
42+doHTTP :: Has HTTP sig m => Int -> m Int
4543doHTTP n = do
4644 open' "cats"
4745 replicateM_ n (get' *> post' "cats")
instances/Poly/HTTP.hs+5−5
@@ -15,16 +15,16 @@ data Http (m :: * -> *) a where
1515
1616makeSem ''Http
1717
18−open' :: String -> HttpM ()
18+open' :: Member Http r => String -> Sem r ()
1919open' = hOpen
2020
21−close' :: HttpM ()
21+close' :: Member Http r => Sem r ()
2222close' = hClose
2323
24−post' :: String -> HttpM String
24+post' :: Member Http r => String -> Sem r String
2525post' = hPost
2626
27−get' :: HttpM String
27+get' :: Member Http r => Sem r String
2828get' = hGet
2929
3030runHttp' :: Sem (Http ': r) a -> Sem r a
@@ -37,7 +37,7 @@ runHttp' = interpret $ \case
3737runHttp :: HttpM a -> IO a
3838runHttp = runFinal . runHttp'
3939
40−doHTTP :: Int -> Sem '[Http, Final IO] Int
40+doHTTP :: Member Http r => Int -> Sem r Int
4141doHTTP n = do
4242 open' "cats"
4343 replicateM_ n (get' *> post' "cats")