git.iko.soy/effects-benchmarks
on master help sign in
swap
c7e354316 ahead, 0 behind
50 files changed+1048−822
since splitsnapshots
unifiedsplit
.gitignore+1 README.md+334−51 effects-benchmarks.cabal+78−93 instances/Effectful/Dynamic/Bench.hs+18 instances/Effectful/Dynamic/HTTP.hs+39 instances/Effectful/Dynamic/Stateful.hs+7 instances/Effectful/Dynamic/StatefulExcept.hs+10 instances/Effectful/Static/Bench.hs+17 instances/Effectful/Static/HTTP.hs+30 instances/Effectful/Static/Stateful.hs+7 instances/Effectful/Static/StatefulExcept.hs+10 instances/ExtEff/Bench.hs+22 instances/ExtEff/HTTP.hs+19−15 instances/ExtEff/Stateful.hs+3−14 instances/ExtEff/StatefulExcept.hs+3−16 instances/FSStateful.hs−18 instances/Freer/Bench.hs+22 instances/Freer/HTTP.hs+25−19 instances/Freer/Stateful.hs+7 instances/Freer/StatefulExcept.hs+5−16 instances/Fused/Bench.hs+21 instances/Fused/HTTP.hs+35−41 instances/Fused/Stateful.hs+3−14 instances/Fused/StatefulExcept.hs+4−17 instances/MTL/Bench.hs+21 instances/MTL/HTTP.hs+14−9 instances/MTL/Stateful.hs+6 instances/MTL/StatefulExcept.hs+4−17 instances/MTLStateful.hs−16 instances/PStateful.hs−17 instances/Poly/Bench.hs+22 instances/Poly/HTTP.hs+21−37 instances/Poly/Stateful.hs+3−13 instances/Poly/StatefulExcept.hs+4−16 instances/Shallow/Bench.hs+19 instances/Shallow/HTTP.hs+11−4 instances/Shallow/Stateful.hs+6−1 instances/Shallow/StatefulExcept.hs+12−6 package.yaml+37 src/Bench/Countdown.hs−14 src/Bench/HTTP.hs−11 src/Bench/Signature/HTTP.hsig−19 src/Bench/Signature/Stateful.hsig−17 src/Bench/Signature/StatefulExcept.hsig−17 src/FreerSimple.hs−73 src/HigherOrder.hs−76 src/JVEffects.hs−72 src/MTL.hs−27 src/Main.hs+70−46 stack.yaml+78
.gitignore+1
@@ -1,4 +1,5 @@
11.stack-work
22.DS_Store
33core-html/
4+dist
45dist-newstyle/
README.md+334−51
@@ -1,105 +1,388 @@
11# effects-benchmarks
22
3−This is a set of memory and time benchmarks for the various Haskell effects libraries, including `fused-effects`, `polysemy`, `freer-simple`, and `extensible-effects`. Benchmarks for equivalent `mtl` and handwritten computations are included for comparison purposes. It uses Cabal's new Backpack feature to save a great deal of boilerplate code.
43
5−# tl;dr
4+## Results
65
7−`fused-effects` and `mtl` achieve roughly commensurate performance. `polysemy` is within an order of magnitude of `fused-effects` and `mtl`. `freer-simple` and `extensible-effects` are considerably slower.
6+<details>
87
9−# Full results
10−
11−On a 15-inch 2017 MacBook Pro (3.1GHz Intel i7, 16GB RAM), here are results for space benchmarks:
8+<summary>Linux – Intel(R) Core(TM) i5-10210U CPU @ 1.60GHz</summary>
129
1310```
11+*** Time benchmarks ***
12+benchmarked Countdown/Put/fused-effects
13+time 13.54 ms (13.44 ms .. 13.67 ms)
14+ 0.999 R² (0.998 R² .. 1.000 R²)
15+mean 13.58 ms (13.54 ms .. 13.69 ms)
16+std dev 165.6 μs (94.38 μs .. 276.3 μs)
17+
18+benchmarked Countdown/Put/mtl
19+time 4.885 ms (4.777 ms .. 4.954 ms)
20+ 0.998 R² (0.993 R² .. 1.000 R²)
21+mean 4.995 ms (4.934 ms .. 5.227 ms)
22+std dev 333.6 μs (54.64 μs .. 696.6 μs)
23+variance introduced by outliers: 37% (moderately inflated)
24+
25+benchmarked Countdown/Put/polysemy
26+time 20.82 ms (20.58 ms .. 21.10 ms)
27+ 0.999 R² (0.997 R² .. 1.000 R²)
28+mean 20.82 ms (20.70 ms .. 21.00 ms)
29+std dev 359.1 μs (243.7 μs .. 578.8 μs)
30+
31+benchmarked Countdown/Put/freer-simple
32+time 20.18 ms (19.82 ms .. 20.56 ms)
33+ 0.998 R² (0.997 R² .. 0.999 R²)
34+mean 19.90 ms (19.56 ms .. 20.53 ms)
35+std dev 1.084 ms (524.8 μs .. 2.078 ms)
36+variance introduced by outliers: 22% (moderately inflated)
37+
38+benchmarked Countdown/Put/extensible-effects
39+time 22.01 ms (21.29 ms .. 22.72 ms)
40+ 0.997 R² (0.995 R² .. 0.999 R²)
41+mean 20.74 ms (19.73 ms .. 21.26 ms)
42+std dev 1.554 ms (611.3 μs .. 2.309 ms)
43+variance introduced by outliers: 30% (moderately inflated)
44+
45+benchmarked Countdown/Put/shallow
46+time 2.432 ms (2.390 ms .. 2.477 ms)
47+ 0.998 R² (0.997 R² .. 0.999 R²)
48+mean 2.439 ms (2.425 ms .. 2.456 ms)
49+std dev 47.42 μs (39.74 μs .. 62.97 μs)
50+
51+benchmarked Countdown/Put/effectful - static
52+time 555.5 μs (542.5 μs .. 567.2 μs)
53+ 0.995 R² (0.985 R² .. 1.000 R²)
54+mean 548.2 μs (544.0 μs .. 561.4 μs)
55+std dev 19.40 μs (5.420 μs .. 41.81 μs)
56+variance introduced by outliers: 12% (moderately inflated)
57+
58+benchmarked Countdown/Put/effectful - dynamic
59+time 2.729 ms (2.688 ms .. 2.777 ms)
60+ 0.998 R² (0.996 R² .. 0.999 R²)
61+mean 2.736 ms (2.722 ms .. 2.761 ms)
62+std dev 59.64 μs (42.50 μs .. 90.32 μs)
63+
64+benchmarked Countdown/Put+Exc/fused-effects
65+time 11.89 ms (11.76 ms .. 12.06 ms)
66+ 0.999 R² (0.999 R² .. 1.000 R²)
67+mean 11.93 ms (11.87 ms .. 12.05 ms)
68+std dev 199.3 μs (102.4 μs .. 324.7 μs)
69+
70+benchmarked Countdown/Put+Exc/mtl
71+time 5.196 ms (5.120 ms .. 5.299 ms)
72+ 0.998 R² (0.994 R² .. 0.999 R²)
73+mean 5.200 ms (5.169 ms .. 5.254 ms)
74+std dev 108.8 μs (69.46 μs .. 167.0 μs)
75+
76+benchmarked Countdown/Put+Exc/polysemy
77+time 29.24 ms (28.82 ms .. 29.79 ms)
78+ 0.999 R² (0.998 R² .. 1.000 R²)
79+mean 29.51 ms (29.26 ms .. 29.95 ms)
80+std dev 681.2 μs (452.7 μs .. 990.8 μs)
81+
82+benchmarked Countdown/Put+Exc/freer-simple
83+time 13.32 ms (12.65 ms .. 14.12 ms)
84+ 0.984 R² (0.974 R² .. 0.993 R²)
85+mean 11.50 ms (11.00 ms .. 11.99 ms)
86+std dev 1.209 ms (1.080 ms .. 1.435 ms)
87+variance introduced by outliers: 48% (moderately inflated)
88+
89+benchmarked Countdown/Put+Exc/extensible-effects
90+time 17.03 ms (15.01 ms .. 18.76 ms)
91+ 0.956 R² (0.928 R² .. 0.980 R²)
92+mean 13.62 ms (12.99 ms .. 14.50 ms)
93+std dev 1.750 ms (1.315 ms .. 2.083 ms)
94+variance introduced by outliers: 56% (severely inflated)
95+
96+benchmarked Countdown/Put+Exc/shallow
97+time 580.0 μs (475.1 μs .. 675.5 μs)
98+ 0.971 R² (0.958 R² .. 1.000 R²)
99+mean 573.0 μs (566.0 μs .. 584.6 μs)
100+std dev 14.90 μs (1.088 μs .. 19.80 μs)
101+
102+benchmarked Countdown/Put+Exc/effectful - static
103+time 588.1 μs (520.7 μs .. 679.1 μs)
104+ 0.974 R² (0.954 R² .. 0.998 R²)
105+mean 602.3 μs (596.0 μs .. 612.8 μs)
106+std dev 13.75 μs (5.999 μs .. 17.97 μs)
107+
108+benchmarked Countdown/Put+Exc/effectful - dynamic
109+time 2.769 ms (2.747 ms .. 2.806 ms)
110+ 0.997 R² (0.992 R² .. 1.000 R²)
111+mean 2.796 ms (2.783 ms .. 2.832 ms)
112+std dev 48.48 μs (21.03 μs .. 95.12 μs)
113+
114+benchmarked HTTP/fused-effects
115+time 1.937 ms (1.916 ms .. 1.976 ms)
116+ 0.997 R² (0.993 R² .. 1.000 R²)
117+mean 1.937 ms (1.928 ms .. 1.957 ms)
118+std dev 29.94 μs (11.47 μs .. 54.28 μs)
119+
120+benchmarked HTTP/polysemy
121+time 34.56 ms (33.19 ms .. 36.29 ms)
122+ 0.995 R² (0.992 R² .. 1.000 R²)
123+mean 33.67 ms (33.40 ms .. 34.39 ms)
124+std dev 841.1 μs (347.0 μs .. 1.492 ms)
125+
126+benchmarked HTTP/extensible-effects
127+time 19.92 ms (18.98 ms .. 21.52 ms)
128+ 0.983 R² (0.970 R² .. 0.991 R²)
129+mean 17.74 ms (16.85 ms .. 18.62 ms)
130+std dev 1.942 ms (1.676 ms .. 2.228 ms)
131+variance introduced by outliers: 48% (moderately inflated)
132+
133+benchmarked HTTP/Deep embedding
134+time 28.14 ms (25.55 ms .. 30.55 ms)
135+ 0.980 R² (0.966 R² .. 0.993 R²)
136+mean 24.73 ms (22.59 ms .. 26.22 ms)
137+std dev 3.694 ms (2.445 ms .. 4.726 ms)
138+variance introduced by outliers: 61% (severely inflated)
139+
140+benchmarking HTTP/Shallow embedding ... took 11.97 s, total 40147 iterations
141+benchmarked HTTP/Shallow embedding
142+time 22.38 μs (21.23 μs .. 23.27 μs)
143+ 0.994 R² (0.977 R² .. 0.999 R²)
144+mean 25.00 μs (24.76 μs .. 25.35 μs)
145+std dev 484.0 ns (352.7 ns .. 601.7 ns)
146+
147+benchmarked HTTP/freer-simple
148+time 19.35 ms (18.52 ms .. 20.60 ms)
149+ 0.980 R² (0.959 R² .. 0.992 R²)
150+mean 17.17 ms (16.27 ms .. 18.04 ms)
151+std dev 1.945 ms (1.653 ms .. 2.326 ms)
152+variance introduced by outliers: 45% (moderately inflated)
153+
154+benchmarking HTTP/effectful - static ... took 11.95 s, total 38223 iterations
155+benchmarked HTTP/effectful - static
156+time 25.03 μs (16.61 μs .. 35.70 μs)
157+ 0.838 R² (0.740 R² .. 0.999 R²)
158+mean 25.57 μs (24.80 μs .. 27.01 μs)
159+std dev 1.644 μs (121.0 ns .. 2.127 μs)
160+variance introduced by outliers: 18% (moderately inflated)
161+
162+benchmarked HTTP/effectful - dynamic
163+time 4.058 ms (3.662 ms .. 4.753 ms)
164+ 0.918 R² (0.847 R² .. 0.997 R²)
165+mean 3.886 ms (3.773 ms .. 4.122 ms)
166+std dev 397.4 μs (161.9 μs .. 614.5 μs)
167+variance introduced by outliers: 50% (severely inflated)
168+
169+*** Space benchmarks (these will take some time to run) ***
170+
14171Countdown
15172
16− Case Allocated
17− fused-effects 40
18− mtl 40
19− polysemy 1,304
20− freer-simple 1,096
21− extensible-effects 1,304
22− shallow 232
173+ Case Allocated GCs
174+ fused-effects 2,512 0
175+ mtl 792 0
176+ polysemy 4,184 0
177+ freer-simple 1,120 0
178+ extensible-effects 1,264 0
179+ shallow 232 0
180+ effectful - static 4,000,488 3
181+ effectful - dynamic 14,401,376 13
23182
24183Countdown + exc
25184
26− Case Allocated GCs
27− fused-effects 336
28− mtl 336
29− polysemy 792
30− freer-simple 864
31− extensible-effects 984
32− shallow 320
185+ Case Allocated GCs
186+ fused-effects 1,080 0
187+ mtl 608 0
188+ polysemy 4,144 0
189+ freer-simple 576 0
190+ extensible-effects 688 0
191+ shallow 0 0
192+ effectful - static 4,002,080 3
193+ effectful - dynamic 14,403,832 13
33194```
34195
35−(The fact that `fused-effects` and `mtl` have the same allocations is not an error; `fused-effects` was designed to have almost identical performance characteristics to `mtl`.)
196+</details>
197+
198+<details>
36199
37−Time (`State`-based countdown):
200+<summary>macOS – MacBook Pro (13-inch, 2018, Four Thunderbolt 3 Ports) – 2.3 GHz Quad-Core Intel Core i5</summary>
38201
39202```
203+*** Time benchmarks ***
40204benchmarked Countdown/Put/fused-effects
41−time 5.692 μs (5.570 μs .. 5.835 μs)
205+time 13.54 ms (13.44 ms .. 13.67 ms)
206+ 0.999 R² (0.998 R² .. 1.000 R²)
207+mean 13.58 ms (13.54 ms .. 13.69 ms)
208+std dev 165.6 μs (94.38 μs .. 276.3 μs)
42209
43210benchmarked Countdown/Put/mtl
44−time 5.500 μs (5.386 μs .. 5.719 μs)
211+time 4.885 ms (4.777 ms .. 4.954 ms)
212+ 0.998 R² (0.993 R² .. 1.000 R²)
213+mean 4.995 ms (4.934 ms .. 5.227 ms)
214+std dev 333.6 μs (54.64 μs .. 696.6 μs)
215+variance introduced by outliers: 37% (moderately inflated)
45216
46217benchmarked Countdown/Put/polysemy
47−time 1.903 ms (1.845 ms .. 1.954 ms)
218+time 20.82 ms (20.58 ms .. 21.10 ms)
219+ 0.999 R² (0.997 R² .. 1.000 R²)
220+mean 20.82 ms (20.70 ms .. 21.00 ms)
221+std dev 359.1 μs (243.7 μs .. 578.8 μs)
48222
49223benchmarked Countdown/Put/freer-simple
50−time 1.324 ms (1.282 ms .. 1.361 ms)
224+time 20.18 ms (19.82 ms .. 20.56 ms)
225+ 0.998 R² (0.997 R² .. 0.999 R²)
226+mean 19.90 ms (19.56 ms .. 20.53 ms)
227+std dev 1.084 ms (524.8 μs .. 2.078 ms)
228+variance introduced by outliers: 22% (moderately inflated)
51229
52230benchmarked Countdown/Put/extensible-effects
53−time 1.383 ms (1.343 ms .. 1.422 ms)
231+time 22.01 ms (21.29 ms .. 22.72 ms)
232+ 0.997 R² (0.995 R² .. 0.999 R²)
233+mean 20.74 ms (19.73 ms .. 21.26 ms)
234+std dev 1.554 ms (611.3 μs .. 2.309 ms)
235+variance introduced by outliers: 30% (moderately inflated)
54236
55237benchmarked Countdown/Put/shallow
56−time 275.1 μs (270.1 μs .. 281.6 μs)
57−```
58−
59−Time (`State` + `Error` countdown):
238+time 2.432 ms (2.390 ms .. 2.477 ms)
239+ 0.998 R² (0.997 R² .. 0.999 R²)
240+mean 2.439 ms (2.425 ms .. 2.456 ms)
241+std dev 47.42 μs (39.74 μs .. 62.97 μs)
242+
243+benchmarked Countdown/Put/effectful - static
244+time 555.5 μs (542.5 μs .. 567.2 μs)
245+ 0.995 R² (0.985 R² .. 1.000 R²)
246+mean 548.2 μs (544.0 μs .. 561.4 μs)
247+std dev 19.40 μs (5.420 μs .. 41.81 μs)
248+variance introduced by outliers: 12% (moderately inflated)
249+
250+benchmarked Countdown/Put/effectful - dynamic
251+time 2.729 ms (2.688 ms .. 2.777 ms)
252+ 0.998 R² (0.996 R² .. 0.999 R²)
253+mean 2.736 ms (2.722 ms .. 2.761 ms)
254+std dev 59.64 μs (42.50 μs .. 90.32 μs)
60255
61−```
62256benchmarked Countdown/Put+Exc/fused-effects
63−time 9.829 μs (9.645 μs .. 10.04 μs)
257+time 11.89 ms (11.76 ms .. 12.06 ms)
258+ 0.999 R² (0.999 R² .. 1.000 R²)
259+mean 11.93 ms (11.87 ms .. 12.05 ms)
260+std dev 199.3 μs (102.4 μs .. 324.7 μs)
64261
65262benchmarked Countdown/Put+Exc/mtl
66−time 9.968 μs (9.779 μs .. 10.15 μs)
263+time 5.196 ms (5.120 ms .. 5.299 ms)
264+ 0.998 R² (0.994 R² .. 0.999 R²)
265+mean 5.200 ms (5.169 ms .. 5.254 ms)
266+std dev 108.8 μs (69.46 μs .. 167.0 μs)
67267
68268benchmarked Countdown/Put+Exc/polysemy
69−time 418.1 μs (408.9 μs .. 427.1 μs)
269+time 29.24 ms (28.82 ms .. 29.79 ms)
270+ 0.999 R² (0.998 R² .. 1.000 R²)
271+mean 29.51 ms (29.26 ms .. 29.95 ms)
272+std dev 681.2 μs (452.7 μs .. 990.8 μs)
70273
71274benchmarked Countdown/Put+Exc/freer-simple
72−time 1.157 ms (1.120 ms .. 1.199 ms)
275+time 13.32 ms (12.65 ms .. 14.12 ms)
276+ 0.984 R² (0.974 R² .. 0.993 R²)
277+mean 11.50 ms (11.00 ms .. 11.99 ms)
278+std dev 1.209 ms (1.080 ms .. 1.435 ms)
279+variance introduced by outliers: 48% (moderately inflated)
73280
74281benchmarked Countdown/Put+Exc/extensible-effects
75−time 1.232 ms (1.212 ms .. 1.262 ms)
282+time 17.03 ms (15.01 ms .. 18.76 ms)
283+ 0.956 R² (0.928 R² .. 0.980 R²)
284+mean 13.62 ms (12.99 ms .. 14.50 ms)
285+std dev 1.750 ms (1.315 ms .. 2.083 ms)
286+variance introduced by outliers: 56% (severely inflated)
76287
77288benchmarked Countdown/Put+Exc/shallow
78−time 55.12 μs (54.34 μs .. 56.29 μs)
79−```
80−
81−Time (custom HTTP DSL):
289+time 580.0 μs (475.1 μs .. 675.5 μs)
290+ 0.971 R² (0.958 R² .. 1.000 R²)
291+mean 573.0 μs (566.0 μs .. 584.6 μs)
292+std dev 14.90 μs (1.088 μs .. 19.80 μs)
293+
294+benchmarked Countdown/Put+Exc/effectful - static
295+time 588.1 μs (520.7 μs .. 679.1 μs)
296+ 0.974 R² (0.954 R² .. 0.998 R²)
297+mean 602.3 μs (596.0 μs .. 612.8 μs)
298+std dev 13.75 μs (5.999 μs .. 17.97 μs)
299+
300+benchmarked Countdown/Put+Exc/effectful - dynamic
301+time 2.769 ms (2.747 ms .. 2.806 ms)
302+ 0.997 R² (0.992 R² .. 1.000 R²)
303+mean 2.796 ms (2.783 ms .. 2.832 ms)
304+std dev 48.48 μs (21.03 μs .. 95.12 μs)
82305
83−```
84306benchmarked HTTP/fused-effects
85−time 8.311 μs (8.060 μs .. 8.592 μs)
307+time 1.937 ms (1.916 ms .. 1.976 ms)
308+ 0.997 R² (0.993 R² .. 1.000 R²)
309+mean 1.937 ms (1.928 ms .. 1.957 ms)
310+std dev 29.94 μs (11.47 μs .. 54.28 μs)
86311
87312benchmarked HTTP/polysemy
88−time 14.99 ms (14.26 ms .. 15.80 ms)
313+time 34.56 ms (33.19 ms .. 36.29 ms)
314+ 0.995 R² (0.992 R² .. 1.000 R²)
315+mean 33.67 ms (33.40 ms .. 34.39 ms)
316+std dev 841.1 μs (347.0 μs .. 1.492 ms)
89317
90318benchmarked HTTP/extensible-effects
91−time 1.612 ms (1.578 ms .. 1.654 ms)
319+time 19.92 ms (18.98 ms .. 21.52 ms)
320+ 0.983 R² (0.970 R² .. 0.991 R²)
321+mean 17.74 ms (16.85 ms .. 18.62 ms)
322+std dev 1.942 ms (1.676 ms .. 2.228 ms)
323+variance introduced by outliers: 48% (moderately inflated)
92324
93325benchmarked HTTP/Deep embedding
94−time 2.027 ms (1.876 ms .. 2.184 ms)
326+time 28.14 ms (25.55 ms .. 30.55 ms)
327+ 0.980 R² (0.966 R² .. 0.993 R²)
328+mean 24.73 ms (22.59 ms .. 26.22 ms)
329+std dev 3.694 ms (2.445 ms .. 4.726 ms)
330+variance introduced by outliers: 61% (severely inflated)
95331
332+benchmarking HTTP/Shallow embedding ... took 11.97 s, total 40147 iterations
96333benchmarked HTTP/Shallow embedding
97−time 15.94 μs (15.49 μs .. 16.46 μs)
334+time 22.38 μs (21.23 μs .. 23.27 μs)
335+ 0.994 R² (0.977 R² .. 0.999 R²)
336+mean 25.00 μs (24.76 μs .. 25.35 μs)
337+std dev 484.0 ns (352.7 ns .. 601.7 ns)
98338
99339benchmarked HTTP/freer-simple
100−time 1.478 ms (1.443 ms .. 1.515 ms)
340+time 19.35 ms (18.52 ms .. 20.60 ms)
341+ 0.980 R² (0.959 R² .. 0.992 R²)
342+mean 17.17 ms (16.27 ms .. 18.04 ms)
343+std dev 1.945 ms (1.653 ms .. 2.326 ms)
344+variance introduced by outliers: 45% (moderately inflated)
345+
346+benchmarking HTTP/effectful - static ... took 11.95 s, total 38223 iterations
347+benchmarked HTTP/effectful - static
348+time 25.03 μs (16.61 μs .. 35.70 μs)
349+ 0.838 R² (0.740 R² .. 0.999 R²)
350+mean 25.57 μs (24.80 μs .. 27.01 μs)
351+std dev 1.644 μs (121.0 ns .. 2.127 μs)
352+variance introduced by outliers: 18% (moderately inflated)
353+
354+benchmarked HTTP/effectful - dynamic
355+time 4.058 ms (3.662 ms .. 4.753 ms)
356+ 0.918 R² (0.847 R² .. 0.997 R²)
357+mean 3.886 ms (3.773 ms .. 4.122 ms)
358+std dev 397.4 μs (161.9 μs .. 614.5 μs)
359+variance introduced by outliers: 50% (severely inflated)
360+
361+*** Space benchmarks (these will take some time to run) ***
362+
363+Countdown
364+
365+ Case Allocated GCs
366+ fused-effects 2,512 0
367+ mtl 792 0
368+ polysemy 4,184 0
369+ freer-simple 1,120 0
370+ extensible-effects 1,264 0
371+ shallow 232 0
372+ effectful - static 4,000,488 3
373+ effectful - dynamic 14,401,376 13
374+
375+Countdown + exc
376+
377+ Case Allocated GCs
378+ fused-effects 1,080 0
379+ mtl 608 0
380+ polysemy 4,144 0
381+ freer-simple 576 0
382+ extensible-effects 688 0
383+ shallow 0 0
384+ effectful - static 4,002,080 3
385+ effectful - dynamic 14,403,832 13
101386```
102387
103−# Future work
104−* More benchmarks: `Writer`, logging, `grammar`, `pipes`
105−* I am going to make this emit pretty graphs, or at least graphable .csv files, someday.
388+</details>
effects-benchmarks.cabal+78−93
@@ -1,97 +1,82 @@
1−cabal-version: 2.2
2−name: effects-benchmarks
3−version: 0.1.0.0
4−homepage: https://github.com/patrickt/effects-benchmarks#readme
5−license: BSD-3-Clause
6−license-file: LICENSE
7−author: Author name here
8−maintainer: example@example.com
9−copyright: 2018 Author name here
10−category: Web
11−build-type: Simple
12−extra-source-files: README.md
1+cabal-version: 1.12
132
14−common shared
15− default-language: Haskell2010
16− ghc-options: -Wall -Werror -O2
17− build-depends: base >= 4.7 && < 5
3+-- This file has been generated from package.yaml by hpack version 0.34.4.
4+--
5+-- see: https://github.com/sol/hpack
186
19−library benchmark-signatures
20− import: shared
21− hs-source-dirs: src
22− signatures: Bench.Signature.Stateful
23− , Bench.Signature.StatefulExcept
24− , Bench.Signature.HTTP
25− exposed-modules: Bench.Countdown
26− , Bench.HTTP
27−
28−library instances-for-shallow
29− import: shared
30− hs-source-dirs: instances
31− default-extensions: StrictData
32− exposed-modules: Shallow.HTTP
33− , Shallow.Stateful
34− , Shallow.StatefulExcept
35−
36−library instances-for-exteff
37− import: shared
38− hs-source-dirs: instances
39− exposed-modules: ExtEff.Stateful
40− , ExtEff.StatefulExcept
41− , ExtEff.HTTP
42− build-depends: extensible-effects ^>= 5.0.0.1
43−
44−library instances-for-mtl
45− import: shared
46− hs-source-dirs: instances
47− exposed-modules: MTLStateful
48− , MTL.StatefulExcept
49− , MTL.HTTP
50− build-depends: mtl ^>= 2.2.2
51−
52−library instances-for-fused-effects
53− import: shared
54− hs-source-dirs: instances
55− exposed-modules: Fused.Stateful
56− , Fused.StatefulExcept
57− , Fused.HTTP
58− build-depends: fused-effects >= 0.3.1.0
59−
60−library instances-for-freer-simple
61− import: shared
62− hs-source-dirs: instances
63− exposed-modules: FSStateful
64− , Freer.StatefulExcept
65− , Freer.HTTP
66− build-depends: freer-simple ^>= 1.2.1
67−
68−library instances-for-polysemy
69− import: shared
70− hs-source-dirs: instances
71− exposed-modules: Poly.Stateful
72− , Poly.StatefulExcept
73− , Poly.HTTP
74− build-depends: polysemy ^>= 0.1.2
7+name: effects-benchmarks
8+version: 0.0.0
9+license: BSD3
10+license-file: LICENSE
11+build-type: Simple
7512
7613benchmark effects-benchmarks
77− import: shared
78− type: exitcode-stdio-1.0
79− hs-source-dirs: src
80− build-depends: benchmark-signatures
81− , instances-for-mtl
82− , instances-for-fused-effects
83− , instances-for-freer-simple
84− , instances-for-polysemy
85− , instances-for-shallow
86− , instances-for-exteff
87− , dump-core
88− , gauge
89− , weigh
90− , polysemy
91− main-is: Main.hs
92− mixins: benchmark-signatures (Bench.Countdown as MTL.Countdown, Bench.HTTP as MTL.HTTPM) requires (Bench.Signature.Stateful as MTLStateful, Bench.Signature.StatefulExcept as MTL.StatefulExcept, Bench.Signature.HTTP as MTL.HTTP)
93− , benchmark-signatures (Bench.Countdown as Fused.Countdown, Bench.HTTP as Fused.HTTPM) requires (Bench.Signature.Stateful as Fused.Stateful, Bench.Signature.StatefulExcept as Fused.StatefulExcept, Bench.Signature.HTTP as Fused.HTTP)
94− , benchmark-signatures (Bench.Countdown as Simple.Countdown, Bench.HTTP as Simple.HTTPM) requires (Bench.Signature.Stateful as FSStateful, Bench.Signature.StatefulExcept as Freer.StatefulExcept, Bench.Signature.HTTP as Freer.HTTP)
95− , benchmark-signatures (Bench.Countdown as Shallow.Countdown, Bench.HTTP as Shallow.HTTPM) requires (Bench.Signature.Stateful as Shallow.Stateful, Bench.Signature.StatefulExcept as Shallow.StatefulExcept, Bench.Signature.HTTP as Shallow.HTTP)
96− , benchmark-signatures (Bench.Countdown as Poly.Countdown, Bench.HTTP as Poly.HTTPM) requires (Bench.Signature.Stateful as Poly.Stateful, Bench.Signature.StatefulExcept as Poly.StatefulExcept, Bench.Signature.HTTP as Poly.HTTP)
97− , benchmark-signatures (Bench.Countdown as ExtEff.Countdown, Bench.HTTP as ExtEff.HTTPM) requires (Bench.Signature.Stateful as ExtEff.Stateful, Bench.Signature.StatefulExcept as ExtEff.StatefulExcept, Bench.Signature.HTTP as ExtEff.HTTP)
14+ type: exitcode-stdio-1.0
15+ main-is: Main.hs
16+ other-modules:
17+ Effectful.Dynamic.Bench
18+ Effectful.Dynamic.HTTP
19+ Effectful.Dynamic.Stateful
20+ Effectful.Dynamic.StatefulExcept
21+ Effectful.Static.Bench
22+ Effectful.Static.HTTP
23+ Effectful.Static.Stateful
24+ Effectful.Static.StatefulExcept
25+ ExtEff.Bench
26+ ExtEff.HTTP
27+ ExtEff.Stateful
28+ ExtEff.StatefulExcept
29+ Freer.Bench
30+ Freer.HTTP
31+ Freer.Stateful
32+ Freer.StatefulExcept
33+ Fused.Bench
34+ Fused.HTTP
35+ Fused.Stateful
36+ Fused.StatefulExcept
37+ MTL.Bench
38+ MTL.HTTP
39+ MTL.Stateful
40+ MTL.StatefulExcept
41+ Poly.Bench
42+ Poly.HTTP
43+ Poly.Stateful
44+ Poly.StatefulExcept
45+ Shallow.Bench
46+ Shallow.HTTP
47+ Shallow.Stateful
48+ Shallow.StatefulExcept
49+ Paths_effects_benchmarks
50+ hs-source-dirs:
51+ instances
52+ src
53+ default-extensions:
54+ DeriveAnyClass
55+ DeriveFunctor
56+ DeriveGeneric
57+ DerivingStrategies
58+ FlexibleInstances
59+ GADTs
60+ GeneralizedNewtypeDeriving
61+ KindSignatures
62+ MultiParamTypeClasses
63+ TypeOperators
64+ UndecidableInstances
65+ DataKinds
66+ FlexibleContexts
67+ TypeApplications
68+ LambdaCase
69+ ScopedTypeVariables
70+ DerivingStrategies
71+ build-depends:
72+ base
73+ , effectful
74+ , effectful-core
75+ , extensible-effects
76+ , freer-simple
77+ , fused-effects
78+ , gauge
79+ , mtl
80+ , polysemy
81+ , weigh
82+ default-language: Haskell2010
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)
instances/ExtEff/Bench.hsnew file+22
@@ -0,0 +1,22 @@
1+module ExtEff.Bench
2+ ( countDownBench,
3+ countDownExcBench,
4+ httpBench,
5+ )
6+where
7+
8+import Control.Eff
9+import Control.Eff.Exception
10+import Control.Eff.State.Strict
11+import ExtEff.HTTP
12+import ExtEff.Stateful
13+import ExtEff.StatefulExcept
14+
15+countDownBench :: Int -> (Int, Int)
16+countDownBench start = run . runState start $ countDownPut
17+
18+countDownExcBench :: Int -> Either String (Int, Int)
19+countDownExcBench start = run . runError . runState start $ countDownExc
20+
21+httpBench :: Int -> IO Int
22+httpBench n = runHttp (doHTTP n)
instances/ExtEff/HTTP.hs+19−15
@@ -1,40 +1,44 @@
1−{-# LANGUAGE DataKinds, TypeOperators, GADTs, FlexibleInstances, MultiParamTypeClasses #-}
2−
31module ExtEff.HTTP where
42
53import Control.Eff
64import Control.Eff.Extend
5+import Control.Monad
76import Data.Function
87
9−type HttpM = Eff '[HTTP, Lift IO]
10−
118data HTTP a where
129 Open :: String -> HTTP ()
1310 Close :: HTTP ()
14− Post :: String -> HTTP String
15− HGet :: HTTP String
11+ Post :: String -> HTTP String
12+ HGet :: HTTP String
1613
17−open' :: String -> HttpM ()
18−open' = send . Open
14+open' :: Member HTTP e => String -> Eff e ()
15+open' = send . Open
1916
20−close' :: HttpM ()
17+close' :: Member HTTP e => Eff e ()
2118close' = send Close
2219
23−post' :: String -> HttpM String
20+post' :: Member HTTP e => String -> Eff e String
2421post' = send . Post
2522
26−get' :: HttpM String
23+get' :: Member HTTP e => Eff e String
2724get' = send HGet
2825
2926instance Handle HTTP r b (Eff e b) where
3027 handle h q req = case req of
3128 Open _s -> h (q ^$ ())
32− Close -> h (q ^$ ())
33− Post s -> h (q ^$ ("posted " <> s))
34− HGet -> h (q ^$ "contents")
29+ Close -> h (q ^$ ())
30+ Post s -> h (q ^$ ("posted " <> s))
31+ HGet -> h (q ^$ "contents")
3532
3633doHttp :: Eff (HTTP ': e) b -> Eff e b
3734doHttp = fix (handle_relay pure)
3835
39−runHttp :: HttpM a -> IO a
36+runHttp :: Eff '[HTTP, Lift IO] a -> IO a
4037runHttp = runLift . doHttp
38+
39+doHTTP :: Member HTTP e => Int -> Eff e Int
40+doHTTP n = do
41+ open' "cats"
42+ replicateM_ n (get' *> post' "cats")
43+ close'
44+ pure n
instances/ExtEff/Stateful.hs+3−14
@@ -1,18 +1,7 @@
1−{-# LANGUAGE DataKinds, TypeApplications #-}
2−
31module ExtEff.Stateful where
42
53import Control.Eff
6−import Control.Eff.State.Strict as State
7−import Data.Tuple
8−
9−type StateM = Eff '[State Int]
10−
11−get :: StateM Int
12−get = State.get @Int
13−
14−put :: Int -> StateM ()
15−put = State.put @Int
4+import Control.Eff.State.Strict
165
17−runStateful :: Int -> StateM a -> (Int, a)
18−runStateful n x = swap . run $ State.runState n x
6+countDownPut :: Member (State Int) r => Eff r Int
7+countDownPut = get >>= (\n -> if n < 0 then pure n else put (n - 1) *> countDownPut)
instances/ExtEff/StatefulExcept.hs+3−16
@@ -1,21 +1,8 @@
1−{-# LANGUAGE TypeApplications, DataKinds #-}
21module ExtEff.StatefulExcept where
32
43import Control.Eff
5−import Control.Eff.State.Strict as State
64import Control.Eff.Exception
7−import Data.Tuple
5+import Control.Eff.State.Strict
86
9−type StateM = Eff '[State Int, Exc String]
10−
11−get :: StateM Int
12−get = State.get @Int
13−
14−put :: Int -> StateM ()
15−put = State.put @Int
16−
17−throw :: String -> StateM a
18−throw = throwError
19−
20−runStatefulExcept :: Int -> StateM a -> Either String (Int, a)
21−runStatefulExcept n x = fmap swap . run . runError $ State.runState n x
7+countDownExc :: (Member (State Int) r, Member (Exc String) r) => Eff r b
8+countDownExc = get @Int >>= (\n -> if n <= 0 then throwError "what" else put @Int (n - 1) *> countDownExc)
instances/FSStateful.hsdeleted−18
@@ -1,18 +0,0 @@
1−{-# LANGUAGE TypeApplications, DataKinds #-}
2−
3−module FSStateful where
4−
5−import Control.Monad.Freer
6−import Control.Monad.Freer.State as State
7−import Data.Tuple
8−
9−type StateM = Eff '[State Int]
10−
11−get :: StateM Int
12−get = State.get @Int
13−
14−put :: Int -> StateM ()
15−put = State.put @Int
16−
17−runStateful :: Int -> StateM a -> (Int, a)
18−runStateful n x = swap . run $ State.runState n x
instances/Freer/Bench.hsnew file+22
@@ -0,0 +1,22 @@
1+module Freer.Bench
2+ ( countDownBench,
3+ countDownExcBench,
4+ httpBench,
5+ )
6+where
7+
8+import Control.Monad.Freer
9+import Control.Monad.Freer.Error
10+import Control.Monad.Freer.State
11+import Freer.HTTP
12+import Freer.Stateful
13+import Freer.StatefulExcept
14+
15+countDownBench :: Int -> (Int, Int)
16+countDownBench start = run . runState start $ countDownPut
17+
18+countDownExcBench :: Int -> Either String (Int, Int)
19+countDownExcBench start = run . runError . runState start $ countDownExc
20+
21+httpBench :: Int -> IO Int
22+httpBench n = runHttp (doHTTP n)
instances/Freer/HTTP.hs+25−19
@@ -1,36 +1,42 @@
1−{-# LANGUAGE DataKinds, TypeOperators, GADTs #-}
2−
31module Freer.HTTP where
42
3+import Control.Monad
54import Control.Monad.Freer
65
7−type HttpM = Eff '[HTTP, IO]
8−
96data HTTP a where
107 Open :: String -> HTTP ()
118 Close :: HTTP ()
12− Post :: String -> HTTP String
13− HGet :: HTTP String
9+ Post :: String -> HTTP String
10+ HGet :: HTTP String
1411
15−open' :: String -> HttpM ()
16−open' = send . Open
12+open' :: Member HTTP e => String -> Eff e ()
13+open' = send . Open
1714
18−close' :: HttpM ()
15+close' :: Member HTTP e => Eff e ()
1916close' = send Close
2017
21−post' :: String -> HttpM String
18+post' :: Member HTTP e => String -> Eff e String
2219post' = send . Post
2320
24−get' :: HttpM String
21+get' :: Member HTTP e => Eff e String
2522get' = send HGet
2623
2724doHttp :: Eff (HTTP ': e) b -> Eff e b
28−doHttp = interpret
29− (\x -> case x of
30− Open _ -> pure ()
31− Close -> pure ()
32− Post a -> pure ("posted" <> a)
33− HGet -> pure "gotten")
34−
35−runHttp :: HttpM a -> IO a
25+doHttp =
26+ interpret
27+ ( \x -> case x of
28+ Open _ -> pure ()
29+ Close -> pure ()
30+ Post a -> pure ("posted" <> a)
31+ HGet -> pure "gotten"
32+ )
33+
34+runHttp :: Eff '[HTTP, IO] a -> IO a
3635runHttp = runM . doHttp
36+
37+doHTTP :: Member HTTP e => Int -> Eff e Int
38+doHTTP n = do
39+ open' "cats"
40+ replicateM_ n (get' *> post' "cats")
41+ close'
42+ pure n
instances/Freer/Stateful.hsnew file+7
@@ -0,0 +1,7 @@
1+module Freer.Stateful where
2+
3+import Control.Monad.Freer
4+import Control.Monad.Freer.State as State
5+
6+countDownPut :: Member (State Int) r => Eff r Int
7+countDownPut = get >>= (\n -> if n < 0 then pure n else put (n - 1) *> countDownPut)
instances/Freer/StatefulExcept.hs+5−16
@@ -1,21 +1,10 @@
1−{-# LANGUAGE TypeApplications, DataKinds #-}
21module Freer.StatefulExcept where
32
43import Control.Monad.Freer
5−import Control.Monad.Freer.State as State
64import Control.Monad.Freer.Error
7−import Data.Tuple
5+import Control.Monad.Freer.State
86
9−type StateM = Eff '[State Int, Error String]
10−
11−get :: StateM Int
12−get = State.get @Int
13−
14−put :: Int -> StateM ()
15−put = State.put @Int
16−
17−throw :: String -> StateM a
18−throw = throwError
19−
20−runStatefulExcept :: Int -> StateM a -> Either String (Int, a)
21−runStatefulExcept n x = fmap swap . run . runError $ State.runState n x
7+countDownExc :: (Member (State Int) e, Member (Error String) e) => Eff e b
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.hsnew file+21
@@ -0,0 +1,21 @@
1+module Fused.Bench
2+ ( countDownBench,
3+ countDownExcBench,
4+ httpBench,
5+ )
6+where
7+
8+import Control.Carrier.Error.Either
9+import Control.Carrier.State.Strict
10+import Fused.HTTP
11+import Fused.Stateful
12+import Fused.StatefulExcept
13+
14+countDownBench :: Int -> (Int, Int)
15+countDownBench start = run . runState start $ countDownPut
16+
17+countDownExcBench :: Int -> Either String (Int, Int)
18+countDownExcBench start = run . runError . runState start $ countDownExc
19+
20+httpBench :: Int -> IO Int
21+httpBench n = runHttp (doHTTP n)
instances/Fused/HTTP.hs+35−41
@@ -1,53 +1,47 @@
1−{-# LANGUAGE TypeOperators, FlexibleInstances, KindSignatures, MultiParamTypeClasses, DeriveFunctor, UndecidableInstances, GeneralizedNewtypeDeriving #-}
2−
31module Fused.HTTP where
42
5−import Control.Effect
6−import Control.Effect.Sum
7−import Control.Effect.Carrier
8−import Data.Coerce
3+import Control.Algebra
4+import Control.Carrier.Lift
5+import Control.Monad
96import Control.Monad.IO.Class
7+import Data.Functor
8+import GHC.Generics (Generic1)
109
11−newtype HttpC m a = HttpC { runHttpC :: m a }
12− deriving (Applicative, Functor, Monad, MonadIO)
13−
14−data HTTP (m :: * -> *) k
15− = Open String k
16− | Close k
17− | Post String (String -> k)
18− | HGet (String -> k)
19− deriving Functor
20−
21−instance Effect HTTP where
22− handle state handler (Open s k) = Open s (handler . (<$ state) $ k)
23− handle state handler (Close k) = Close (handler . (<$ state) $ k)
24− handle state handler (Post s k) = Post s (handler . (<$ state) . k)
25− handle state handler (HGet k) = HGet (handler . (<$ state) . k)
10+newtype HttpC m a = HttpC {runHttpC :: m a}
11+ deriving newtype (Applicative, Functor, Monad, MonadIO)
2612
27−instance HFunctor HTTP where
28− hmap _ = coerce
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
2918
30−open' :: String -> HttpM ()
31−open' s = send (Open s (pure ()))
19+open' :: Has HTTP sig m => String -> m ()
20+open' s = send (Open s)
3221
33−close' :: HttpM ()
34−close' = send (Close (pure ()))
22+close' :: Has HTTP sig m => m ()
23+close' = send Close
3524
36−post' :: String -> HttpM String
37−post' s = send (Post s pure)
25+post' :: Has HTTP sig m => String -> m String
26+post' s = send (Post s)
3827
39−get' :: HttpM String
40−get' = send (HGet pure)
28+get' :: Has HTTP sig m => m String
29+get' = send HGet
4130
42−type HttpM = HttpC (LiftC IO)
31+instance (Algebra sig m) => Algebra (HTTP :+: sig) (HttpC m) where
32+ alg hdl (L act) ctx = case act of
33+ Open _ -> pure ctx
34+ Close -> pure ctx
35+ Post s -> pure $ ctx $> ("posted " <> s)
36+ HGet -> pure $ ctx $> "lmao"
37+ alg hdl (R other) ctx = HttpC (alg (runHttpC . hdl) other ctx)
4338
44−instance (Effect sig, Carrier sig m) => Carrier (HTTP :+: sig) (HttpC m) where
45− eff (L act) = case act of
46− Open _ k -> k
47− Close k -> k
48− Post s k -> k ("posted " <> s)
49− HGet k -> k "lmao"
50− eff (R other) = HttpC (eff (handleCoercible other))
51−
52−runHttp :: HttpM a -> IO a
39+runHttp :: HttpC (LiftC IO) a -> IO a
5340runHttp = runM . runHttpC
41+
42+doHTTP :: Has HTTP sig m => Int -> m Int
43+doHTTP n = do
44+ open' "cats"
45+ replicateM_ n (get' *> post' "cats")
46+ close'
47+ pure n
instances/Fused/Stateful.hs+3−14
@@ -1,17 +1,6 @@
1−{-# LANGUAGE TypeApplications #-}
2−
31module Fused.Stateful where
42
5−import Control.Effect (run, PureC)
6−import Control.Effect.State.Lazy as State
7−
8−type StateM = StateC Int PureC
9−
10−get :: StateM Int
11−get = State.get @Int
12−
13−put :: Int -> StateM ()
14−put = State.put @Int
3+import Control.Effect.State
154
16−runStateful :: Int -> StateM a -> (Int, a)
17−runStateful n x = run $ State.runState n x
5+countDownPut :: Has (State Int) sig m => m Int
6+countDownPut = get >>= (\n -> if n < 0 then pure n else put (n - 1) *> countDownPut)
instances/Fused/StatefulExcept.hs+4−17
@@ -1,21 +1,8 @@
1−{-# LANGUAGE TypeApplications #-}
2−
31module Fused.StatefulExcept where
42
5−import Control.Effect (run, PureC)
6−import Control.Effect.State.Strict as State
73import Control.Effect.Error
4+import Control.Effect.State
85
9−type StateM = StateC Int (ErrorC String PureC)
10−
11−get :: StateM Int
12−get = State.get @Int
13−
14−put :: Int -> StateM ()
15−put = State.put @Int
16−
17−throw :: String -> StateM a
18−throw = throwError
19−
20−runStatefulExcept :: Int -> StateM a -> Either String (Int, a)
21−runStatefulExcept n x = run . runError $ State.runState n x
6+countDownExc :: (Has (State Int) sig m, Has (Error String) sig m) => m a
7+countDownExc =
8+ get @Int >>= (\n -> if n <= 0 then throwError "what" else put @Int (n - 1) *> countDownExc)
instances/MTL/Bench.hsnew file+21
@@ -0,0 +1,21 @@
1+module MTL.Bench
2+ ( countDownBench,
3+ countDownExcBench,
4+ httpBench,
5+ )
6+where
7+
8+import Control.Monad.Except
9+import Control.Monad.State.Strict
10+import MTL.HTTP
11+import MTL.Stateful
12+import MTL.StatefulExcept
13+
14+countDownBench :: Int -> (Int, Int)
15+countDownBench start = flip runState start $ countDownPut
16+
17+countDownExcBench :: Int -> Either String (Int, Int)
18+countDownExcBench start = runExcept . flip runStateT start $ countDownExc
19+
20+httpBench :: Int -> IO Int
21+httpBench n = runHttp (doHTTP n)
instances/MTL/HTTP.hs+14−9
@@ -1,5 +1,3 @@
1−{-# LANGUAGE GADTs, LambdaCase #-}
2−
31module MTL.HTTP where
42
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,10 +36,17 @@ 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"
46+
47+doHTTP :: Int -> HttpM Int
48+doHTTP n = do
49+ open' "cats"
50+ replicateM_ n (get' *> post' "cats")
51+ close'
52+ pure n
instances/MTL/Stateful.hsnew file+6
@@ -0,0 +1,6 @@
1+module MTL.Stateful where
2+
3+import Control.Monad.State.Class
4+
5+countDownPut :: MonadState Int m => m Int
6+countDownPut = get >>= (\n -> if n < 0 then pure n else put (n - 1) *> countDownPut)
instances/MTL/StatefulExcept.hs+4−17
@@ -1,20 +1,7 @@
11module MTL.StatefulExcept where
22
3−import qualified Control.Monad.State.Strict as MTL
4−import qualified Control.Monad.Except as MTL
5−import Data.Tuple
6−import Data.Functor.Identity
3+import Control.Monad.Error.Class
4+import Control.Monad.State.Class
75
8−type StateM = MTL.StateT Int (MTL.ExceptT String Identity)
9−
10−get :: StateM Int
11−get = MTL.get
12−
13−put :: Int -> StateM ()
14−put = MTL.put
15−
16−throw :: String -> StateM a
17−throw = MTL.throwError
18−
19−runStatefulExcept :: Int -> StateM a -> Either String (Int, a)
20−runStatefulExcept n x = fmap swap . MTL.runExcept $ MTL.runStateT x n
6+countDownExc :: (MonadState Int m, MonadError String m) => m a
7+countDownExc = get >>= (\n -> if n <= 0 then throwError "what" else put (n - 1) *> countDownExc)
instances/MTLStateful.hsdeleted−16
@@ -1,16 +0,0 @@
1−module MTLStateful where
2−
3−import qualified Control.Monad.State.Strict as MTL
4−import Data.Tuple
5−import Data.Functor.Identity
6−
7−type StateM = MTL.StateT Int Identity
8−
9−get :: StateM Int
10−get = MTL.get
11−
12−put :: Int -> StateM ()
13−put = MTL.put
14−
15−runStateful :: Int -> StateM a -> (Int, a)
16−runStateful n x = swap (MTL.runState x n)
instances/PStateful.hsdeleted−17
@@ -1,17 +0,0 @@
1−{-# LANGUAGE TypeApplications, DataKinds #-}
2−
3−module PStateful where
4−
5−import Polysemy
6−import Polysemy.State as State
7−
8−type StateM = Sem '[State Int]
9−
10−get :: StateM Int
11−get = State.get
12−
13−put :: Int -> StateM ()
14−put = State.put
15−
16−runStateful :: Int -> StateM a -> (Int, a)
17−runStateful n x = run $ State.runState n x
instances/Poly/Bench.hsnew file+22
@@ -0,0 +1,22 @@
1+module Poly.Bench
2+ ( countDownBench,
3+ countDownExcBench,
4+ httpBench,
5+ )
6+where
7+
8+import Poly.HTTP
9+import Poly.Stateful
10+import Poly.StatefulExcept
11+import Polysemy
12+import Polysemy.Error
13+import Polysemy.State
14+
15+countDownBench :: Int -> (Int, Int)
16+countDownBench start = run . runState start $ countDownPut
17+
18+countDownExcBench :: Int -> Either String (Int, Int)
19+countDownExcBench start = run . runError . runState start $ countDownExc
20+
21+httpBench :: Int -> IO Int
22+httpBench n = runHttp (doHTTP n)
instances/Poly/HTTP.hs+21−37
@@ -1,61 +1,45 @@
1−{-# LANGUAGE DataKinds, TemplateHaskell, KindSignatures, GADTs, FlexibleContexts, TypeOperators, LambdaCase #-}
1+{-# LANGUAGE TemplateHaskell #-}
22
33module Poly.HTTP where
44
5+import Control.Monad
56import Polysemy
67
7−type HttpM = Sem '[Http, Lift IO]
8+type HttpM = Sem '[Http, Final IO]
89
910data Http (m :: * -> *) a where
10− HOpen :: String -> Http m ()
11+ HOpen :: String -> Http m ()
1112 HClose :: Http m ()
12− HPost :: String -> Http m String
13− HGet :: Http m String
13+ HPost :: String -> Http m String
14+ HGet :: Http m String
1415
1516makeSem ''Http
1617
17−open' :: String -> HttpM ()
18−open' = hOpen
18+open' :: Member Http r => String -> Sem r ()
19+open' = hOpen
1920
20−close' :: HttpM ()
21+close' :: Member Http r => Sem r ()
2122close' = hClose
2223
23−post' :: String -> HttpM String
24+post' :: Member Http r => String -> Sem r String
2425post' = hPost
2526
26−get' :: HttpM String
27+get' :: Member Http r => Sem r String
2728get' = hGet
2829
2930runHttp' :: Sem (Http ': r) a -> Sem r a
3031runHttp' = interpret $ \case
3132 HOpen _ -> pure ()
32− HClose -> pure ()
33+ HClose -> pure ()
3334 HPost s -> pure ("posted " <> s)
34− HGet -> pure "contents"
35+ HGet -> pure "contents"
3536
3637runHttp :: HttpM a -> IO a
37−runHttp = runM . runHttp'
38−
39−-- open' :: String -> HttpM ()
40−-- open' = send . Open
41−
42−-- close' :: HttpM ()
43−-- close' = send Close
44−
45−-- post' :: String -> HttpM String
46−-- post' = send . Post
47−
48−-- get' :: HttpM String
49−-- get' = send Get
50−
51−-- runHttp' :: Eff (Http ': r) w -> Eff r w
52−-- runHttp' (Val x) = pure x
53−-- runHttp' (E u q) = case decomp u of
54−-- Right (Open _) -> runHttp (qApp q ())
55−-- Right Close -> runHttp (qApp q ())
56−-- Right (Post d) -> runHttp (qApp q d)
57−-- Right Get -> runHttp (qApp q "")
58−-- Left u' -> E u' (tsingleton (runHttp . qApp q ))
59−
60−-- runHttp :: HttpM a -> IO a
61−-- runHttp = runM . runHttp'
38+runHttp = runFinal . runHttp'
39+
40+doHTTP :: Member Http r => Int -> Sem r Int
41+doHTTP n = do
42+ open' "cats"
43+ replicateM_ n (get' *> post' "cats")
44+ close'
45+ pure n
instances/Poly/Stateful.hs+3−13
@@ -1,17 +1,7 @@
1−{-# LANGUAGE DataKinds, TypeApplications #-}
2−
31module Poly.Stateful where
42
53import Polysemy
6−import Polysemy.State as State
7−
8−type StateM = Sem '[State Int]
9−
10−get :: StateM Int
11−get = State.get @Int
12−
13−put :: Int -> StateM ()
14−put = State.put @Int
4+import Polysemy.State
155
16−runStateful :: Int -> StateM a -> (Int, a)
17−runStateful n x = run $ State.runState n x
6+countDownPut :: Member (State Int) r => Sem r Int
7+countDownPut = get >>= (\n -> if n < 0 then pure n else put (n - 1) *> countDownPut)
instances/Poly/StatefulExcept.hs+4−16
@@ -1,20 +1,8 @@
1−{-# LANGUAGE TypeApplications, DataKinds #-}
21module Poly.StatefulExcept where
32
43import Polysemy
5−import Polysemy.State as State
6−import Polysemy.Error as Err
4+import Polysemy.Error
5+import Polysemy.State
76
8−type StateM = Sem '[State Int, Error String]
9−
10−get :: StateM Int
11−get = State.get @Int
12−
13−put :: Int -> StateM ()
14−put = State.put @Int
15−
16−throw :: String -> StateM a
17−throw = Err.throw
18−
19−runStatefulExcept :: Int -> StateM a -> Either String (Int, a)
20−runStatefulExcept n x = run . runError $ State.runState n x
7+countDownExc :: (Member (State Int) r, Member (Error String) r) => Sem r a
8+countDownExc = get @Int >>= (\n -> if n <= 0 then throw "what" else put @Int (n - 1) *> countDownExc)
instances/Shallow/Bench.hsnew file+19
@@ -0,0 +1,19 @@
1+module Shallow.Bench
2+ ( countDownBench,
3+ countDownExcBench,
4+ httpBench,
5+ )
6+where
7+
8+import Shallow.HTTP
9+import Shallow.Stateful
10+import Shallow.StatefulExcept
11+
12+countDownBench :: Int -> (Int, Int)
13+countDownBench = countDownPut
14+
15+countDownExcBench :: Int -> Either String (Int, Int)
16+countDownExcBench = countDownExc
17+
18+httpBench :: Int -> IO Int
19+httpBench = doHTTP
instances/Shallow/HTTP.hs+11−4
@@ -1,9 +1,9 @@
1−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2−
31module Shallow.HTTP where
42
5−newtype HttpM a = HttpM { runHttp :: IO a}
6− deriving (Applicative, Functor, Monad)
3+import Control.Monad
4+
5+newtype HttpM a = HttpM {runHttp :: IO a}
6+ deriving newtype (Applicative, Functor, Monad)
77
88get' :: HttpM String
99get' = pure "lmao"
@@ -16,3 +16,10 @@ close' = pure ()
1616
1717open' :: String -> HttpM ()
1818open' _ = pure ()
19+
20+doHTTP :: Int -> IO Int
21+doHTTP n = runHttp $ do
22+ open' "cats"
23+ replicateM_ n (get' *> post' "cats")
24+ close'
25+ pure n
instances/Shallow/Stateful.hs+6−1
@@ -2,7 +2,7 @@ module Shallow.Stateful where
22
33import Control.Monad
44
5−newtype StateM a = StateM { unStateM :: Int -> (Int, a) }
5+newtype StateM a = StateM {unStateM :: Int -> (Int, a)}
66
77instance Functor StateM where
88 fmap f (StateM a) = StateM (\n -> fmap f (a n))
@@ -22,3 +22,8 @@ put x = StateM (\_ -> (x, ()))
2222
2323runStateful :: Int -> StateM a -> (Int, a)
2424runStateful n (StateM f) = f $! n
25+
26+countDownPut :: Int -> (Int, Int)
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+12−6
@@ -1,10 +1,8 @@
1−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2−
31module Shallow.StatefulExcept where
42
53import Control.Monad
64
7−newtype StateM a = StateM { unStateM :: Int -> Either String (Int, a) }
5+newtype StateM a = StateM {unStateM :: Int -> Either String (Int, a)}
86
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))
@@ -29,3 +30,8 @@ throw s = StateM (\_ -> Left s)
2930
3031runStatefulExcept :: Int -> StateM a -> Either String (Int, a)
3132runStatefulExcept n (StateM f) = f $! n
33+
34+countDownExc :: Int -> Either String (Int, Int)
35+countDownExc start = runStatefulExcept start go
36+ where
37+ go = get >>= (\n -> if n <= 0 then throw "what" else put (n - 1) *> go)
package.yamlnew file+37
@@ -0,0 +1,37 @@
1+name: effects-benchmarks
2+
3+benchmarks:
4+ effects-benchmarks:
5+ main: Main.hs
6+ dependencies:
7+ - base
8+ - polysemy
9+ - freer-simple
10+ - fused-effects
11+ - mtl
12+ - extensible-effects
13+ - gauge
14+ - weigh
15+ - effectful
16+ - effectful-core
17+ source-dirs:
18+ - instances
19+ - src
20+ default-extensions:
21+ - DeriveAnyClass
22+ - DeriveFunctor
23+ - DeriveGeneric
24+ - DerivingStrategies
25+ - FlexibleInstances
26+ - GADTs
27+ - GeneralizedNewtypeDeriving
28+ - KindSignatures
29+ - MultiParamTypeClasses
30+ - TypeOperators
31+ - UndecidableInstances
32+ - DataKinds
33+ - FlexibleContexts
34+ - TypeApplications
35+ - LambdaCase
36+ - ScopedTypeVariables
37+ - DerivingStrategies
src/Bench/Countdown.hsdeleted−14
@@ -1,14 +0,0 @@
1−{-# LANGUAGE FlexibleContexts #-}
2−
3−module Bench.Countdown where
4−
5−import qualified Bench.Signature.Stateful as S
6−import qualified Bench.Signature.StatefulExcept as SE
7−
8−countDownPut :: Int -> (Int, Int)
9−countDownPut start = S.runStateful start go where
10− go = S.get >>= (\n -> if n < 0 then pure n else S.put (n - 1) *> go)
11−
12−countDownExc :: Int -> Either String (Int, Int)
13−countDownExc start = SE.runStatefulExcept start go where
14− go = SE.get >>= (\n -> if n <= 0 then SE.throw "what" else SE.put (n - 1) *> go)
src/Bench/HTTP.hsdeleted−11
@@ -1,11 +0,0 @@
1−module Bench.HTTP where
2−
3−import Bench.Signature.HTTP
4−import Control.Monad
5−
6−doHTTP :: Int -> IO Int
7−doHTTP n = runHttp $ do
8− open' "cats"
9− replicateM_ n (get' *> post' "cats")
10− close'
11− pure n
src/Bench/Signature/HTTP.hsigdeleted−19
@@ -1,19 +0,0 @@
1−signature Bench.Signature.HTTP
2− ( HttpM
3− , open'
4− , close'
5− , post'
6− , get'
7− , runHttp
8− ) where
9−
10−data HttpM a
11−
12−instance Applicative HttpM
13−instance Monad HttpM
14−
15−open' :: String -> HttpM ()
16−get' :: HttpM String
17−post' :: String -> HttpM String
18−close' :: HttpM ()
19−runHttp :: HttpM a -> IO a
src/Bench/Signature/Stateful.hsigdeleted−17
@@ -1,17 +0,0 @@
1−{-# LANGUAGE KindSignatures #-}
2−signature Bench.Signature.Stateful
3− ( StateM
4− , get
5− , put
6− , runStateful
7− ) where
8−
9−data StateM a
10−
11−instance Applicative StateM
12−instance Monad StateM
13−
14−get :: StateM Int
15−put :: Int -> StateM ()
16−runStateful :: Int -> StateM a -> (Int, a)
17−
src/Bench/Signature/StatefulExcept.hsigdeleted−17
@@ -1,17 +0,0 @@
1−signature Bench.Signature.StatefulExcept
2− ( StateM
3− , get
4− , put
5− , throw
6− , runStatefulExcept
7− ) where
8−
9−data StateM a
10−
11−instance Applicative StateM
12−instance Monad StateM
13−
14−get :: StateM Int
15−put :: Int -> StateM ()
16−throw :: String -> StateM a
17−runStatefulExcept :: Int -> StateM a -> Either String (Int, a)
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− ]
src/Main.hs+70−46
@@ -1,66 +1,90 @@
1−{-# LANGUAGE FlexibleContexts, GADTs, CPP #-}
1+{-# LANGUAGE CPP #-}
2+{-# LANGUAGE FlexibleContexts #-}
3+{-# LANGUAGE GADTs #-}
24
35module Main where
46
7+import qualified Effectful.Dynamic.Bench as EffectfulDynamic
8+import qualified Effectful.Static.Bench as EffectfulStatic
9+import qualified ExtEff.Bench as ExtEff
10+import qualified Freer.Bench as Freer
11+import qualified Fused.Bench as Fused
512import Gauge (bench, bgroup, nf, nfAppIO)
613import Gauge.Main (defaultMain)
14+import qualified MTL.Bench as MTL
15+import qualified Poly.Bench as Poly
16+import qualified Shallow.Bench as Shallow
717import qualified Weigh
818
9−import qualified Fused.Countdown as Fused
10−import qualified Simple.Countdown as Simple
11−import qualified Shallow.Countdown as Shallow
12−import qualified MTL.Countdown as MTL
13−import qualified Poly.Countdown as Poly
14−import qualified ExtEff.Countdown as ExtEff
15−
16−import qualified Fused.HTTPM as Fused
17−import qualified Simple.HTTPM as Simple
18−import qualified MTL.HTTPM as MTL
19−import qualified Shallow.HTTPM as Shallow
20−import qualified Poly.HTTPM as Poly
21−import qualified ExtEff.HTTPM as ExtEff
22−
23−#define MEMSUITE(nam,v) sequence_ [ Weigh.func "fused-effects" Fused.nam v \
24− , Weigh.func "mtl" MTL.nam v \
25− , Weigh.func "polysemy" Poly.nam v \
26− , Weigh.func "freer-simple" Simple.nam v \
27− , Weigh.func "extensible-effects" ExtEff.nam v \
28− , Weigh.func "shallow" Shallow.nam v ]
29−
30−#define SUITE(nam,v) [ bench "fused-effects" (nf Fused.nam v) \
31− , bench "mtl" (nf MTL.nam v) \
32− , bench "polysemy" (nf Poly.nam v) \
33− , bench "freer-simple" (nf Simple.nam v) \
34− , bench "extensible-effects" (nf ExtEff.nam v) \
35− , bench "shallow" (nf Shallow.nam v) ]
36−
3719wruns :: Int
3820wruns = 1
3921
4022runs :: Int
41−runs = 10000
23+runs = 100000
4224
4325main :: IO ()
4426main = do
4527 putStrLn "*** Time benchmarks ***"
4628 defaultMain
47− [
48− bgroup "Countdown"
49− [ bgroup "Put" SUITE(countDownPut, runs)
50− , bgroup "Put+Exc" SUITE(countDownExc, runs)
51− ]
52− , bgroup "HTTP"
53− [ bench "fused-effects" (nfAppIO Fused.doHTTP runs)
54− , bench "polysemy" (nfAppIO Poly.doHTTP runs)
55− , bench "extensible-effects" (nfAppIO ExtEff.doHTTP runs)
56− , bench "Deep embedding" (nfAppIO MTL.doHTTP runs)
57− , bench "Shallow embedding" (nfAppIO Shallow.doHTTP runs)
58− , bench "freer-simple" (nfAppIO Simple.doHTTP runs)
59− ]
29+ [ bgroup
30+ "Countdown"
31+ [ bgroup
32+ "Put"
33+ [ bench "fused-effects" (nf Fused.countDownBench runs),
34+ bench "mtl" (nf MTL.countDownBench runs),
35+ bench "polysemy" (nf Poly.countDownBench runs),
36+ bench "freer-simple" (nf Freer.countDownBench runs),
37+ bench "extensible-effects" (nf ExtEff.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)
41+ ],
42+ bgroup
43+ "Put+Exc"
44+ [ bench "fused-effects" (nf Fused.countDownExcBench runs),
45+ bench "mtl" (nf MTL.countDownExcBench runs),
46+ bench "polysemy" (nf Poly.countDownExcBench runs),
47+ bench "freer-simple" (nf Freer.countDownExcBench runs),
48+ bench "extensible-effects" (nf ExtEff.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)
52+ ]
53+ ],
54+ bgroup
55+ "HTTP"
56+ [ bench "fused-effects" (nfAppIO Fused.httpBench runs),
57+ bench "polysemy" (nfAppIO Poly.httpBench runs),
58+ bench "extensible-effects" (nfAppIO ExtEff.httpBench runs),
59+ bench "Deep embedding" (nfAppIO MTL.httpBench runs),
60+ bench "Shallow embedding" (nfAppIO Shallow.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)
64+ ]
6065 ]
6166
6267 putStrLn "*** Space benchmarks (these will take some time to run) ***"
6368 Weigh.mainWith $ do
64− Weigh.wgroup "Countdown" $ MEMSUITE(countDownPut, wruns)
65− Weigh.wgroup "Countdown + exc" $ MEMSUITE(countDownExc, wruns)
66−
69+ Weigh.wgroup "Countdown" $
70+ sequence_
71+ [ Weigh.func "fused-effects" Fused.countDownBench wruns,
72+ Weigh.func "mtl" MTL.countDownBench wruns,
73+ Weigh.func "polysemy" Poly.countDownBench wruns,
74+ Weigh.func "freer-simple" Freer.countDownBench wruns,
75+ Weigh.func "extensible-effects" ExtEff.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
79+ ]
80+ Weigh.wgroup "Countdown + exc" $
81+ sequence_
82+ [ Weigh.func "fused-effects" Fused.countDownExcBench wruns,
83+ Weigh.func "mtl" MTL.countDownExcBench wruns,
84+ Weigh.func "polysemy" Poly.countDownExcBench wruns,
85+ Weigh.func "freer-simple" Freer.countDownExcBench wruns,
86+ Weigh.func "extensible-effects" ExtEff.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
90+ ]
stack.yamlnew file+78
@@ -0,0 +1,78 @@
1+# This file was automatically generated by 'stack init'
2+#
3+# Some commonly used options have been documented as comments in this file.
4+# For advanced use and comprehensive documentation of the format, please see:
5+# https://docs.haskellstack.org/en/stable/yaml_configuration/
6+
7+# Resolver to choose a 'specific' stackage snapshot or a compiler version.
8+# A snapshot resolver dictates the compiler version and the set of packages
9+# to be used for project dependencies. For example:
10+#
11+# resolver: lts-3.5
12+# resolver: nightly-2015-09-21
13+# resolver: ghc-7.10.2
14+#
15+# The location of a snapshot can be provided as a file or url. Stack assumes
16+# a snapshot provided as a file might change, whereas a url resource does not.
17+#
18+# resolver: ./custom-snapshot.yaml
19+# resolver: https://example.com/snapshots/2018-01-01.yaml
20+resolver: lts-18.21
21+
22+# User packages to be built.
23+# Various formats can be used as shown in the example below.
24+#
25+# packages:
26+# - some-directory
27+# - https://example.com/foo/bar/baz-0.0.2.tar.gz
28+# subdirs:
29+# - auto-update
30+# - wai
31+packages:
32+ - .
33+# Dependency packages to be pulled from upstream that are not in the resolver.
34+# These entries can reference officially published versions as well as
35+# forks / in-progress versions pinned to a git hash. For example:
36+#
37+# extra-deps:
38+# - acme-missiles-0.3
39+# - git: https://github.com/commercialhaskell/stack.git
40+# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
41+#
42+extra-deps:
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+
51+# Override default flag values for local packages and extra-deps
52+# flags: {}
53+
54+# Extra package databases containing global packages
55+# extra-package-dbs: []
56+
57+# Control whether we use the GHC we find on the path
58+# system-ghc: true
59+#
60+# Require a specific version of stack, using version ranges
61+# require-stack-version: -any # Default
62+# require-stack-version: ">=2.3"
63+#
64+# Override the architecture used by stack, especially useful on Windows
65+# arch: i386
66+# arch: x86_64
67+#
68+# Extra directories used by stack for building
69+# extra-include-dirs: [/path/to/dir]
70+# extra-lib-dirs: [/path/to/dir]
71+#
72+# Allow a newer minor version of GHC than the snapshot specifies
73+# compiler-check: newer-minor
74+
75+ghc-options:
76+ "$everything": -O2
77+
78+rebuild-ghc-options: true