git.iko.soy/effects-benchmarks
on master help sign in
Remove dead benchmarks.
commit286b1876ced64d338e51567a562557ea0c4ef48f authorPatrick Thomson <patrickt@github.com> dateMon 6 May 2019, 14:34 (7 years ago) parent075071e
4 files changed−248
compare with master
unifiedsplit
src/FreerSimple.hs−73 src/HigherOrder.hs−76 src/JVEffects.hs−72 src/MTL.hs−27
src/FreerSimple.hsdeleted−73
@@ -1,73 +0,0 @@
1−{-# LANGUAGE TypeOperators, GADTs, FlexibleContexts, DataKinds #-}
2−
3−module FreerSimple (marks) where
4−
5−import Control.Monad
6−import Control.Monad.Freer
7−import Control.Monad.Freer.State
8−import Control.Monad.Freer.Error
9−import Gauge
10−
11−data HTTP a where
12− Open :: String -> HTTP ()
13− Close :: HTTP ()
14− Post :: String -> HTTP String
15− HGet :: HTTP String
16−
17−open' :: Member HTTP r => String -> Eff r ()
18−open' = send . Open
19−
20−close' :: Member HTTP r => Eff r ()
21−close' = send Close
22−
23−post' :: Member HTTP r => String -> Eff r String
24−post' = send . Post
25−
26−get' :: Member HTTP r => Eff r String
27−get' = send HGet
28−
29−runHTTP :: Eff (HTTP ': e) b -> Eff e b
30−runHTTP = interpret
31− (\x -> case x of
32− Open _ -> pure ()
33− Close -> pure ()
34− Post a -> pure a
35− HGet -> pure "gotten")
36−
37−prog :: Member HTTP r => Eff r ()
38−prog = open' "cats" >> get' >> post' "cats" >> close'
39−
40−p :: Member HTTP r => Int -> Eff r ()
41−p count = open' "cats" >> replicateM_ count (get' >> post' "cats") >> close'
42−
43−oneGet :: Int -> (Int, Int)
44−oneGet n = run (runState n get)
45−
46−countDown :: Int -> (Int,Int)
47−countDown start = run (runState start go)
48− where go = get >>= (\n -> if n <= 0 then pure n else put (n-1) >> go)
49−
50−countDownExc :: Int -> Either String (Int,Int)
51−countDownExc start = run $ runError (runState start go)
52− where go = get >>= (\n -> if n <= (0 :: Int) then throwError "wat" else put (n-1) >> go)
53−
54−-- prog :: (Monad m, Member HTTP sig, Carrier sig m) => m ()
55−-- prog = open' "cats" >> get' >> post' "cats" >> close'
56−
57−-- p :: (Monad m, Member HTTP sig, Carrier sig m) => Int -> m ()
58−-- p count = open' "cats" >> replicateM_ count (get' >> post' "cats") >> close'
59−
60−marks :: Benchmark
61−marks = bgroup "freer-simple"
62− [ bgroup "State"
63− [ bench "get" $ whnf oneGet 0
64− , bench "countdown" $ whnf countDown 100
65− ]
66− , bgroup "State + Error"
67− [ bench "countdownExc" $ whnf countDownExc 10000
68− ]
69− , bgroup "HTTP DSL"
70− [ bench "simple" $ whnf (run . runHTTP) prog
71− , bench "replicated" $ whnf (run . runHTTP . p) 100000
72− ]
73− ]
src/HigherOrder.hsdeleted−76
@@ -1,76 +0,0 @@
1−{-# LANGUAGE DeriveFunctor, FlexibleContexts, FlexibleInstances, KindSignatures, MultiParamTypeClasses,
2− TypeApplications, TypeOperators, UndecidableInstances #-}
3−
4−module HigherOrder (marks) where
5−
6−import Control.Effect
7−import Control.Monad
8−import Data.Coerce
9−import Gauge.Main
10−
11−data HTTP (m :: * -> *) k
12− = Open String k
13− | Close k
14− | Post String (String -> k)
15− | HGet (String -> k)
16− deriving Functor
17−
18−instance HFunctor HTTP where
19− hmap _ = coerce
20−
21−open' :: (Member HTTP sig, Carrier sig m) => String -> m ()
22−open' s = send (Open s (gen ()))
23−
24−close' :: (Member HTTP sig, Carrier sig m) => m ()
25−close' = send (Close (gen ()))
26−
27−post' :: (Member HTTP sig, Carrier sig m) => String -> m String
28−post' s = send (Post s gen)
29−
30−get' :: (Member HTTP sig, Carrier sig m) => m String
31−get' = send (HGet gen)
32−
33−newtype HTTPC m a = HTTPC { runHTTPC :: m a }
34−
35−instance (Carrier sig m) => Carrier (HTTP :+: sig) (HTTPC m) where
36− gen = HTTPC . gen
37− alg = algS \/ (HTTPC . alg . handlePure runHTTPC) where
38− algS (Open _ k) = k
39− algS (Close k) = k
40− algS (Post s k) = k s
41− algS (HGet k) = k ""
42−
43−runHTTP :: (Carrier sig m) => Eff (HTTPC m) a -> m a
44−runHTTP = runHTTPC . interpret
45−
46−oneGet :: Int -> (Int, Int)
47−oneGet n = run (runState n get)
48−
49−countDown :: Int -> (Int,Int)
50−countDown start = run (runState start go)
51− where go = get >>= (\n -> if n <= 0 then pure n else put (n-1) >> go)
52−
53−countDownExc :: Int -> Either String (Int,Int)
54−countDownExc start = run $ runError (runState start go)
55− where go = get >>= (\n -> if n <= (0 :: Int) then throwError "wat" else put (n-1) >> go)
56−
57−prog :: (Monad m, Member HTTP sig, Carrier sig m) => m ()
58−prog = open' "cats" >> get' >> post' "cats" >> close'
59−
60−p :: (Monad m, Member HTTP sig, Carrier sig m) => Int -> m ()
61−p count = open' "cats" >> replicateM_ count (get' >> post' "cats") >> close'
62−
63−marks :: Benchmark
64−marks = bgroup "higher-order-effects"
65− [ bgroup "State"
66− [ bench "get" $ whnf oneGet 0
67− , bench "countdown" $ whnf countDown 100
68− ]
69− , bgroup "State + Error"
70− [ bench "countdownExc" $ whnf countDownExc 10000
71− ]
72− , bgroup "HTTP DSL"
73− [ bench "simple" $ whnf (run . runHTTP) prog
74− , bench "replicated" $ whnf (run . runHTTP . p) 100000
75− ]
76− ]
src/JVEffects.hsdeleted−72
@@ -1,72 +0,0 @@
1−{-# LANGUAGE TypeApplications, KindSignatures, TypeOperators, GADTs, FlexibleContexts, DataKinds #-}
2−
3−module JVEffects (marks) where
4−
5−import Control.Monad
6−import Control.Monad.Effect
7−import Control.Monad.Effect.Exception
8−import Control.Monad.Effect.State
9−import Gauge
10−
11−oneGet :: Int -> (Int, Int)
12−oneGet n = run @Eff (runState n get)
13−
14−countDown :: Int -> (Int,Int)
15−countDown start = run @Eff (runState start go)
16− where go = get >>= (\n -> if n <= 0 then pure n else put (n-1) >> go)
17−
18−countDownExc :: Int -> Either String (Int,Int)
19−countDownExc start = run @Eff $ runError (runState start go)
20− where go = get >>= (\n -> if n <= (0 :: Int) then throwError "wat" else put (n-1) >> go)
21−
22−data HTTP (m :: * -> *) out where
23− Open :: String -> HTTP m ()
24− Close :: HTTP m ()
25− Post :: String -> HTTP m String
26− HGet :: HTTP m String
27−
28−instance Effect HTTP where
29− handleState _ _ _ = error "Rob said we didn't need this"
30−
31−instance PureEffect HTTP
32−
33−open' :: Member HTTP r => String -> Eff r ()
34−open' = send . Open
35−
36−close' :: Member HTTP r => Eff r ()
37−close' = send Close
38−
39−post' :: Member HTTP r => String -> Eff r String
40−post' = send . Post
41−
42−get' :: Member HTTP r => Eff r String
43−get' = send HGet
44−
45−runHTTP :: PureEffects e => Eff (HTTP ': e) b -> Eff e b
46−runHTTP = interpret
47− (\x -> case x of
48− Open _ -> pure ()
49− Close -> pure ()
50− Post a -> pure a
51− HGet -> pure "gotten")
52−
53−prog :: Member HTTP r => Eff r ()
54−prog = open' "cats" >> get' >> post' "cats" >> close'
55−
56−p :: Member HTTP r => Int -> Eff r ()
57−p count = open' "cats" >> replicateM_ count (get' >> post' "cats") >> close'
58−
59−marks :: Benchmark
60−marks = bgroup "joshvera/effects"
61− [ bgroup "State"
62− [ bench "get" $ whnf oneGet 0
63− , bench "countdown" $ whnf countDown 100
64− ]
65− , bgroup "State + Error"
66− [ bench "countdownExc" $ whnf countDownExc 10000
67− ]
68− , bgroup "HTTP DSL"
69− [ bench "simple" $ whnf (run . runHTTP) prog
70− , bench "replicated" $ whnf (run . runHTTP . p) 100000
71− ]
72− ]
src/MTL.hsdeleted−27
@@ -1,27 +0,0 @@
1−module MTL (marks) where
2−
3−import qualified Control.Monad.State as MTL
4−import qualified Control.Monad.Except as MTL
5−import Gauge
6−
7−oneGet :: Int -> (Int, Int)
8−oneGet = MTL.runState MTL.get
9−
10−countDown :: Int -> (Int,Int)
11−countDown = MTL.runState go
12− where go = MTL.get >>= (\n -> if n <= 0 then pure n else MTL.put (n-1) >> go)
13−
14−countDownExc :: Int -> Either String (Int,Int)
15−countDownExc = MTL.runStateT go
16− where go = MTL.get >>= (\n -> if n <= (0 :: Int) then MTL.throwError "wat" else MTL.put (n-1) >> go)
17−
18−marks :: Benchmark
19−marks = bgroup "MTL"
20− [ bgroup "State"
21− [ bench "get" $ whnf oneGet 0
22− , bench "countdown" $ whnf countDown 100
23− ]
24− , bgroup "State + Error"
25− [ bench "countdownExc" $ whnf countDownExc 10000
26− ]
27− ]