0ced5cc · effects-benchmarks

effects-benchmarks.cabal−1

compare with master

unifiedsplit

@@ -14,7 +14,6 @@ benchmark effects-benchmarks

14 type: exitcode-stdio-1.0

15 main-is: Main.hs

16 other-modules:

17− Effectful.Bench

18 Effectful.Dynamic.Bench

17 Effectful.Dynamic.Bench

19 Effectful.Dynamic.HTTP

18 Effectful.Dynamic.HTTP

20 Effectful.Dynamic.Stateful

19 Effectful.Dynamic.Stateful

instances/ExtEff/HTTP.hs+6−8

@@ -5,24 +5,22 @@ import Control.Eff.Extend

5import Control.Monad

6import Data.Function

7

8−type HttpM = Eff '[HTTP, Lift IO]

9−

10data HTTP a where

8data HTTP a where

11 Open :: String -> HTTP ()

9 Open :: String -> HTTP ()

12 Close :: HTTP ()

10 Close :: HTTP ()

13 Post :: String -> HTTP String

11 Post :: String -> HTTP String

14 HGet :: HTTP String

12 HGet :: HTTP String

15

13

16−open' :: String -> HttpM ()

14+open' :: Member HTTP e => String -> Eff e ()

17open' = send . Open

15open' = send . Open

18

16

19−close' :: HttpM ()

17+close' :: Member HTTP e => Eff e ()

20close' = send Close

18close' = send Close

21

19

22−post' :: String -> HttpM String

20+post' :: Member HTTP e => String -> Eff e String

23post' = send . Post

21post' = send . Post

24

22

25−get' :: HttpM String

23+get' :: Member HTTP e => Eff e String

26get' = send HGet

24get' = send HGet

27

25

28instance Handle HTTP r b (Eff e b) where

26instance Handle HTTP r b (Eff e b) where

@@ -35,10 +33,10 @@ instance Handle HTTP r b (Eff e b) where

35doHttp :: Eff (HTTP ': e) b -> Eff e b

33doHttp :: Eff (HTTP ': e) b -> Eff e b

36doHttp = fix (handle_relay pure)

34doHttp = fix (handle_relay pure)

37

35

38−runHttp :: HttpM a -> IO a

36+runHttp :: Eff '[HTTP, Lift IO] a -> IO a

39runHttp = runLift . doHttp

37runHttp = runLift . doHttp

40

38

41−doHTTP :: Int -> Eff '[HTTP, Lift IO] Int

39+doHTTP :: Member HTTP e => Int -> Eff e Int

42doHTTP n = do

40doHTTP n = do

43 open' "cats"

41 open' "cats"

44 replicateM_ n (get' *> post' "cats")

42 replicateM_ n (get' *> post' "cats")

instances/Freer/HTTP.hs+6−8

@@ -3,24 +3,22 @@ module Freer.HTTP where

3import Control.Monad

4import Control.Monad.Freer

5

6−type HttpM = Eff '[HTTP, IO]

7−

8data HTTP a where

6data HTTP a where

9 Open :: String -> HTTP ()

7 Open :: String -> HTTP ()

10 Close :: HTTP ()

8 Close :: HTTP ()

11 Post :: String -> HTTP String

9 Post :: String -> HTTP String

12 HGet :: HTTP String

10 HGet :: HTTP String

13

11

14−open' :: String -> HttpM ()

12+open' :: Member HTTP e => String -> Eff e ()

15open' = send . Open

13open' = send . Open

16

14

17−close' :: HttpM ()

15+close' :: Member HTTP e => Eff e ()

18close' = send Close

16close' = send Close

19

17

20−post' :: String -> HttpM String

18+post' :: Member HTTP e => String -> Eff e String

21post' = send . Post

19post' = send . Post

22

20

23−get' :: HttpM String

21+get' :: Member HTTP e => Eff e String

24get' = send HGet

22get' = send HGet

25

23

26doHttp :: Eff (HTTP ': e) b -> Eff e b

24doHttp :: Eff (HTTP ': e) b -> Eff e b

@@ -33,10 +31,10 @@ doHttp =

33 HGet -> pure "gotten"

31 HGet -> pure "gotten"

34 )

32 )

35

33

36−runHttp :: HttpM a -> IO a

34+runHttp :: Eff '[HTTP, IO] a -> IO a

37runHttp = runM . doHttp

35runHttp = runM . doHttp

38

36

39−doHTTP :: Int -> Eff '[HTTP, IO] Int

37+doHTTP :: Member HTTP e => Int -> Eff e Int

40doHTTP n = do

38doHTTP n = do

41 open' "cats"

39 open' "cats"

42 replicateM_ n (get' *> post' "cats")

40 replicateM_ n (get' *> post' "cats")

instances/Freer/StatefulExcept.hs+1−1

@@ -4,7 +4,7 @@ import Control.Monad.Freer

4import Control.Monad.Freer.Error

5import Control.Monad.Freer.State

6

7−countDownExc :: Eff '[State Int, Error String] b

7+countDownExc :: (Member (State Int) e, Member (Error String) e) => Eff e b

8countDownExc = go

9 where

10 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

16 Post :: String -> HTTP m String

17 HGet :: HTTP m String

18

19−open' :: String -> HttpM ()

19+open' :: Has HTTP sig m => String -> m ()

20open' s = send (Open s)

21

22−close' :: HttpM ()

22+close' :: Has HTTP sig m => m ()

23close' = send Close

24

25−post' :: String -> HttpM String

25+post' :: Has HTTP sig m => String -> m String

26post' s = send (Post s)

27

28−get' :: HttpM String

28+get' :: Has HTTP sig m => m String

29get' = send HGet

30

31−type HttpM = HttpC (LiftC IO)

32−

33instance (Algebra sig m) => Algebra (HTTP :+: sig) (HttpC m) where

31instance (Algebra sig m) => Algebra (HTTP :+: sig) (HttpC m) where

34 alg hdl (L act) ctx = case act of

32 alg hdl (L act) ctx = case act of

35 Open _ -> pure ctx

33 Open _ -> pure ctx

@@ -38,10 +36,10 @@ instance (Algebra sig m) => Algebra (HTTP :+: sig) (HttpC m) where

38 HGet -> pure $ ctx $> "lmao"

36 HGet -> pure $ ctx $> "lmao"

39 alg hdl (R other) ctx = HttpC (alg (runHttpC . hdl) other ctx)

37 alg hdl (R other) ctx = HttpC (alg (runHttpC . hdl) other ctx)

40

38

41−runHttp :: HttpM a -> IO a

39+runHttp :: HttpC (LiftC IO) a -> IO a

42runHttp = runM . runHttpC

40runHttp = runM . runHttpC

43

41

44−doHTTP :: Int -> HttpC (LiftC IO) Int

42+doHTTP :: Has HTTP sig m => Int -> m Int

45doHTTP n = do

43doHTTP n = do

46 open' "cats"

44 open' "cats"

47 replicateM_ n (get' *> post' "cats")

45 replicateM_ n (get' *> post' "cats")

instances/Poly/HTTP.hs+5−5

@@ -15,16 +15,16 @@ data Http (m :: * -> *) a where

15

16makeSem ''Http

17

18−open' :: String -> HttpM ()

18+open' :: Member Http r => String -> Sem r ()

19open' = hOpen

20

21−close' :: HttpM ()

21+close' :: Member Http r => Sem r ()

22close' = hClose

23

24−post' :: String -> HttpM String

24+post' :: Member Http r => String -> Sem r String

25post' = hPost

26

27−get' :: HttpM String

27+get' :: Member Http r => Sem r String

28get' = hGet

29

30runHttp' :: Sem (Http ': r) a -> Sem r a

@@ -37,7 +37,7 @@ runHttp' = interpret $ \case

37runHttp :: HttpM a -> IO a

38runHttp = runFinal . runHttp'

39

40−doHTTP :: Int -> Sem '[Http, Final IO] Int

40+doHTTP :: Member Http r => Int -> Sem r Int

41doHTTP n = do

42 open' "cats"

43 replicateM_ n (get' *> post' "cats")