8c042db · effects-benchmarks

git.iko.soy/effects-benchmarks

Formatted and updated

commit8c042db33a95bb839167f809c64c052613dd0022 authoriko <ilyakooo0@gmail.com> dateTue 4 Jan 2022, 18:17 (5 years ago) parentedf18f2

29 files changed+226−213

compare with master

unifiedsplit

effects-benchmarks.cabal+19−1 hie.yaml−7 instances/ExtEff/Bench.hs+9−8 instances/ExtEff/HTTP.hs+7−9 instances/ExtEff/Stateful.hs−4 instances/ExtEff/StatefulExcept.hs+1−4 instances/Freer/Bench.hs+9−8 instances/Freer/HTTP.hs+12−12 instances/Freer/Stateful.hs−4 instances/Freer/StatefulExcept.hs+4−4 instances/Fused/Bench.hs+8−7 instances/Fused/HTTP.hs+20−24 instances/Fused/Stateful.hs−2 instances/Fused/StatefulExcept.hs−4 instances/MTL/Bench.hs+8−7 instances/MTL/HTTP.hs+7−9 instances/MTL/Stateful.hs−1 instances/MTL/StatefulExcept.hs+1−2 instances/Poly/Bench.hs+7−6 instances/Poly/HTTP.hs+8−8 instances/Poly/Stateful.hs−4 instances/Poly/StatefulExcept.hs+1−4 instances/Shallow/Bench.hs+6−5 instances/Shallow/HTTP.hs+2−4 instances/Shallow/Stateful.hs+4−3 instances/Shallow/StatefulExcept.hs+10−8 package.yaml+18 src/Main.hs+56−50 stack.yaml+9−4

effects-benchmarks.cabal+19−1

@@ -1,6 +1,6 @@

11cabal-version: 1.12

3−-- This file has been generated from package.yaml by hpack version 0.34.2.

3+-- This file has been generated from package.yaml by hpack version 0.34.4.

44--

55-- see: https://github.com/sol/hpack

@@ -42,6 +42,24 @@ benchmark effects-benchmarks

4242 hs-source-dirs:

4343 instances

4444 src

45+ default-extensions:

46+ DeriveAnyClass

47+ DeriveFunctor

48+ DeriveGeneric

49+ DerivingStrategies

50+ FlexibleInstances

51+ GADTs

52+ GeneralizedNewtypeDeriving

53+ KindSignatures

54+ MultiParamTypeClasses

55+ TypeOperators

56+ UndecidableInstances

57+ DataKinds

58+ FlexibleContexts

59+ TypeApplications

60+ LambdaCase

61+ ScopedTypeVariables

62+ DerivingStrategies

4563 build-depends:

4664 base

4765 , extensible-effects

hie.yamldeleted−7

@@ -1,7 +0,0 @@

1−cradle:

2− stack:

3− - path: "./instances"

4− component: "effects-benchmarks:bench:effects-benchmarks"

5−

6− - path: "./src/Main.hs"

7− component: "effects-benchmarks:bench:effects-benchmarks"

instances/ExtEff/Bench.hs+9−8

@@ -1,15 +1,16 @@

11module ExtEff.Bench

2− ( countDownBench

3− , countDownExcBench

4− , httpBench

5− ) where

2+ ( countDownBench,

3+ countDownExcBench,

4+ httpBench,

5+ )

6+where

8+import Control.Eff

9+import Control.Eff.Exception

10+import Control.Eff.State.Strict

11+import ExtEff.HTTP

712import ExtEff.Stateful

813import ExtEff.StatefulExcept

9−import ExtEff.HTTP

10−import Control.Eff.State.Strict

11−import Control.Eff.Exception

12−import Control.Eff

1314

1415countDownBench :: Int -> (Int, Int)

1516countDownBench start = run . runState start $ countDownPut

instances/ExtEff/HTTP.hs+7−9

@@ -1,22 +1,20 @@

1−{-# LANGUAGE DataKinds, TypeOperators, GADTs, FlexibleInstances, MultiParamTypeClasses #-}

2−

31module ExtEff.HTTP where

53import Control.Eff

64import Control.Eff.Extend

7−import Data.Function

85import Control.Monad

6+import Data.Function

108type HttpM = Eff '[HTTP, Lift IO]

119

1210data HTTP a where

1311 Open :: String -> HTTP ()

1412 Close :: HTTP ()

15− Post :: String -> HTTP String

16− HGet :: HTTP String

13+ Post :: String -> HTTP String

14+ HGet :: HTTP String

1715

1816open' :: String -> HttpM ()

19−open' = send . Open

17+open' = send . Open

2018

2119close' :: HttpM ()

2220close' = send Close

@@ -30,9 +28,9 @@ get' = send HGet

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

3129 handle h q req = case req of

3230 Open _s -> h (q ^$ ())

33− Close -> h (q ^$ ())

34− Post s -> h (q ^$ ("posted " <> s))

35− HGet -> h (q ^$ "contents")

31+ Close -> h (q ^$ ())

32+ Post s -> h (q ^$ ("posted " <> s))

33+ HGet -> h (q ^$ "contents")

3634

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

3836doHttp = fix (handle_relay pure)

instances/ExtEff/Stateful.hs−4

@@ -1,7 +1,3 @@

1−{-# LANGUAGE MonoLocalBinds #-}

2−{-# LANGUAGE FlexibleContexts #-}

3−{-# LANGUAGE DataKinds, TypeApplications #-}

4−

51module ExtEff.Stateful where

73import Control.Eff

instances/ExtEff/StatefulExcept.hs+1−4

@@ -1,11 +1,8 @@

1−{-# LANGUAGE MonoLocalBinds #-}

2−{-# LANGUAGE FlexibleContexts #-}

3−{-# LANGUAGE TypeApplications, DataKinds #-}

41module ExtEff.StatefulExcept where

63import Control.Eff

7−import Control.Eff.State.Strict

84import Control.Eff.Exception

5+import Control.Eff.State.Strict

107countDownExc :: (Member (State Int) r, Member (Exc String) r) => Eff r b

118countDownExc = get @Int >>= (\n -> if n <= 0 then throwError "what" else put @Int (n - 1) *> countDownExc)

instances/Freer/Bench.hs+9−8

@@ -1,15 +1,16 @@

11module Freer.Bench

2− ( countDownBench

3− , countDownExcBench

4− , httpBench

5− ) where

2+ ( countDownBench,

3+ countDownExcBench,

4+ httpBench,

5+ )

6+where

8+import Control.Monad.Freer

9+import Control.Monad.Freer.Error

10+import Control.Monad.Freer.State

11+import Freer.HTTP

712import Freer.Stateful

813import Freer.StatefulExcept

9−import Freer.HTTP

10−import Control.Monad.Freer.State

11−import Control.Monad.Freer.Error

12−import Control.Monad.Freer

1314

1415countDownBench :: Int -> (Int, Int)

1516countDownBench start = run . runState start $ countDownPut

instances/Freer/HTTP.hs+12−12

@@ -1,20 +1,18 @@

1−{-# LANGUAGE DataKinds, TypeOperators, GADTs #-}

2−

31module Freer.HTTP where

5−import Control.Monad.Freer

63import Control.Monad

4+import Control.Monad.Freer

86type HttpM = Eff '[HTTP, IO]

108data HTTP a where

119 Open :: String -> HTTP ()

1210 Close :: HTTP ()

13− Post :: String -> HTTP String

14− HGet :: HTTP String

11+ Post :: String -> HTTP String

12+ HGet :: HTTP String

1513

1614open' :: String -> HttpM ()

17−open' = send . Open

15+open' = send . Open

1816

1917close' :: HttpM ()

2018close' = send Close

@@ -26,12 +24,14 @@ get' :: HttpM String

2624get' = send HGet

2725

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

29−doHttp = interpret

30− (\x -> case x of

31− Open _ -> pure ()

32− Close -> pure ()

33− Post a -> pure ("posted" <> a)

34− HGet -> pure "gotten")

27+doHttp =

28+ interpret

29+ ( \x -> case x of

30+ Open _ -> pure ()

31+ Close -> pure ()

32+ Post a -> pure ("posted" <> a)

33+ HGet -> pure "gotten"

34+ )

3535

3636runHttp :: HttpM a -> IO a

3737runHttp = runM . doHttp

instances/Freer/Stateful.hs−4

@@ -1,7 +1,3 @@

1−{-# LANGUAGE MonoLocalBinds #-}

2−{-# LANGUAGE FlexibleContexts #-}

3−{-# LANGUAGE TypeApplications, DataKinds #-}

4−

51module Freer.Stateful where

73import Control.Monad.Freer

instances/Freer/StatefulExcept.hs+4−4

@@ -1,10 +1,10 @@

1−{-# LANGUAGE TypeApplications, DataKinds #-}

21module Freer.StatefulExcept where

43import Control.Monad.Freer

5−import Control.Monad.Freer.State

64import Control.Monad.Freer.Error

5+import Control.Monad.Freer.State

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

9−countDownExc = go where

10− go = get @Int >>= (\n -> if n <= 0 then throwError "what" else put @Int (n - 1) *> go)

8+countDownExc = go

9+ where

10+ go = get @Int >>= (\n -> if n <= 0 then throwError "what" else put @Int (n - 1) *> go)

instances/Fused/Bench.hs+8−7

@@ -1,14 +1,15 @@

11module Fused.Bench

2− ( countDownBench

3− , countDownExcBench

4− , httpBench

5− ) where

2+ ( countDownBench,

3+ countDownExcBench,

4+ httpBench,

5+ )

6+where

8+import Control.Carrier.Error.Either

9+import Control.Carrier.State.Strict

10+import Fused.HTTP

711import Fused.Stateful

812import Fused.StatefulExcept

9−import Fused.HTTP

10−import Control.Carrier.State.Strict

11−import Control.Carrier.Error.Either

1213

1314countDownBench :: Int -> (Int, Int)

1415countDownBench start = run . runState start $ countDownPut

instances/Fused/HTTP.hs+20−24

@@ -1,46 +1,42 @@

1−{-# LANGUAGE DeriveAnyClass, DeriveFunctor, DeriveGeneric, DerivingStrategies, FlexibleInstances, GeneralizedNewtypeDeriving,

2− KindSignatures, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}

3−

41module Fused.HTTP where

63import Control.Algebra

7−import Control.Monad.IO.Class

8−import GHC.Generics (Generic1)

94import Control.Carrier.Lift

105import Control.Monad

6+import Control.Monad.IO.Class

7+import Data.Functor

8+import GHC.Generics (Generic1)

119

12−newtype HttpC m a = HttpC { runHttpC :: m a }

10+newtype HttpC m a = HttpC {runHttpC :: m a}

1311 deriving newtype (Applicative, Functor, Monad, MonadIO)

1412

15−data HTTP (m :: * -> *) k

16− = Open String (m k)

17− | Close (m k)

18− | Post String (String -> m k)

19− | HGet (String -> m k)

20− deriving stock (Functor, Generic1)

21− deriving anyclass (HFunctor, Effect)

13+data HTTP (m :: * -> *) k where

14+ Open :: String -> HTTP m ()

15+ Close :: HTTP m ()

16+ Post :: String -> HTTP m String

17+ HGet :: HTTP m String

2218

2319open' :: String -> HttpM ()

24−open' s = send (Open s (pure ()))

20+open' s = send (Open s)

2521

2622close' :: HttpM ()

27−close' = send (Close (pure ()))

23+close' = send Close

2824

2925post' :: String -> HttpM String

30−post' s = send (Post s pure)

26+post' s = send (Post s)

3127

3228get' :: HttpM String

33−get' = send (HGet pure)

29+get' = send HGet

3430

3531type HttpM = HttpC (LiftC IO)

3632

37−instance (Effect sig, Algebra sig m) => Algebra (HTTP :+: sig) (HttpC m) where

38− alg (L act) = case act of

39− Open _ k -> k

40− Close k -> k

41− Post s k -> k ("posted " <> s)

42− HGet k -> k "lmao"

43− alg (R other) = HttpC (alg (handleCoercible other))

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

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

35+ Open _ -> pure ctx

36+ Close -> pure ctx

37+ Post s -> pure $ ctx $> ("posted " <> s)

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

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

4440

4541runHttp :: HttpM a -> IO a

4642runHttp = runM . runHttpC

instances/Fused/Stateful.hs−2

@@ -1,5 +1,3 @@

1−{-# LANGUAGE TypeApplications #-}

2−

31module Fused.Stateful where

53import Control.Effect.State

instances/Fused/StatefulExcept.hs−4

@@ -1,12 +1,8 @@

1−{-# LANGUAGE TypeApplications #-}

2−

31module Fused.StatefulExcept where

5−

63import Control.Effect.Error

74import Control.Effect.State

9−

106countDownExc :: (Has (State Int) sig m, Has (Error String) sig m) => m a

117countDownExc =

128 get @Int >>= (\n -> if n <= 0 then throwError "what" else put @Int (n - 1) *> countDownExc)

instances/MTL/Bench.hs+8−7

@@ -1,14 +1,15 @@

11module MTL.Bench

2− ( countDownBench

3− , countDownExcBench

4− , httpBench

5− ) where

2+ ( countDownBench,

3+ countDownExcBench,

4+ httpBench,

5+ )

6+where

8+import Control.Monad.Except

9+import Control.Monad.State.Strict

10+import MTL.HTTP

711import MTL.Stateful

812import MTL.StatefulExcept

9−import MTL.HTTP

10−import Control.Monad.State.Strict

11−import Control.Monad.Except

1213

1314countDownBench :: Int -> (Int, Int)

1415countDownBench start = flip runState start $ countDownPut

instances/MTL/HTTP.hs+7−9

@@ -1,5 +1,3 @@

1−{-# LANGUAGE GADTs, LambdaCase #-}

2−

31module MTL.HTTP where

53import Control.Applicative

@@ -18,7 +16,7 @@ instance Functor HttpM where

1816 fmap = liftA

1917

2018instance Applicative HttpM where

21− pure = Pure

19+ pure = Pure

2220 (<*>) = ap

2321

2422instance Monad HttpM where

@@ -38,13 +36,13 @@ open' = Open

3836

3937runHttp :: HttpM a -> IO a

4038runHttp = \case

41− Pure x -> pure x

42− Lift m -> m

39+ Pure x -> pure x

40+ Lift m -> m

4341 Then x f -> runHttp x >>= runHttp . f

44− Open _ -> pure ()

45− Shut -> pure ()

46− Post s -> pure ("posted " <> s)

47− HGet -> pure "lmap"

42+ Open _ -> pure ()

43+ Shut -> pure ()

44+ Post s -> pure ("posted " <> s)

45+ HGet -> pure "lmap"

4846

4947doHTTP :: Int -> HttpM Int

5048doHTTP n = do

instances/MTL/Stateful.hs−1

@@ -1,4 +1,3 @@

1−{-# LANGUAGE FlexibleContexts #-}

21module MTL.Stateful where

43import Control.Monad.State.Class

instances/MTL/StatefulExcept.hs+1−2

@@ -1,8 +1,7 @@

1−{-# LANGUAGE FlexibleContexts #-}

21module MTL.StatefulExcept where

4−import Control.Monad.State.Class

53import Control.Monad.Error.Class

4+import Control.Monad.State.Class

76countDownExc :: (MonadState Int m, MonadError String m) => m a

87countDownExc = get >>= (\n -> if n <= 0 then throwError "what" else put (n - 1) *> countDownExc)

instances/Poly/Bench.hs+7−6

@@ -1,15 +1,16 @@

11module Poly.Bench

2− ( countDownBench

3− , countDownExcBench

4− , httpBench

5− ) where

2+ ( countDownBench,

3+ countDownExcBench,

4+ httpBench,

5+ )

6+where

8+import Poly.HTTP

79import Poly.Stateful

810import Poly.StatefulExcept

9−import Poly.HTTP

10−import Polysemy.State

1111import Polysemy

1212import Polysemy.Error

13+import Polysemy.State

1314

1415countDownBench :: Int -> (Int, Int)

1516countDownBench start = run . runState start $ countDownPut

instances/Poly/HTTP.hs+8−8

@@ -1,22 +1,22 @@

1−{-# LANGUAGE ScopedTypeVariables, DataKinds, TemplateHaskell, KindSignatures, GADTs, FlexibleContexts, TypeOperators, LambdaCase #-}

1+{-# LANGUAGE TemplateHaskell #-}

33module Poly.HTTP where

5−import Polysemy

65import Control.Monad

6+import Polysemy

88type HttpM = Sem '[Http, Final IO]

1010data Http (m :: * -> *) a where

11− HOpen :: String -> Http m ()

11+ HOpen :: String -> Http m ()

1212 HClose :: Http m ()

13− HPost :: String -> Http m String

14− HGet :: Http m String

13+ HPost :: String -> Http m String

14+ HGet :: Http m String

1515

1616makeSem ''Http

1717

1818open' :: String -> HttpM ()

19−open' = hOpen

19+open' = hOpen

2020

2121close' :: HttpM ()

2222close' = hClose

@@ -30,9 +30,9 @@ get' = hGet

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

3131runHttp' = interpret $ \case

3232 HOpen _ -> pure ()

33− HClose -> pure ()

33+ HClose -> pure ()

3434 HPost s -> pure ("posted " <> s)

35− HGet -> pure "contents"

35+ HGet -> pure "contents"

3636

3737runHttp :: HttpM a -> IO a

3838runHttp = runFinal . runHttp'

instances/Poly/Stateful.hs−4

@@ -1,7 +1,3 @@

1−{-# LANGUAGE GADTs #-}

2−{-# LANGUAGE FlexibleContexts #-}

3−{-# LANGUAGE DataKinds, TypeApplications #-}

4−

51module Poly.Stateful where

73import Polysemy

instances/Poly/StatefulExcept.hs+1−4

@@ -1,11 +1,8 @@

1−{-# LANGUAGE GADTs #-}

2−{-# LANGUAGE FlexibleContexts #-}

3−{-# LANGUAGE TypeApplications, DataKinds #-}

41module Poly.StatefulExcept where

63import Polysemy

7−import Polysemy.State

84import Polysemy.Error

5+import Polysemy.State

107countDownExc :: (Member (State Int) r, Member (Error String) r) => Sem r a

118countDownExc = get @Int >>= (\n -> if n <= 0 then throw "what" else put @Int (n - 1) *> countDownExc)

instances/Shallow/Bench.hs+6−5

@@ -1,12 +1,13 @@

11module Shallow.Bench

2− ( countDownBench

3− , countDownExcBench

4− , httpBench

5− ) where

2+ ( countDownBench,

3+ countDownExcBench,

4+ httpBench,

5+ )

6+where

8+import Shallow.HTTP

79import Shallow.Stateful

810import Shallow.StatefulExcept

9−import Shallow.HTTP

1011

1112countDownBench :: Int -> (Int, Int)

1213countDownBench = countDownPut

instances/Shallow/HTTP.hs+2−4

@@ -1,11 +1,9 @@

1−{-# LANGUAGE GeneralizedNewtypeDeriving #-}

2−

31module Shallow.HTTP where

53import Control.Monad

7−newtype HttpM a = HttpM { runHttp :: IO a}

8− deriving (Applicative, Functor, Monad)

5+newtype HttpM a = HttpM {runHttp :: IO a}

6+ deriving newtype (Applicative, Functor, Monad)

108get' :: HttpM String

119get' = pure "lmao"

instances/Shallow/Stateful.hs+4−3

@@ -2,7 +2,7 @@ module Shallow.Stateful where

33import Control.Monad

5−newtype StateM a = StateM { unStateM :: Int -> (Int, a) }

5+newtype StateM a = StateM {unStateM :: Int -> (Int, a)}

77instance Functor StateM where

88 fmap f (StateM a) = StateM (\n -> fmap f (a n))

@@ -24,5 +24,6 @@ runStateful :: Int -> StateM a -> (Int, a)

2424runStateful n (StateM f) = f $! n

2525

2626countDownPut :: Int -> (Int, Int)

27−countDownPut start = runStateful start go where

28− go = get >>= (\n -> if n < 0 then pure n else put (n - 1) *> go)

27+countDownPut start = runStateful start go

28+ where

29+ go = get >>= (\n -> if n < 0 then pure n else put (n - 1) *> go)

instances/Shallow/StatefulExcept.hs+10−8

@@ -1,10 +1,8 @@

1−{-# LANGUAGE GeneralizedNewtypeDeriving #-}

2−

31module Shallow.StatefulExcept where

53import Control.Monad

7−newtype StateM a = StateM { unStateM :: Int -> Either String (Int, a) }

5+newtype StateM a = StateM {unStateM :: Int -> Either String (Int, a)}

97instance Functor StateM where

108 fmap f (StateM a) = StateM (\n -> fmap (fmap f) (a n))

@@ -14,9 +12,12 @@ instance Applicative StateM where

1412 (<*>) = ap

1513

1614instance Monad StateM where

17− (StateM a) >>= f = StateM (\n -> case a n of

18− Left s -> Left s

19− Right (n', x) -> unStateM (f x) n')

15+ (StateM a) >>= f =

16+ StateM

17+ ( \n -> case a n of

18+ Left s -> Left s

19+ Right (n', x) -> unStateM (f x) n'

20+ )

2021

2122get :: StateM Int

2223get = StateM (\n -> Right (n, n))

@@ -31,5 +32,6 @@ runStatefulExcept :: Int -> StateM a -> Either String (Int, a)

3132runStatefulExcept n (StateM f) = f $! n

3233

3334countDownExc :: Int -> Either String (Int, Int)

34−countDownExc start = runStatefulExcept start go where

35− go = get >>= (\n -> if n <= 0 then throw "what" else put (n - 1) *> go)

35+countDownExc start = runStatefulExcept start go

36+ where

37+ go = get >>= (\n -> if n <= 0 then throw "what" else put (n - 1) *> go)

package.yaml+18

@@ -15,3 +15,21 @@ benchmarks:

1515 source-dirs:

1616 - instances

1717 - src

18+ default-extensions:

19+ - DeriveAnyClass

20+ - DeriveFunctor

21+ - DeriveGeneric

22+ - DerivingStrategies

23+ - FlexibleInstances

24+ - GADTs

25+ - GeneralizedNewtypeDeriving

26+ - KindSignatures

27+ - MultiParamTypeClasses

28+ - TypeOperators

29+ - UndecidableInstances

30+ - DataKinds

31+ - FlexibleContexts

32+ - TypeApplications

33+ - LambdaCase

34+ - ScopedTypeVariables

35+ - DerivingStrategies

src/Main.hs+56−50

@@ -1,72 +1,78 @@

1−{-# LANGUAGE FlexibleContexts, GADTs, CPP #-}

1+{-# LANGUAGE CPP #-}

2+{-# LANGUAGE FlexibleContexts #-}

3+{-# LANGUAGE GADTs #-}

35module Main where

7+import qualified ExtEff.Bench as ExtEff

8+import qualified Freer.Bench as Freer

9+import qualified Fused.Bench as Fused

510import Gauge (bench, bgroup, nf, nfAppIO)

611import Gauge.Main (defaultMain)

7−import qualified Weigh

8−

9−import qualified Fused.Bench as Fused

10−import qualified Freer.Bench as Freer

11−import qualified Shallow.Bench as Shallow

1212import qualified MTL.Bench as MTL

1313import qualified Poly.Bench as Poly

14−import qualified ExtEff.Bench as ExtEff

14+import qualified Shallow.Bench as Shallow

15+import qualified Weigh

1516

1617wruns :: Int

1718wruns = 1

1819

1920runs :: Int

20−runs = 10000

21+runs = 100000

2122

2223main :: IO ()

2324main = do

2425 putStrLn "*** Time benchmarks ***"

2526 defaultMain

26− [

27− bgroup "Countdown"

28− [ bgroup "Put"

29− [ bench "fused-effects" (nf Fused.countDownBench runs)

30− , bench "mtl" (nf MTL.countDownBench runs)

31− , bench "polysemy" (nf Poly.countDownBench runs)

32− , bench "freer-simple" (nf Freer.countDownBench runs)

33− , bench "extensible-effects" (nf ExtEff.countDownBench runs)

34− , bench "shallow" (nf Shallow.countDownBench runs)

27+ [ bgroup

28+ "Countdown"

29+ [ bgroup

30+ "Put"

31+ [ bench "fused-effects" (nf Fused.countDownBench runs),

32+ bench "mtl" (nf MTL.countDownBench runs),

33+ bench "polysemy" (nf Poly.countDownBench runs),

34+ bench "freer-simple" (nf Freer.countDownBench runs),

35+ bench "extensible-effects" (nf ExtEff.countDownBench runs),

36+ bench "shallow" (nf Shallow.countDownBench runs)

37+ ],

38+ bgroup

39+ "Put+Exc"

40+ [ bench "fused-effects" (nf Fused.countDownExcBench runs),

41+ bench "mtl" (nf MTL.countDownExcBench runs),

42+ bench "polysemy" (nf Poly.countDownExcBench runs),

43+ bench "freer-simple" (nf Freer.countDownExcBench runs),

44+ bench "extensible-effects" (nf ExtEff.countDownExcBench runs),

45+ bench "shallow" (nf Shallow.countDownExcBench runs)

46+ ]

47+ ],

48+ bgroup

49+ "HTTP"

50+ [ bench "fused-effects" (nfAppIO Fused.httpBench runs),

51+ bench "polysemy" (nfAppIO Poly.httpBench runs),

52+ bench "extensible-effects" (nfAppIO ExtEff.httpBench runs),

53+ bench "Deep embedding" (nfAppIO MTL.httpBench runs),

54+ bench "Shallow embedding" (nfAppIO Shallow.httpBench runs),

55+ bench "freer-simple" (nfAppIO Freer.httpBench runs)

3556 ]

36− , bgroup "Put+Exc"

37− [ bench "fused-effects" (nf Fused.countDownExcBench runs)

38− , bench "mtl" (nf MTL.countDownExcBench runs)

39− , bench "polysemy" (nf Poly.countDownExcBench runs)

40− , bench "freer-simple" (nf Freer.countDownExcBench runs)

41− , bench "extensible-effects" (nf ExtEff.countDownExcBench runs)

42− , bench "shallow" (nf Shallow.countDownExcBench runs)

43− ]

44− ]

45− , bgroup "HTTP"

46− [ bench "fused-effects" (nfAppIO Fused.httpBench runs)

47− , bench "polysemy" (nfAppIO Poly.httpBench runs)

48− , bench "extensible-effects" (nfAppIO ExtEff.httpBench runs)

49− , bench "Deep embedding" (nfAppIO MTL.httpBench runs)

50− , bench "Shallow embedding" (nfAppIO Shallow.httpBench runs)

51− , bench "freer-simple" (nfAppIO Freer.httpBench runs)

52− ]

5357 ]

5458

5559 putStrLn "*** Space benchmarks (these will take some time to run) ***"

5660 Weigh.mainWith $ do

57− Weigh.wgroup "Countdown" $ sequence_

58− [ Weigh.func "fused-effects" Fused.countDownBench wruns

59− , Weigh.func "mtl" MTL.countDownBench wruns

60− , Weigh.func "polysemy" Poly.countDownBench wruns

61− , Weigh.func "freer-simple" Freer.countDownBench wruns

62− , Weigh.func "extensible-effects" ExtEff.countDownBench wruns

63− , Weigh.func "shallow" Shallow.countDownBench wruns

64− ]

65− Weigh.wgroup "Countdown + exc" $ sequence_

66− [ Weigh.func "fused-effects" Fused.countDownExcBench wruns

67− , Weigh.func "mtl" MTL.countDownExcBench wruns

68− , Weigh.func "polysemy" Poly.countDownExcBench wruns

69− , Weigh.func "freer-simple" Freer.countDownExcBench wruns

70− , Weigh.func "extensible-effects" ExtEff.countDownExcBench wruns

71− , Weigh.func "shallow" Shallow.countDownExcBench wruns

72− ]

61+ Weigh.wgroup "Countdown" $

62+ sequence_

63+ [ Weigh.func "fused-effects" Fused.countDownBench wruns,

64+ Weigh.func "mtl" MTL.countDownBench wruns,

65+ Weigh.func "polysemy" Poly.countDownBench wruns,

66+ Weigh.func "freer-simple" Freer.countDownBench wruns,

67+ Weigh.func "extensible-effects" ExtEff.countDownBench wruns,

68+ Weigh.func "shallow" Shallow.countDownBench wruns

69+ ]

70+ Weigh.wgroup "Countdown + exc" $

71+ sequence_

72+ [ Weigh.func "fused-effects" Fused.countDownExcBench wruns,

73+ Weigh.func "mtl" MTL.countDownExcBench wruns,

74+ Weigh.func "polysemy" Poly.countDownExcBench wruns,

75+ Weigh.func "freer-simple" Freer.countDownExcBench wruns,

76+ Weigh.func "extensible-effects" ExtEff.countDownExcBench wruns,

77+ Weigh.func "shallow" Shallow.countDownExcBench wruns

78+ ]

stack.yaml+9−4

@@ -17,7 +17,7 @@

1717#

1818# resolver: ./custom-snapshot.yaml

1919# resolver: https://example.com/snapshots/2018-01-01.yaml

20−resolver: lts-16.18

20+resolver: lts-18.21

2121

2222# User packages to be built.

2323# Various formats can be used as shown in the example below.

@@ -29,7 +29,7 @@ resolver: lts-16.18

2929# - auto-update

3030# - wai

3131packages:

32−- .

32+ - .

3333# Dependency packages to be pulled from upstream that are not in the resolver.

3434# These entries can reference officially published versions as well as

3535# forks / in-progress versions pinned to a git hash. For example:

@@ -39,8 +39,8 @@ packages:

3939# - git: https://github.com/commercialhaskell/stack.git

4040# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a

4141#

42−# extra-deps: []

43−

42+extra-deps:

43+ - fused-effects-1.1.1.1

4444# Override default flag values for local packages and extra-deps

4545# flags: {}

4646

@@ -64,3 +64,8 @@ packages:

6464#

6565# Allow a newer minor version of GHC than the snapshot specifies

6666# compiler-check: newer-minor

67+

68+ghc-options:

69+ "$everything": -O2

70+

71+rebuild-ghc-options: true