git.iko.soy/effects-benchmarks
on edf18f2 help sign in
c7e3543
swap
0 ahead, 4 behind
38 files changed+294−753
since splitsnapshots
unifiedsplit
README.md+51−334 effects-benchmarks.cabal+1−29 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+8−9 instances/ExtEff/HTTP.hs+17−13 instances/ExtEff/Stateful.hs+4 instances/ExtEff/StatefulExcept.hs+4−1 instances/Freer/Bench.hs+8−9 instances/Freer/HTTP.hs+21−19 instances/Freer/Stateful.hs+4 instances/Freer/StatefulExcept.hs+5−5 instances/Fused/Bench.hs+7−8 instances/Fused/HTTP.hs+32−26 instances/Fused/Stateful.hs+2 instances/Fused/StatefulExcept.hs+4 instances/MTL/Bench.hs+7−8 instances/MTL/HTTP.hs+9−7 instances/MTL/Stateful.hs+1 instances/MTL/StatefulExcept.hs+2−1 instances/Poly/Bench.hs+6−7 instances/Poly/HTTP.hs+13−13 instances/Poly/Stateful.hs+4 instances/Poly/StatefulExcept.hs+4−1 instances/Shallow/Bench.hs+5−6 instances/Shallow/HTTP.hs+4−2 instances/Shallow/Stateful.hs+3−4 instances/Shallow/StatefulExcept.hs+8−10 package.yaml−20 src/Main.hs+50−68 stack.yaml+3−15
README.md+51−334
@@ -1,388 +1,105 @@
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.
34
4−## Results
5+# tl;dr
56
6−<details>
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.
78
8−<summary>Linux – Intel(R) Core(TM) i5-10210U CPU @ 1.60GHz</summary>
9+# Full results
910
10−```
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) ***
11+On a 15-inch 2017 MacBook Pro (3.1GHz Intel i7, 16GB RAM), here are results for space benchmarks:
17012
13+```
17114Countdown
17215
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
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
18223
18324Countdown + exc
18425
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
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
19433```
19534
196−</details>
197−
198−<details>
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`.)
19936
200−<summary>macOS – MacBook Pro (13-inch, 2018, Four Thunderbolt 3 Ports) – 2.3 GHz Quad-Core Intel Core i5</summary>
37+Time (`State`-based countdown):
20138
20239```
203−*** Time benchmarks ***
20440benchmarked Countdown/Put/fused-effects
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)
41+time 5.692 μs (5.570 μs .. 5.835 μs)
20942
21043benchmarked Countdown/Put/mtl
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)
44+time 5.500 μs (5.386 μs .. 5.719 μs)
21645
21746benchmarked Countdown/Put/polysemy
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)
47+time 1.903 ms (1.845 ms .. 1.954 ms)
22248
22349benchmarked Countdown/Put/freer-simple
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)
50+time 1.324 ms (1.282 ms .. 1.361 ms)
22951
23052benchmarked Countdown/Put/extensible-effects
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)
53+time 1.383 ms (1.343 ms .. 1.422 ms)
23654
23755benchmarked Countdown/Put/shallow
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)
56+time 275.1 μs (270.1 μs .. 281.6 μs)
57+```
58+
59+Time (`State` + `Error` countdown):
25560
61+```
25662benchmarked Countdown/Put+Exc/fused-effects
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)
63+time 9.829 μs (9.645 μs .. 10.04 μs)
26164
26265benchmarked Countdown/Put+Exc/mtl
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)
66+time 9.968 μs (9.779 μs .. 10.15 μs)
26767
26868benchmarked Countdown/Put+Exc/polysemy
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)
69+time 418.1 μs (408.9 μs .. 427.1 μs)
27370
27471benchmarked Countdown/Put+Exc/freer-simple
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)
72+time 1.157 ms (1.120 ms .. 1.199 ms)
28073
28174benchmarked Countdown/Put+Exc/extensible-effects
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)
75+time 1.232 ms (1.212 ms .. 1.262 ms)
28776
28877benchmarked Countdown/Put+Exc/shallow
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)
78+time 55.12 μs (54.34 μs .. 56.29 μs)
79+```
80+
81+Time (custom HTTP DSL):
30582
83+```
30684benchmarked HTTP/fused-effects
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)
85+time 8.311 μs (8.060 μs .. 8.592 μs)
31186
31287benchmarked HTTP/polysemy
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)
88+time 14.99 ms (14.26 ms .. 15.80 ms)
31789
31890benchmarked HTTP/extensible-effects
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)
91+time 1.612 ms (1.578 ms .. 1.654 ms)
32492
32593benchmarked HTTP/Deep embedding
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)
94+time 2.027 ms (1.876 ms .. 2.184 ms)
33195
332−benchmarking HTTP/Shallow embedding ... took 11.97 s, total 40147 iterations
33396benchmarked HTTP/Shallow embedding
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)
97+time 15.94 μs (15.49 μs .. 16.46 μs)
33898
33999benchmarked HTTP/freer-simple
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
100+time 1.478 ms (1.443 ms .. 1.515 ms)
386101```
387102
388−</details>
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.
effects-benchmarks.cabal+1−29
@@ -1,6 +1,6 @@
11cabal-version: 1.12
22
3−-- This file has been generated from package.yaml by hpack version 0.34.4.
3+-- This file has been generated from package.yaml by hpack version 0.34.2.
44--
55-- see: https://github.com/sol/hpack
66
@@ -14,14 +14,6 @@ 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
2517 ExtEff.Bench
2618 ExtEff.HTTP
2719 ExtEff.Stateful
@@ -50,28 +42,8 @@ benchmark effects-benchmarks
5042 hs-source-dirs:
5143 instances
5244 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
7145 build-depends:
7246 base
73− , effectful
74− , effectful-core
7547 , extensible-effects
7648 , freer-simple
7749 , fused-effects
hie.yamlnew file+7
@@ -0,0 +1,7 @@
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.hsdeleted−18
@@ -1,18 +0,0 @@
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.hsdeleted−39
@@ -1,39 +0,0 @@
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.hsdeleted−7
@@ -1,7 +0,0 @@
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.hsdeleted−10
@@ -1,10 +0,0 @@
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.hsdeleted−17
@@ -1,17 +0,0 @@
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.hsdeleted−30
@@ -1,30 +0,0 @@
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.hsdeleted−7
@@ -1,7 +0,0 @@
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.hsdeleted−10
@@ -1,10 +0,0 @@
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+8−9
@@ -1,16 +1,15 @@
11module ExtEff.Bench
2− ( countDownBench,
3− countDownExcBench,
4− httpBench,
5− )
6−where
2+ ( countDownBench
3+ , countDownExcBench
4+ , httpBench
5+ ) where
76
8−import Control.Eff
9−import Control.Eff.Exception
10−import Control.Eff.State.Strict
11−import ExtEff.HTTP
127import ExtEff.Stateful
138import ExtEff.StatefulExcept
9+import ExtEff.HTTP
10+import Control.Eff.State.Strict
11+import Control.Eff.Exception
12+import Control.Eff
1413
1514countDownBench :: Int -> (Int, Int)
1615countDownBench start = run . runState start $ countDownPut
instances/ExtEff/HTTP.hs+17−13
@@ -1,42 +1,46 @@
1+{-# LANGUAGE DataKinds, TypeOperators, GADTs, FlexibleInstances, MultiParamTypeClasses #-}
2+
13module ExtEff.HTTP where
24
35import Control.Eff
46import Control.Eff.Extend
5−import Control.Monad
67import Data.Function
8+import Control.Monad
9+
10+type HttpM = Eff '[HTTP, Lift IO]
711
812data HTTP a where
913 Open :: String -> HTTP ()
1014 Close :: HTTP ()
11− Post :: String -> HTTP String
12− HGet :: HTTP String
15+ Post :: String -> HTTP String
16+ HGet :: HTTP String
1317
14−open' :: Member HTTP e => String -> Eff e ()
15−open' = send . Open
18+open' :: String -> HttpM ()
19+open' = send . Open
1620
17−close' :: Member HTTP e => Eff e ()
21+close' :: HttpM ()
1822close' = send Close
1923
20−post' :: Member HTTP e => String -> Eff e String
24+post' :: String -> HttpM String
2125post' = send . Post
2226
23−get' :: Member HTTP e => Eff e String
27+get' :: HttpM String
2428get' = send HGet
2529
2630instance Handle HTTP r b (Eff e b) where
2731 handle h q req = case req of
2832 Open _s -> h (q ^$ ())
29− Close -> h (q ^$ ())
30− Post s -> h (q ^$ ("posted " <> s))
31− HGet -> h (q ^$ "contents")
33+ Close -> h (q ^$ ())
34+ Post s -> h (q ^$ ("posted " <> s))
35+ HGet -> h (q ^$ "contents")
3236
3337doHttp :: Eff (HTTP ': e) b -> Eff e b
3438doHttp = fix (handle_relay pure)
3539
36−runHttp :: Eff '[HTTP, Lift IO] a -> IO a
40+runHttp :: HttpM a -> IO a
3741runHttp = runLift . doHttp
3842
39−doHTTP :: Member HTTP e => Int -> Eff e Int
43+doHTTP :: Int -> Eff '[HTTP, Lift IO] Int
4044doHTTP n = do
4145 open' "cats"
4246 replicateM_ n (get' *> post' "cats")
instances/ExtEff/Stateful.hs+4
@@ -1,3 +1,7 @@
1+{-# LANGUAGE MonoLocalBinds #-}
2+{-# LANGUAGE FlexibleContexts #-}
3+{-# LANGUAGE DataKinds, TypeApplications #-}
4+
15module ExtEff.Stateful where
26
37import Control.Eff
instances/ExtEff/StatefulExcept.hs+4−1
@@ -1,8 +1,11 @@
1+{-# LANGUAGE MonoLocalBinds #-}
2+{-# LANGUAGE FlexibleContexts #-}
3+{-# LANGUAGE TypeApplications, DataKinds #-}
14module ExtEff.StatefulExcept where
25
36import Control.Eff
4−import Control.Eff.Exception
57import Control.Eff.State.Strict
8+import Control.Eff.Exception
69
710countDownExc :: (Member (State Int) r, Member (Exc String) r) => Eff r b
811countDownExc = get @Int >>= (\n -> if n <= 0 then throwError "what" else put @Int (n - 1) *> countDownExc)
instances/Freer/Bench.hs+8−9
@@ -1,16 +1,15 @@
11module Freer.Bench
2− ( countDownBench,
3− countDownExcBench,
4− httpBench,
5− )
6−where
2+ ( countDownBench
3+ , countDownExcBench
4+ , httpBench
5+ ) where
76
8−import Control.Monad.Freer
9−import Control.Monad.Freer.Error
10−import Control.Monad.Freer.State
11−import Freer.HTTP
127import Freer.Stateful
138import Freer.StatefulExcept
9+import Freer.HTTP
10+import Control.Monad.Freer.State
11+import Control.Monad.Freer.Error
12+import Control.Monad.Freer
1413
1514countDownBench :: Int -> (Int, Int)
1615countDownBench start = run . runState start $ countDownPut
instances/Freer/HTTP.hs+21−19
@@ -1,40 +1,42 @@
1+{-# LANGUAGE DataKinds, TypeOperators, GADTs #-}
2+
13module Freer.HTTP where
24
3−import Control.Monad
45import Control.Monad.Freer
6+import Control.Monad
7+
8+type HttpM = Eff '[HTTP, IO]
59
610data HTTP a where
711 Open :: String -> HTTP ()
812 Close :: HTTP ()
9− Post :: String -> HTTP String
10− HGet :: HTTP String
13+ Post :: String -> HTTP String
14+ HGet :: HTTP String
1115
12−open' :: Member HTTP e => String -> Eff e ()
13−open' = send . Open
16+open' :: String -> HttpM ()
17+open' = send . Open
1418
15−close' :: Member HTTP e => Eff e ()
19+close' :: HttpM ()
1620close' = send Close
1721
18−post' :: Member HTTP e => String -> Eff e String
22+post' :: String -> HttpM String
1923post' = send . Post
2024
21−get' :: Member HTTP e => Eff e String
25+get' :: HttpM String
2226get' = send HGet
2327
2428doHttp :: Eff (HTTP ': e) b -> Eff e b
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
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
3537runHttp = runM . doHttp
3638
37−doHTTP :: Member HTTP e => Int -> Eff e Int
39+doHTTP :: Int -> Eff '[HTTP, IO] Int
3840doHTTP n = do
3941 open' "cats"
4042 replicateM_ n (get' *> post' "cats")
instances/Freer/Stateful.hs+4
@@ -1,3 +1,7 @@
1+{-# LANGUAGE MonoLocalBinds #-}
2+{-# LANGUAGE FlexibleContexts #-}
3+{-# LANGUAGE TypeApplications, DataKinds #-}
4+
15module Freer.Stateful where
26
37import Control.Monad.Freer
instances/Freer/StatefulExcept.hs+5−5
@@ -1,10 +1,10 @@
1+{-# LANGUAGE TypeApplications, DataKinds #-}
12module Freer.StatefulExcept where
23
34import Control.Monad.Freer
4−import Control.Monad.Freer.Error
55import Control.Monad.Freer.State
6+import Control.Monad.Freer.Error
67
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)
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)
instances/Fused/Bench.hs+7−8
@@ -1,15 +1,14 @@
11module Fused.Bench
2− ( countDownBench,
3− countDownExcBench,
4− httpBench,
5− )
6−where
2+ ( countDownBench
3+ , countDownExcBench
4+ , httpBench
5+ ) where
76
8−import Control.Carrier.Error.Either
9−import Control.Carrier.State.Strict
10−import Fused.HTTP
117import Fused.Stateful
128import Fused.StatefulExcept
9+import Fused.HTTP
10+import Control.Carrier.State.Strict
11+import Control.Carrier.Error.Either
1312
1413countDownBench :: Int -> (Int, Int)
1514countDownBench start = run . runState start $ countDownPut
instances/Fused/HTTP.hs+32−26
@@ -1,45 +1,51 @@
1+{-# LANGUAGE DeriveAnyClass, DeriveFunctor, DeriveGeneric, DerivingStrategies, FlexibleInstances, GeneralizedNewtypeDeriving,
2+ KindSignatures, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}
3+
14module Fused.HTTP where
25
36import Control.Algebra
4−import Control.Carrier.Lift
5−import Control.Monad
67import Control.Monad.IO.Class
7−import Data.Functor
88import GHC.Generics (Generic1)
9+import Control.Carrier.Lift
10+import Control.Monad
911
10−newtype HttpC m a = HttpC {runHttpC :: m a}
12+newtype HttpC m a = HttpC { runHttpC :: m a }
1113 deriving newtype (Applicative, Functor, Monad, MonadIO)
1214
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
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 ()))
1825
19−open' :: Has HTTP sig m => String -> m ()
20−open' s = send (Open s)
26+close' :: HttpM ()
27+close' = send (Close (pure ()))
2128
22−close' :: Has HTTP sig m => m ()
23−close' = send Close
29+post' :: String -> HttpM String
30+post' s = send (Post s pure)
2431
25−post' :: Has HTTP sig m => String -> m String
26−post' s = send (Post s)
32+get' :: HttpM String
33+get' = send (HGet pure)
2734
28−get' :: Has HTTP sig m => m String
29−get' = send HGet
35+type HttpM = HttpC (LiftC IO)
3036
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)
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))
3844
39−runHttp :: HttpC (LiftC IO) a -> IO a
45+runHttp :: HttpM a -> IO a
4046runHttp = runM . runHttpC
4147
42−doHTTP :: Has HTTP sig m => Int -> m Int
48+doHTTP :: Int -> HttpC (LiftC IO) Int
4349doHTTP n = do
4450 open' "cats"
4551 replicateM_ n (get' *> post' "cats")
instances/Fused/Stateful.hs+2
@@ -1,3 +1,5 @@
1+{-# LANGUAGE TypeApplications #-}
2+
13module Fused.Stateful where
24
35import Control.Effect.State
instances/Fused/StatefulExcept.hs+4
@@ -1,8 +1,12 @@
1+{-# LANGUAGE TypeApplications #-}
2+
13module Fused.StatefulExcept where
24
5+
36import Control.Effect.Error
47import Control.Effect.State
58
9+
610countDownExc :: (Has (State Int) sig m, Has (Error String) sig m) => m a
711countDownExc =
812 get @Int >>= (\n -> if n <= 0 then throwError "what" else put @Int (n - 1) *> countDownExc)
instances/MTL/Bench.hs+7−8
@@ -1,15 +1,14 @@
11module MTL.Bench
2− ( countDownBench,
3− countDownExcBench,
4− httpBench,
5− )
6−where
2+ ( countDownBench
3+ , countDownExcBench
4+ , httpBench
5+ ) where
76
8−import Control.Monad.Except
9−import Control.Monad.State.Strict
10−import MTL.HTTP
117import MTL.Stateful
128import MTL.StatefulExcept
9+import MTL.HTTP
10+import Control.Monad.State.Strict
11+import Control.Monad.Except
1312
1413countDownBench :: Int -> (Int, Int)
1514countDownBench start = flip runState start $ countDownPut
instances/MTL/HTTP.hs+9−7
@@ -1,3 +1,5 @@
1+{-# LANGUAGE GADTs, LambdaCase #-}
2+
13module MTL.HTTP where
24
35import Control.Applicative
@@ -16,7 +18,7 @@ instance Functor HttpM where
1618 fmap = liftA
1719
1820instance Applicative HttpM where
19− pure = Pure
21+ pure = Pure
2022 (<*>) = ap
2123
2224instance Monad HttpM where
@@ -36,13 +38,13 @@ open' = Open
3638
3739runHttp :: HttpM a -> IO a
3840runHttp = \case
39− Pure x -> pure x
40− Lift m -> m
41+ Pure x -> pure x
42+ Lift m -> m
4143 Then x f -> runHttp x >>= runHttp . f
42− Open _ -> pure ()
43− Shut -> pure ()
44− Post s -> pure ("posted " <> s)
45− HGet -> pure "lmap"
44+ Open _ -> pure ()
45+ Shut -> pure ()
46+ Post s -> pure ("posted " <> s)
47+ HGet -> pure "lmap"
4648
4749doHTTP :: Int -> HttpM Int
4850doHTTP n = do
instances/MTL/Stateful.hs+1
@@ -1,3 +1,4 @@
1+{-# LANGUAGE FlexibleContexts #-}
12module MTL.Stateful where
23
34import Control.Monad.State.Class
instances/MTL/StatefulExcept.hs+2−1
@@ -1,7 +1,8 @@
1+{-# LANGUAGE FlexibleContexts #-}
12module MTL.StatefulExcept where
23
3−import Control.Monad.Error.Class
44import Control.Monad.State.Class
5+import Control.Monad.Error.Class
56
67countDownExc :: (MonadState Int m, MonadError String m) => m a
78countDownExc = get >>= (\n -> if n <= 0 then throwError "what" else put (n - 1) *> countDownExc)
instances/Poly/Bench.hs+6−7
@@ -1,16 +1,15 @@
11module Poly.Bench
2− ( countDownBench,
3− countDownExcBench,
4− httpBench,
5− )
6−where
2+ ( countDownBench
3+ , countDownExcBench
4+ , httpBench
5+ ) where
76
8−import Poly.HTTP
97import Poly.Stateful
108import Poly.StatefulExcept
9+import Poly.HTTP
10+import Polysemy.State
1111import Polysemy
1212import Polysemy.Error
13−import Polysemy.State
1413
1514countDownBench :: Int -> (Int, Int)
1615countDownBench start = run . runState start $ countDownPut
instances/Poly/HTTP.hs+13−13
@@ -1,43 +1,43 @@
1−{-# LANGUAGE TemplateHaskell #-}
1+{-# LANGUAGE ScopedTypeVariables, DataKinds, TemplateHaskell, KindSignatures, GADTs, FlexibleContexts, TypeOperators, LambdaCase #-}
22
33module Poly.HTTP where
44
5−import Control.Monad
65import Polysemy
6+import Control.Monad
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' :: Member Http r => String -> Sem r ()
19−open' = hOpen
18+open' :: String -> HttpM ()
19+open' = hOpen
2020
21−close' :: Member Http r => Sem r ()
21+close' :: HttpM ()
2222close' = hClose
2323
24−post' :: Member Http r => String -> Sem r String
24+post' :: String -> HttpM String
2525post' = hPost
2626
27−get' :: Member Http r => Sem r String
27+get' :: HttpM 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 :: Member Http r => Int -> Sem r Int
40+doHTTP :: Int -> Sem '[Http, Final IO] Int
4141doHTTP n = do
4242 open' "cats"
4343 replicateM_ n (get' *> post' "cats")
instances/Poly/Stateful.hs+4
@@ -1,3 +1,7 @@
1+{-# LANGUAGE GADTs #-}
2+{-# LANGUAGE FlexibleContexts #-}
3+{-# LANGUAGE DataKinds, TypeApplications #-}
4+
15module Poly.Stateful where
26
37import Polysemy
instances/Poly/StatefulExcept.hs+4−1
@@ -1,8 +1,11 @@
1+{-# LANGUAGE GADTs #-}
2+{-# LANGUAGE FlexibleContexts #-}
3+{-# LANGUAGE TypeApplications, DataKinds #-}
14module Poly.StatefulExcept where
25
36import Polysemy
4−import Polysemy.Error
57import Polysemy.State
8+import Polysemy.Error
69
710countDownExc :: (Member (State Int) r, Member (Error String) r) => Sem r a
811countDownExc = get @Int >>= (\n -> if n <= 0 then throw "what" else put @Int (n - 1) *> countDownExc)
instances/Shallow/Bench.hs+5−6
@@ -1,13 +1,12 @@
11module Shallow.Bench
2− ( countDownBench,
3− countDownExcBench,
4− httpBench,
5− )
6−where
2+ ( countDownBench
3+ , countDownExcBench
4+ , httpBench
5+ ) where
76
8−import Shallow.HTTP
97import Shallow.Stateful
108import Shallow.StatefulExcept
9+import Shallow.HTTP
1110
1211countDownBench :: Int -> (Int, Int)
1312countDownBench = countDownPut
instances/Shallow/HTTP.hs+4−2
@@ -1,9 +1,11 @@
1+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2+
13module Shallow.HTTP where
24
35import Control.Monad
46
5−newtype HttpM a = HttpM {runHttp :: IO a}
6− deriving newtype (Applicative, Functor, Monad)
7+newtype HttpM a = HttpM { runHttp :: IO a}
8+ deriving (Applicative, Functor, Monad)
79
810get' :: HttpM String
911get' = pure "lmao"
instances/Shallow/Stateful.hs+3−4
@@ -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,6 +24,5 @@ runStateful :: Int -> StateM a -> (Int, a)
2424runStateful n (StateM f) = f $! n
2525
2626countDownPut :: 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)
27+countDownPut start = runStateful start go where
28+ go = get >>= (\n -> if n < 0 then pure n else put (n - 1) *> go)
instances/Shallow/StatefulExcept.hs+8−10
@@ -1,8 +1,10 @@
1+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2+
13module Shallow.StatefulExcept where
24
35import Control.Monad
46
5−newtype StateM a = StateM {unStateM :: Int -> Either String (Int, a)}
7+newtype StateM a = StateM { unStateM :: Int -> Either String (Int, a) }
68
79instance Functor StateM where
810 fmap f (StateM a) = StateM (\n -> fmap (fmap f) (a n))
@@ -12,12 +14,9 @@ instance Applicative StateM where
1214 (<*>) = ap
1315
1416instance Monad StateM where
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− )
17+ (StateM a) >>= f = StateM (\n -> case a n of
18+ Left s -> Left s
19+ Right (n', x) -> unStateM (f x) n')
2120
2221get :: StateM Int
2322get = StateM (\n -> Right (n, n))
@@ -32,6 +31,5 @@ runStatefulExcept :: Int -> StateM a -> Either String (Int, a)
3231runStatefulExcept n (StateM f) = f $! n
3332
3433countDownExc :: 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)
34+countDownExc start = runStatefulExcept start go where
35+ go = get >>= (\n -> if n <= 0 then throw "what" else put (n - 1) *> go)
package.yaml−20
@@ -12,26 +12,6 @@ benchmarks:
1212 - extensible-effects
1313 - gauge
1414 - weigh
15− - effectful
16− - effectful-core
1715 source-dirs:
1816 - instances
1917 - 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+50−68
@@ -1,90 +1,72 @@
1−{-# LANGUAGE CPP #-}
2−{-# LANGUAGE FlexibleContexts #-}
3−{-# LANGUAGE GADTs #-}
1+{-# LANGUAGE FlexibleContexts, GADTs, CPP #-}
42
53module Main where
64
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
125import Gauge (bench, bgroup, nf, nfAppIO)
136import 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
1412import qualified MTL.Bench as MTL
1513import qualified Poly.Bench as Poly
16−import qualified Shallow.Bench as Shallow
17−import qualified Weigh
14+import qualified ExtEff.Bench as ExtEff
1815
1916wruns :: Int
2017wruns = 1
2118
2219runs :: Int
23−runs = 100000
20+runs = 10000
2421
2522main :: IO ()
2623main = do
2724 putStrLn "*** Time benchmarks ***"
2825 defaultMain
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)
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)
6435 ]
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+ ]
6553 ]
6654
6755 putStrLn "*** Space benchmarks (these will take some time to run) ***"
6856 Weigh.mainWith $ do
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− ]
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+ ]
stack.yaml+3−15
@@ -17,7 +17,7 @@
1717#
1818# resolver: ./custom-snapshot.yaml
1919# resolver: https://example.com/snapshots/2018-01-01.yaml
20−resolver: lts-18.21
20+resolver: lts-16.18
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-18.21
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,14 +39,7 @@ packages:
3939# - git: https://github.com/commercialhaskell/stack.git
4040# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
4141#
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
42+# extra-deps: []
5043
5144# Override default flag values for local packages and extra-deps
5245# flags: {}
@@ -71,8 +64,3 @@ extra-deps:
7164#
7265# Allow a newer minor version of GHC than the snapshot specifies
7366# compiler-check: newer-minor
74−
75−ghc-options:
76− "$everything": -O2
77−
78−rebuild-ghc-options: true