git.iko.soy/effects-benchmarks
on master help sign in
swap
c7e35434 ahead, 0 behind
38 files changed+753−294
since splitsnapshots
unifiedsplit
README.md+334−51 effects-benchmarks.cabal+29−1 hie.yaml−7 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+9−8 instances/ExtEff/HTTP.hs+13−17 instances/ExtEff/Stateful.hs−4 instances/ExtEff/StatefulExcept.hs+1−4 instances/Freer/Bench.hs+9−8 instances/Freer/HTTP.hs+19−21 instances/Freer/Stateful.hs−4 instances/Freer/StatefulExcept.hs+5−5 instances/Fused/Bench.hs+8−7 instances/Fused/HTTP.hs+26−32 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+13−13 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+20 src/Main.hs+68−50 stack.yaml+15−3
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 one to three orders of magnitude from `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+29−1
@@ -1,6 +1,6 @@
11cabal-version: 1.12
22
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
66
@@ -14,6 +14,14 @@ benchmark effects-benchmarks
1414 type: exitcode-stdio-1.0
1515 main-is: Main.hs
1616 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
1725 ExtEff.Bench
1826 ExtEff.HTTP
1927 ExtEff.Stateful
@@ -42,8 +50,28 @@ benchmark effects-benchmarks
4250 hs-source-dirs:
4351 instances
4452 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
4571 build-depends:
4672 base
73+ , effectful
74+ , effectful-core
4775 , extensible-effects
4876 , freer-simple
4977 , fused-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/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.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
67
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+13−17
@@ -1,46 +1,42 @@
1−{-# LANGUAGE DataKinds, TypeOperators, GADTs, FlexibleInstances, MultiParamTypeClasses #-}
2−
31module ExtEff.HTTP where
42
53import Control.Eff
64import Control.Eff.Extend
7−import Data.Function
85import Control.Monad
9−
10−type HttpM = Eff '[HTTP, Lift IO]
6+import Data.Function
117
128data HTTP a where
139 Open :: String -> HTTP ()
1410 Close :: HTTP ()
15− Post :: String -> HTTP String
16− HGet :: HTTP String
11+ Post :: String -> HTTP String
12+ HGet :: HTTP String
1713
18−open' :: String -> HttpM ()
19−open' = send . Open
14+open' :: Member HTTP e => String -> Eff e ()
15+open' = send . Open
2016
21−close' :: HttpM ()
17+close' :: Member HTTP e => Eff e ()
2218close' = send Close
2319
24−post' :: String -> HttpM String
20+post' :: Member HTTP e => String -> Eff e String
2521post' = send . Post
2622
27−get' :: HttpM String
23+get' :: Member HTTP e => Eff e String
2824get' = send HGet
2925
3026instance Handle HTTP r b (Eff e b) where
3127 handle h q req = case req of
3228 Open _s -> h (q ^$ ())
33− Close -> h (q ^$ ())
34− Post s -> h (q ^$ ("posted " <> s))
35− HGet -> h (q ^$ "contents")
29+ Close -> h (q ^$ ())
30+ Post s -> h (q ^$ ("posted " <> s))
31+ HGet -> h (q ^$ "contents")
3632
3733doHttp :: Eff (HTTP ': e) b -> Eff e b
3834doHttp = fix (handle_relay pure)
3935
40−runHttp :: HttpM a -> IO a
36+runHttp :: Eff '[HTTP, Lift IO] a -> IO a
4137runHttp = runLift . doHttp
4238
43−doHTTP :: Int -> Eff '[HTTP, Lift IO] Int
39+doHTTP :: Member HTTP e => Int -> Eff e Int
4440doHTTP n = do
4541 open' "cats"
4642 replicateM_ n (get' *> post' "cats")
instances/ExtEff/Stateful.hs−4
@@ -1,7 +1,3 @@
1−{-# LANGUAGE MonoLocalBinds #-}
2−{-# LANGUAGE FlexibleContexts #-}
3−{-# LANGUAGE DataKinds, TypeApplications #-}
4−
51module ExtEff.Stateful where
62
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
52
63import Control.Eff
7−import Control.Eff.State.Strict
84import Control.Eff.Exception
5+import Control.Eff.State.Strict
96
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
67
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+19−21
@@ -1,42 +1,40 @@
1−{-# LANGUAGE DataKinds, TypeOperators, GADTs #-}
2−
31module Freer.HTTP where
42
5−import Control.Monad.Freer
63import Control.Monad
7−
8−type HttpM = Eff '[HTTP, IO]
4+import Control.Monad.Freer
95
106data HTTP a where
117 Open :: String -> HTTP ()
128 Close :: HTTP ()
13− Post :: String -> HTTP String
14− HGet :: HTTP String
9+ Post :: String -> HTTP String
10+ HGet :: HTTP String
1511
16−open' :: String -> HttpM ()
17−open' = send . Open
12+open' :: Member HTTP e => String -> Eff e ()
13+open' = send . Open
1814
19−close' :: HttpM ()
15+close' :: Member HTTP e => Eff e ()
2016close' = send Close
2117
22−post' :: String -> HttpM String
18+post' :: Member HTTP e => String -> Eff e String
2319post' = send . Post
2420
25−get' :: HttpM String
21+get' :: Member HTTP e => Eff e String
2622get' = send HGet
2723
2824doHttp :: 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")
35−
36−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
3735runHttp = runM . doHttp
3836
39−doHTTP :: Int -> Eff '[HTTP, IO] Int
37+doHTTP :: Member HTTP e => Int -> Eff e Int
4038doHTTP n = do
4139 open' "cats"
4240 replicateM_ n (get' *> post' "cats")
instances/Freer/Stateful.hs−4
@@ -1,7 +1,3 @@
1−{-# LANGUAGE MonoLocalBinds #-}
2−{-# LANGUAGE FlexibleContexts #-}
3−{-# LANGUAGE TypeApplications, DataKinds #-}
4−
51module Freer.Stateful where
62
73import Control.Monad.Freer
instances/Freer/StatefulExcept.hs+5−5
@@ -1,10 +1,10 @@
1−{-# LANGUAGE TypeApplications, DataKinds #-}
21module Freer.StatefulExcept where
32
43import Control.Monad.Freer
5−import Control.Monad.Freer.State
64import Control.Monad.Freer.Error
5+import Control.Monad.Freer.State
76
8−countDownExc :: 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)
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.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
67
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+26−32
@@ -1,51 +1,45 @@
1−{-# LANGUAGE DeriveAnyClass, DeriveFunctor, DeriveGeneric, DerivingStrategies, FlexibleInstances, GeneralizedNewtypeDeriving,
2− KindSignatures, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}
3−
41module Fused.HTTP where
52
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)
22−
23−open' :: String -> HttpM ()
24−open' s = send (Open s (pure ()))
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
2518
26−close' :: HttpM ()
27−close' = send (Close (pure ()))
19+open' :: Has HTTP sig m => String -> m ()
20+open' s = send (Open s)
2821
29−post' :: String -> HttpM String
30−post' s = send (Post s pure)
22+close' :: Has HTTP sig m => m ()
23+close' = send Close
3124
32−get' :: HttpM String
33−get' = send (HGet pure)
25+post' :: Has HTTP sig m => String -> m String
26+post' s = send (Post s)
3427
35−type HttpM = HttpC (LiftC IO)
28+get' :: Has HTTP sig m => m String
29+get' = send HGet
3630
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))
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)
4438
45−runHttp :: HttpM a -> IO a
39+runHttp :: HttpC (LiftC IO) a -> IO a
4640runHttp = runM . runHttpC
4741
48−doHTTP :: Int -> HttpC (LiftC IO) Int
42+doHTTP :: Has HTTP sig m => Int -> m Int
4943doHTTP n = do
5044 open' "cats"
5145 replicateM_ n (get' *> post' "cats")
instances/Fused/Stateful.hs−2
@@ -1,5 +1,3 @@
1−{-# LANGUAGE TypeApplications #-}
2−
31module Fused.Stateful where
42
53import Control.Effect.State
instances/Fused/StatefulExcept.hs−4
@@ -1,12 +1,8 @@
1−{-# LANGUAGE TypeApplications #-}
2−
31module Fused.StatefulExcept where
42
5−
63import Control.Effect.Error
74import Control.Effect.State
85
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
67
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
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,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
32
43import Control.Monad.State.Class
instances/MTL/StatefulExcept.hs+1−2
@@ -1,8 +1,7 @@
1−{-# LANGUAGE FlexibleContexts #-}
21module MTL.StatefulExcept where
32
4−import Control.Monad.State.Class
53import Control.Monad.Error.Class
4+import Control.Monad.State.Class
65
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
67
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+13−13
@@ -1,43 +1,43 @@
1−{-# LANGUAGE ScopedTypeVariables, DataKinds, TemplateHaskell, KindSignatures, GADTs, FlexibleContexts, TypeOperators, LambdaCase #-}
1+{-# LANGUAGE TemplateHaskell #-}
22
33module Poly.HTTP where
44
5−import Polysemy
65import Control.Monad
6+import Polysemy
77
88type HttpM = Sem '[Http, Final IO]
99
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
18−open' :: String -> HttpM ()
19−open' = hOpen
18+open' :: Member Http r => String -> Sem r ()
19+open' = hOpen
2020
21−close' :: HttpM ()
21+close' :: Member Http r => Sem r ()
2222close' = hClose
2323
24−post' :: String -> HttpM String
24+post' :: Member Http r => String -> Sem r String
2525post' = hPost
2626
27−get' :: HttpM String
27+get' :: Member Http r => Sem r String
2828get' = hGet
2929
3030runHttp' :: Sem (Http ': r) a -> Sem r a
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'
3939
40−doHTTP :: Int -> Sem '[Http, Final IO] Int
40+doHTTP :: Member Http r => Int -> Sem r Int
4141doHTTP n = do
4242 open' "cats"
4343 replicateM_ n (get' *> post' "cats")
instances/Poly/Stateful.hs−4
@@ -1,7 +1,3 @@
1−{-# LANGUAGE GADTs #-}
2−{-# LANGUAGE FlexibleContexts #-}
3−{-# LANGUAGE DataKinds, TypeApplications #-}
4−
51module Poly.Stateful where
62
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
52
63import Polysemy
7−import Polysemy.State
84import Polysemy.Error
5+import Polysemy.State
96
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
67
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
42
53import Control.Monad
64
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)
97
108get' :: HttpM String
119get' = pure "lmao"
instances/Shallow/Stateful.hs+4−3
@@ -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))
@@ -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
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))
@@ -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+20
@@ -12,6 +12,26 @@ benchmarks:
1212 - extensible-effects
1313 - gauge
1414 - weigh
15+ - effectful
16+ - effectful-core
1517 source-dirs:
1618 - instances
1719 - 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/Main.hs+68−50
@@ -1,72 +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)
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
1214import qualified MTL.Bench as MTL
1315import qualified Poly.Bench as Poly
14−import qualified ExtEff.Bench as ExtEff
16+import qualified Shallow.Bench as Shallow
17+import qualified Weigh
1518
1619wruns :: Int
1720wruns = 1
1821
1922runs :: Int
20−runs = 10000
23+runs = 100000
2124
2225main :: IO ()
2326main = do
2427 putStrLn "*** Time benchmarks ***"
2528 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)
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)
3564 ]
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− ]
5365 ]
5466
5567 putStrLn "*** Space benchmarks (these will take some time to run) ***"
5668 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− ]
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.yaml+15−3
@@ -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,7 +39,14 @@ packages:
3939# - git: https://github.com/commercialhaskell/stack.git
4040# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
4141#
42−# extra-deps: []
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
4350
4451# Override default flag values for local packages and extra-deps
4552# flags: {}
@@ -64,3 +71,8 @@ packages:
6471#
6572# Allow a newer minor version of GHC than the snapshot specifies
6673# compiler-check: newer-minor
74+
75+ghc-options:
76+ "$everything": -O2
77+
78+rebuild-ghc-options: true