git.iko.soy/effects-benchmarks
on f50cd09 help sign in
c7e3543
swap
0 ahead, 19 behind
50 files changed+751−1109
since splitsnapshots
unifiedsplit
.gitignore−1 README.md−387 effects-benchmarks.cabal+82−78 instances/Effectful/Dynamic/Bench.hs−18 instances/Effectful/Dynamic/HTTP.hs−39 instances/Effectful/Dynamic/Stateful.hs−7 instances/Effectful/Dynamic/StatefulExcept.hs−10 instances/Effectful/Static/Bench.hs−17 instances/Effectful/Static/HTTP.hs−30 instances/Effectful/Static/Stateful.hs−7 instances/Effectful/Static/StatefulExcept.hs−10 instances/ExtEff/Bench.hs−22 instances/ExtEff/HTTP.hs+15−19 instances/ExtEff/Stateful.hs+14−3 instances/ExtEff/StatefulExcept.hs+16−3 instances/FSStateful.hs+18 instances/Freer/Bench.hs−22 instances/Freer/HTTP.hs+19−25 instances/Freer/Stateful.hs−7 instances/Freer/StatefulExcept.hs+16−5 instances/Fused/Bench.hs−21 instances/Fused/HTTP.hs+41−35 instances/Fused/Stateful.hs+14−3 instances/Fused/StatefulExcept.hs+17−4 instances/MTL/Bench.hs−21 instances/MTL/HTTP.hs+9−14 instances/MTL/Stateful.hs−6 instances/MTL/StatefulExcept.hs+17−4 instances/MTLStateful.hs+16 instances/PStateful.hs+17 instances/Poly/Bench.hs−22 instances/Poly/HTTP.hs+37−21 instances/Poly/Stateful.hs+13−3 instances/Poly/StatefulExcept.hs+16−4 instances/Shallow/Bench.hs−19 instances/Shallow/HTTP.hs+4−11 instances/Shallow/Stateful.hs+1−6 instances/Shallow/StatefulExcept.hs+6−12 package.yaml−37 src/Bench/Countdown.hs+14 src/Bench/HTTP.hs+11 src/Bench/Signature/HTTP.hsig+19 src/Bench/Signature/Stateful.hsig+17 src/Bench/Signature/StatefulExcept.hsig+17 src/FreerSimple.hs+73 src/HigherOrder.hs+76 src/JVEffects.hs+72 src/MTL.hs+27 src/Main.hs+37−78 stack.yaml−78
.gitignore−1
@@ -1,5 +1,4 @@
11.stack-work
22.DS_Store
33core-html/
4−dist
54dist-newstyle/
README.md−387
@@ -1,388 +1 @@
11# effects-benchmarks
2−
3−
4−## Results
5−
6−<details>
7−
8−<summary>Linux – Intel(R) Core(TM) i5-10210U CPU @ 1.60GHz</summary>
9−
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) ***
170−
171−Countdown
172−
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
182−
183−Countdown + exc
184−
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
194−```
195−
196−</details>
197−
198−<details>
199−
200−<summary>macOS – MacBook Pro (13-inch, 2018, Four Thunderbolt 3 Ports) – 2.3 GHz Quad-Core Intel Core i5</summary>
201−
202−```
203−*** Time benchmarks ***
204−benchmarked 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)
209−
210−benchmarked 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)
216−
217−benchmarked 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)
222−
223−benchmarked 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)
229−
230−benchmarked 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)
236−
237−benchmarked 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)
255−
256−benchmarked 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)
261−
262−benchmarked 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)
267−
268−benchmarked 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)
273−
274−benchmarked 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)
280−
281−benchmarked 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)
287−
288−benchmarked 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)
305−
306−benchmarked 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)
311−
312−benchmarked 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)
317−
318−benchmarked 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)
324−
325−benchmarked 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)
331−
332−benchmarking HTTP/Shallow embedding ... took 11.97 s, total 40147 iterations
333−benchmarked 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)
338−
339−benchmarked 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
386−```
387−
388−</details>
effects-benchmarks.cabal+82−78
@@ -1,82 +1,86 @@
1−cabal-version: 1.12
1+cabal-version: 2.2
2+name: effects-benchmarks
3+version: 0.1.0.0
4+homepage: https://github.com/patrickt/effects-benchmarks#readme
5+license: BSD-3-Clause
6+license-file: LICENSE
7+author: Author name here
8+maintainer: example@example.com
9+copyright: 2018 Author name here
10+category: Web
11+build-type: Simple
12+extra-source-files: README.md
213
3−-- This file has been generated from package.yaml by hpack version 0.34.4.
4−--
5−-- see: https://github.com/sol/hpack
14+common shared
15+ default-language: Haskell2010
16+ ghc-options: -Wall -Werror -O2
17+ build-depends: base >= 4.7 && < 5
618
7−name: effects-benchmarks
8−version: 0.0.0
9−license: BSD3
10−license-file: LICENSE
11−build-type: Simple
19+library benchmark-signatures
20+ import: shared
21+ hs-source-dirs: src
22+ signatures: Bench.Signature.Stateful
23+ , Bench.Signature.StatefulExcept
24+ , Bench.Signature.HTTP
25+ exposed-modules: Bench.Countdown
26+ , Bench.HTTP
27+
28+library instances-for-shallow
29+ import: shared
30+ hs-source-dirs: instances
31+ default-extensions: StrictData
32+ exposed-modules: Shallow.HTTP
33+ , Shallow.Stateful
34+ , Shallow.StatefulExcept
35+
36+library instances-for-mtl
37+ import: shared
38+ hs-source-dirs: instances
39+ exposed-modules: MTLStateful
40+ , MTL.StatefulExcept
41+ , MTL.HTTP
42+ build-depends: mtl ^>= 2.2.2
43+
44+library instances-for-fused-effects
45+ import: shared
46+ hs-source-dirs: instances
47+ exposed-modules: Fused.Stateful
48+ , Fused.StatefulExcept
49+ , Fused.HTTP
50+ build-depends: fused-effects >= 0.3.1.0
51+
52+library instances-for-freer-simple
53+ import: shared
54+ hs-source-dirs: instances
55+ exposed-modules: FSStateful
56+ , Freer.StatefulExcept
57+ , Freer.HTTP
58+ build-depends: freer-simple ^>= 1.2.1
59+
60+library instances-for-polysemy
61+ import: shared
62+ hs-source-dirs: instances
63+ exposed-modules: Poly.Stateful
64+ , Poly.StatefulExcept
65+ , Poly.HTTP
66+ build-depends: polysemy ^>= 0.1.2
1267
1368benchmark effects-benchmarks
14− type: exitcode-stdio-1.0
15− main-is: Main.hs
16− other-modules:
17− Effectful.Dynamic.Bench
18− Effectful.Dynamic.HTTP
19− Effectful.Dynamic.Stateful
20− Effectful.Dynamic.StatefulExcept
21− Effectful.Static.Bench
22− Effectful.Static.HTTP
23− Effectful.Static.Stateful
24− Effectful.Static.StatefulExcept
25− ExtEff.Bench
26− ExtEff.HTTP
27− ExtEff.Stateful
28− ExtEff.StatefulExcept
29− Freer.Bench
30− Freer.HTTP
31− Freer.Stateful
32− Freer.StatefulExcept
33− Fused.Bench
34− Fused.HTTP
35− Fused.Stateful
36− Fused.StatefulExcept
37− MTL.Bench
38− MTL.HTTP
39− MTL.Stateful
40− MTL.StatefulExcept
41− Poly.Bench
42− Poly.HTTP
43− Poly.Stateful
44− Poly.StatefulExcept
45− Shallow.Bench
46− Shallow.HTTP
47− Shallow.Stateful
48− Shallow.StatefulExcept
49− Paths_effects_benchmarks
50− hs-source-dirs:
51− instances
52− src
53− default-extensions:
54− DeriveAnyClass
55− DeriveFunctor
56− DeriveGeneric
57− DerivingStrategies
58− FlexibleInstances
59− GADTs
60− GeneralizedNewtypeDeriving
61− KindSignatures
62− MultiParamTypeClasses
63− TypeOperators
64− UndecidableInstances
65− DataKinds
66− FlexibleContexts
67− TypeApplications
68− LambdaCase
69− ScopedTypeVariables
70− DerivingStrategies
71− build-depends:
72− base
73− , effectful
74− , effectful-core
75− , extensible-effects
76− , freer-simple
77− , fused-effects
78− , gauge
79− , mtl
80− , polysemy
81− , weigh
82− default-language: Haskell2010
69+ import: shared
70+ type: exitcode-stdio-1.0
71+ hs-source-dirs: src
72+ build-depends: benchmark-signatures
73+ , instances-for-mtl
74+ , instances-for-fused-effects
75+ , instances-for-freer-simple
76+ , instances-for-polysemy
77+ , instances-for-shallow
78+ , dump-core
79+ , gauge
80+ , polysemy
81+ main-is: Main.hs
82+ mixins: benchmark-signatures (Bench.Countdown as MTL.Countdown, Bench.HTTP as MTL.HTTPM) requires (Bench.Signature.Stateful as MTLStateful, Bench.Signature.StatefulExcept as MTL.StatefulExcept, Bench.Signature.HTTP as MTL.HTTP)
83+ , benchmark-signatures (Bench.Countdown as Fused.Countdown, Bench.HTTP as Fused.HTTPM) requires (Bench.Signature.Stateful as Fused.Stateful, Bench.Signature.StatefulExcept as Fused.StatefulExcept, Bench.Signature.HTTP as Fused.HTTP)
84+ , benchmark-signatures (Bench.Countdown as Simple.Countdown, Bench.HTTP as Simple.HTTPM) requires (Bench.Signature.Stateful as FSStateful, Bench.Signature.StatefulExcept as Freer.StatefulExcept, Bench.Signature.HTTP as Freer.HTTP)
85+ , benchmark-signatures (Bench.Countdown as Shallow.Countdown, Bench.HTTP as Shallow.HTTPM) requires (Bench.Signature.Stateful as Shallow.Stateful, Bench.Signature.StatefulExcept as Shallow.StatefulExcept, Bench.Signature.HTTP as Shallow.HTTP)
86+ , benchmark-signatures (Bench.Countdown as Poly.Countdown, Bench.HTTP as Poly.HTTPM) requires (Bench.Signature.Stateful as Poly.Stateful, Bench.Signature.StatefulExcept as Poly.StatefulExcept, Bench.Signature.HTTP as Poly.HTTP)
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.hsdeleted−22
@@ -1,22 +0,0 @@
1−module ExtEff.Bench
2− ( countDownBench,
3− countDownExcBench,
4− httpBench,
5− )
6−where
7−
8−import Control.Eff
9−import Control.Eff.Exception
10−import Control.Eff.State.Strict
11−import ExtEff.HTTP
12−import ExtEff.Stateful
13−import ExtEff.StatefulExcept
14−
15−countDownBench :: Int -> (Int, Int)
16−countDownBench start = run . runState start $ countDownPut
17−
18−countDownExcBench :: Int -> Either String (Int, Int)
19−countDownExcBench start = run . runError . runState start $ countDownExc
20−
21−httpBench :: Int -> IO Int
22−httpBench n = runHttp (doHTTP n)
instances/ExtEff/HTTP.hs+15−19
@@ -1,44 +1,40 @@
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
78
9+type HttpM = Eff '[HTTP, Lift IO]
10+
811data HTTP a where
912 Open :: String -> HTTP ()
1013 Close :: HTTP ()
11− Post :: String -> HTTP String
12− HGet :: HTTP String
14+ Post :: String -> HTTP String
15+ HGet :: HTTP String
1316
14−open' :: Member HTTP e => String -> Eff e ()
15−open' = send . Open
17+open' :: String -> HttpM ()
18+open' = send . Open
1619
17−close' :: Member HTTP e => Eff e ()
20+close' :: HttpM ()
1821close' = send Close
1922
20−post' :: Member HTTP e => String -> Eff e String
23+post' :: String -> HttpM String
2124post' = send . Post
2225
23−get' :: Member HTTP e => Eff e String
26+get' :: HttpM String
2427get' = send HGet
2528
2629instance Handle HTTP r b (Eff e b) where
2730 handle h q req = case req of
2831 Open _s -> h (q ^$ ())
29− Close -> h (q ^$ ())
30− Post s -> h (q ^$ ("posted " <> s))
31− HGet -> h (q ^$ "contents")
32+ Close -> h (q ^$ ())
33+ Post s -> h (q ^$ ("posted " <> s))
34+ HGet -> h (q ^$ "contents")
3235
3336doHttp :: Eff (HTTP ': e) b -> Eff e b
3437doHttp = fix (handle_relay pure)
3538
36−runHttp :: Eff '[HTTP, Lift IO] a -> IO a
39+runHttp :: HttpM a -> IO a
3740runHttp = runLift . doHttp
38−
39−doHTTP :: Member HTTP e => Int -> Eff e Int
40−doHTTP n = do
41− open' "cats"
42− replicateM_ n (get' *> post' "cats")
43− close'
44− pure n
instances/ExtEff/Stateful.hs+14−3
@@ -1,7 +1,18 @@
1+{-# LANGUAGE DataKinds, TypeApplications #-}
2+
13module ExtEff.Stateful where
24
35import Control.Eff
4−import Control.Eff.State.Strict
6+import Control.Eff.State.Strict as State
7+import Data.Tuple
8+
9+type StateM = Eff '[State Int]
10+
11+get :: StateM Int
12+get = State.get @Int
13+
14+put :: Int -> StateM ()
15+put = State.put @Int
516
6−countDownPut :: Member (State Int) r => Eff r Int
7−countDownPut = get >>= (\n -> if n < 0 then pure n else put (n - 1) *> countDownPut)
17+runStateful :: Int -> StateM a -> (Int, a)
18+runStateful n x = swap . run $ State.runState n x
instances/ExtEff/StatefulExcept.hs+16−3
@@ -1,8 +1,21 @@
1+{-# LANGUAGE TypeApplications, DataKinds #-}
12module ExtEff.StatefulExcept where
23
34import Control.Eff
5+import Control.Eff.State.Strict as State
46import Control.Eff.Exception
5−import Control.Eff.State.Strict
7+import Data.Tuple
68
7−countDownExc :: (Member (State Int) r, Member (Exc String) r) => Eff r b
8−countDownExc = get @Int >>= (\n -> if n <= 0 then throwError "what" else put @Int (n - 1) *> countDownExc)
9+type StateM = Eff '[State Int, Exc String]
10+
11+get :: StateM Int
12+get = State.get @Int
13+
14+put :: Int -> StateM ()
15+put = State.put @Int
16+
17+throw :: String -> StateM a
18+throw = throwError
19+
20+runStatefulExcept :: Int -> StateM a -> Either String (Int, a)
21+runStatefulExcept n x = fmap swap . run . runError $ State.runState n x
instances/FSStateful.hsnew file+18
@@ -0,0 +1,18 @@
1+{-# LANGUAGE TypeApplications, DataKinds #-}
2+
3+module FSStateful where
4+
5+import Control.Monad.Freer
6+import Control.Monad.Freer.State as State
7+import Data.Tuple
8+
9+type StateM = Eff '[State Int]
10+
11+get :: StateM Int
12+get = State.get @Int
13+
14+put :: Int -> StateM ()
15+put = State.put @Int
16+
17+runStateful :: Int -> StateM a -> (Int, a)
18+runStateful n x = swap . run $ State.runState n x
instances/Freer/Bench.hsdeleted−22
@@ -1,22 +0,0 @@
1−module Freer.Bench
2− ( countDownBench,
3− countDownExcBench,
4− httpBench,
5− )
6−where
7−
8−import Control.Monad.Freer
9−import Control.Monad.Freer.Error
10−import Control.Monad.Freer.State
11−import Freer.HTTP
12−import Freer.Stateful
13−import Freer.StatefulExcept
14−
15−countDownBench :: Int -> (Int, Int)
16−countDownBench start = run . runState start $ countDownPut
17−
18−countDownExcBench :: Int -> Either String (Int, Int)
19−countDownExcBench start = run . runError . runState start $ countDownExc
20−
21−httpBench :: Int -> IO Int
22−httpBench n = runHttp (doHTTP n)
instances/Freer/HTTP.hs+19−25
@@ -1,42 +1,36 @@
1+{-# LANGUAGE DataKinds, TypeOperators, GADTs #-}
2+
13module Freer.HTTP where
24
3−import Control.Monad
45import Control.Monad.Freer
56
7+type HttpM = Eff '[HTTP, IO]
8+
69data HTTP a where
710 Open :: String -> HTTP ()
811 Close :: HTTP ()
9− Post :: String -> HTTP String
10− HGet :: HTTP String
12+ Post :: String -> HTTP String
13+ HGet :: HTTP String
1114
12−open' :: Member HTTP e => String -> Eff e ()
13−open' = send . Open
15+open' :: String -> HttpM ()
16+open' = send . Open
1417
15−close' :: Member HTTP e => Eff e ()
18+close' :: HttpM ()
1619close' = send Close
1720
18−post' :: Member HTTP e => String -> Eff e String
21+post' :: String -> HttpM String
1922post' = send . Post
2023
21−get' :: Member HTTP e => Eff e String
24+get' :: HttpM String
2225get' = send HGet
2326
2427doHttp :: 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
28+doHttp = interpret
29+ (\x -> case x of
30+ Open _ -> pure ()
31+ Close -> pure ()
32+ Post a -> pure ("posted" <> a)
33+ HGet -> pure "gotten")
34+
35+runHttp :: HttpM a -> IO a
3536runHttp = runM . doHttp
36−
37−doHTTP :: Member HTTP e => Int -> Eff e Int
38−doHTTP n = do
39− open' "cats"
40− replicateM_ n (get' *> post' "cats")
41− close'
42− pure n
instances/Freer/Stateful.hsdeleted−7
@@ -1,7 +0,0 @@
1−module Freer.Stateful where
2−
3−import Control.Monad.Freer
4−import Control.Monad.Freer.State as State
5−
6−countDownPut :: Member (State Int) r => Eff r Int
7−countDownPut = get >>= (\n -> if n < 0 then pure n else put (n - 1) *> countDownPut)
instances/Freer/StatefulExcept.hs+16−5
@@ -1,10 +1,21 @@
1+{-# LANGUAGE TypeApplications, DataKinds #-}
12module Freer.StatefulExcept where
23
34import Control.Monad.Freer
5+import Control.Monad.Freer.State as State
46import Control.Monad.Freer.Error
5−import Control.Monad.Freer.State
7+import Data.Tuple
68
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)
9+type StateM = Eff '[State Int, Error String]
10+
11+get :: StateM Int
12+get = State.get @Int
13+
14+put :: Int -> StateM ()
15+put = State.put @Int
16+
17+throw :: String -> StateM a
18+throw = throwError
19+
20+runStatefulExcept :: Int -> StateM a -> Either String (Int, a)
21+runStatefulExcept n x = fmap swap . run . runError $ State.runState n x
instances/Fused/Bench.hsdeleted−21
@@ -1,21 +0,0 @@
1−module Fused.Bench
2− ( countDownBench,
3− countDownExcBench,
4− httpBench,
5− )
6−where
7−
8−import Control.Carrier.Error.Either
9−import Control.Carrier.State.Strict
10−import Fused.HTTP
11−import Fused.Stateful
12−import Fused.StatefulExcept
13−
14−countDownBench :: Int -> (Int, Int)
15−countDownBench start = run . runState start $ countDownPut
16−
17−countDownExcBench :: Int -> Either String (Int, Int)
18−countDownExcBench start = run . runError . runState start $ countDownExc
19−
20−httpBench :: Int -> IO Int
21−httpBench n = runHttp (doHTTP n)
instances/Fused/HTTP.hs+41−35
@@ -1,47 +1,53 @@
1+{-# LANGUAGE TypeOperators, FlexibleInstances, KindSignatures, MultiParamTypeClasses, DeriveFunctor, UndecidableInstances, GeneralizedNewtypeDeriving #-}
2+
13module Fused.HTTP where
24
3−import Control.Algebra
4−import Control.Carrier.Lift
5−import Control.Monad
5+import Control.Effect
6+import Control.Effect.Sum
7+import Control.Effect.Carrier
8+import Data.Coerce
69import Control.Monad.IO.Class
7−import Data.Functor
8−import GHC.Generics (Generic1)
910
10−newtype HttpC m a = HttpC {runHttpC :: m a}
11− deriving newtype (Applicative, Functor, Monad, MonadIO)
11+newtype HttpC m a = HttpC { runHttpC :: m a }
12+ deriving (Applicative, Functor, Monad, MonadIO)
1213
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
14+data HTTP (m :: * -> *) k
15+ = Open String k
16+ | Close k
17+ | Post String (String -> k)
18+ | HGet (String -> k)
19+ deriving Functor
1820
19−open' :: Has HTTP sig m => String -> m ()
20−open' s = send (Open s)
21+instance Effect HTTP where
22+ handle state handler (Open s k) = Open s (handler . (<$ state) $ k)
23+ handle state handler (Close k) = Close (handler . (<$ state) $ k)
24+ handle state handler (Post s k) = Post s (handler . (<$ state) . k)
25+ handle state handler (HGet k) = HGet (handler . (<$ state) . k)
2126
22−close' :: Has HTTP sig m => m ()
23−close' = send Close
27+instance HFunctor HTTP where
28+ hmap _ = coerce
2429
25−post' :: Has HTTP sig m => String -> m String
26−post' s = send (Post s)
30+open' :: String -> HttpM ()
31+open' s = send (Open s (pure ()))
2732
28−get' :: Has HTTP sig m => m String
29−get' = send HGet
33+close' :: HttpM ()
34+close' = send (Close (pure ()))
3035
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)
36+post' :: String -> HttpM String
37+post' s = send (Post s pure)
3838
39−runHttp :: HttpC (LiftC IO) a -> IO a
40−runHttp = runM . runHttpC
39+get' :: HttpM String
40+get' = send (HGet pure)
41+
42+type HttpM = HttpC (LiftC IO)
4143
42−doHTTP :: Has HTTP sig m => Int -> m Int
43−doHTTP n = do
44− open' "cats"
45− replicateM_ n (get' *> post' "cats")
46− close'
47− pure n
44+instance (Effect sig, Carrier sig m) => Carrier (HTTP :+: sig) (HttpC m) where
45+ eff (L act) = case act of
46+ Open _ k -> k
47+ Close k -> k
48+ Post s k -> k ("posted " <> s)
49+ HGet k -> k "lmao"
50+ eff (R other) = HttpC (eff (handleCoercible other))
51+
52+runHttp :: HttpM a -> IO a
53+runHttp = runM . runHttpC
instances/Fused/Stateful.hs+14−3
@@ -1,6 +1,17 @@
1+{-# LANGUAGE TypeApplications #-}
2+
13module Fused.Stateful where
24
3−import Control.Effect.State
5+import Control.Effect (run, PureC)
6+import Control.Effect.State.Lazy as State
7+
8+type StateM = StateC Int PureC
9+
10+get :: StateM Int
11+get = State.get @Int
12+
13+put :: Int -> StateM ()
14+put = State.put @Int
415
5−countDownPut :: Has (State Int) sig m => m Int
6−countDownPut = get >>= (\n -> if n < 0 then pure n else put (n - 1) *> countDownPut)
16+runStateful :: Int -> StateM a -> (Int, a)
17+runStateful n x = run $ State.runState n x
instances/Fused/StatefulExcept.hs+17−4
@@ -1,8 +1,21 @@
1+{-# LANGUAGE TypeApplications #-}
2+
13module Fused.StatefulExcept where
24
5+import Control.Effect (run, PureC)
6+import Control.Effect.State.Strict as State
37import Control.Effect.Error
4−import Control.Effect.State
58
6−countDownExc :: (Has (State Int) sig m, Has (Error String) sig m) => m a
7−countDownExc =
8− get @Int >>= (\n -> if n <= 0 then throwError "what" else put @Int (n - 1) *> countDownExc)
9+type StateM = StateC Int (ErrorC String PureC)
10+
11+get :: StateM Int
12+get = State.get @Int
13+
14+put :: Int -> StateM ()
15+put = State.put @Int
16+
17+throw :: String -> StateM a
18+throw = throwError
19+
20+runStatefulExcept :: Int -> StateM a -> Either String (Int, a)
21+runStatefulExcept n x = run . runError $ State.runState n x
instances/MTL/Bench.hsdeleted−21
@@ -1,21 +0,0 @@
1−module MTL.Bench
2− ( countDownBench,
3− countDownExcBench,
4− httpBench,
5− )
6−where
7−
8−import Control.Monad.Except
9−import Control.Monad.State.Strict
10−import MTL.HTTP
11−import MTL.Stateful
12−import MTL.StatefulExcept
13−
14−countDownBench :: Int -> (Int, Int)
15−countDownBench start = flip runState start $ countDownPut
16−
17−countDownExcBench :: Int -> Either String (Int, Int)
18−countDownExcBench start = runExcept . flip runStateT start $ countDownExc
19−
20−httpBench :: Int -> IO Int
21−httpBench n = runHttp (doHTTP n)
instances/MTL/HTTP.hs+9−14
@@ -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,17 +38,10 @@ 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"
46−
47−doHTTP :: Int -> HttpM Int
48−doHTTP n = do
49− open' "cats"
50− replicateM_ n (get' *> post' "cats")
51− close'
52− pure n
44+ Open _ -> pure ()
45+ Shut -> pure ()
46+ Post s -> pure ("posted " <> s)
47+ HGet -> pure "lmap"
instances/MTL/Stateful.hsdeleted−6
@@ -1,6 +0,0 @@
1−module MTL.Stateful where
2−
3−import Control.Monad.State.Class
4−
5−countDownPut :: MonadState Int m => m Int
6−countDownPut = get >>= (\n -> if n < 0 then pure n else put (n - 1) *> countDownPut)
instances/MTL/StatefulExcept.hs+17−4
@@ -1,7 +1,20 @@
11module MTL.StatefulExcept where
22
3−import Control.Monad.Error.Class
4−import Control.Monad.State.Class
3+import qualified Control.Monad.State.Strict as MTL
4+import qualified Control.Monad.Except as MTL
5+import Data.Tuple
6+import Data.Functor.Identity
57
6−countDownExc :: (MonadState Int m, MonadError String m) => m a
7−countDownExc = get >>= (\n -> if n <= 0 then throwError "what" else put (n - 1) *> countDownExc)
8+type StateM = MTL.StateT Int (MTL.ExceptT String Identity)
9+
10+get :: StateM Int
11+get = MTL.get
12+
13+put :: Int -> StateM ()
14+put = MTL.put
15+
16+throw :: String -> StateM a
17+throw = MTL.throwError
18+
19+runStatefulExcept :: Int -> StateM a -> Either String (Int, a)
20+runStatefulExcept n x = fmap swap . MTL.runExcept $ MTL.runStateT x n
instances/MTLStateful.hsnew file+16
@@ -0,0 +1,16 @@
1+module MTLStateful where
2+
3+import qualified Control.Monad.State.Strict as MTL
4+import Data.Tuple
5+import Data.Functor.Identity
6+
7+type StateM = MTL.StateT Int Identity
8+
9+get :: StateM Int
10+get = MTL.get
11+
12+put :: Int -> StateM ()
13+put = MTL.put
14+
15+runStateful :: Int -> StateM a -> (Int, a)
16+runStateful n x = swap (MTL.runState x n)
instances/PStateful.hsnew file+17
@@ -0,0 +1,17 @@
1+{-# LANGUAGE TypeApplications, DataKinds #-}
2+
3+module PStateful where
4+
5+import Polysemy
6+import Polysemy.State as State
7+
8+type StateM = Sem '[State Int]
9+
10+get :: StateM Int
11+get = State.get
12+
13+put :: Int -> StateM ()
14+put = State.put
15+
16+runStateful :: Int -> StateM a -> (Int, a)
17+runStateful n x = run $ State.runState n x
instances/Poly/Bench.hsdeleted−22
@@ -1,22 +0,0 @@
1−module Poly.Bench
2− ( countDownBench,
3− countDownExcBench,
4− httpBench,
5− )
6−where
7−
8−import Poly.HTTP
9−import Poly.Stateful
10−import Poly.StatefulExcept
11−import Polysemy
12−import Polysemy.Error
13−import Polysemy.State
14−
15−countDownBench :: Int -> (Int, Int)
16−countDownBench start = run . runState start $ countDownPut
17−
18−countDownExcBench :: Int -> Either String (Int, Int)
19−countDownExcBench start = run . runError . runState start $ countDownExc
20−
21−httpBench :: Int -> IO Int
22−httpBench n = runHttp (doHTTP n)
instances/Poly/HTTP.hs+37−21
@@ -1,45 +1,61 @@
1−{-# LANGUAGE TemplateHaskell #-}
1+{-# LANGUAGE DataKinds, TemplateHaskell, KindSignatures, GADTs, FlexibleContexts, TypeOperators, LambdaCase #-}
22
33module Poly.HTTP where
44
5−import Control.Monad
65import Polysemy
76
8−type HttpM = Sem '[Http, Final IO]
7+type HttpM = Sem '[Http, Lift IO]
98
109data Http (m :: * -> *) a where
11− HOpen :: String -> Http m ()
10+ HOpen :: String -> Http m ()
1211 HClose :: Http m ()
13− HPost :: String -> Http m String
14− HGet :: Http m String
12+ HPost :: String -> Http m String
13+ HGet :: Http m String
1514
1615makeSem ''Http
1716
18−open' :: Member Http r => String -> Sem r ()
19−open' = hOpen
17+open' :: String -> HttpM ()
18+open' = hOpen
2019
21−close' :: Member Http r => Sem r ()
20+close' :: HttpM ()
2221close' = hClose
2322
24−post' :: Member Http r => String -> Sem r String
23+post' :: String -> HttpM String
2524post' = hPost
2625
27−get' :: Member Http r => Sem r String
26+get' :: HttpM String
2827get' = hGet
2928
3029runHttp' :: Sem (Http ': r) a -> Sem r a
3130runHttp' = interpret $ \case
3231 HOpen _ -> pure ()
33− HClose -> pure ()
32+ HClose -> pure ()
3433 HPost s -> pure ("posted " <> s)
35− HGet -> pure "contents"
34+ HGet -> pure "contents"
3635
3736runHttp :: HttpM a -> IO a
38−runHttp = runFinal . runHttp'
39−
40−doHTTP :: Member Http r => Int -> Sem r Int
41−doHTTP n = do
42− open' "cats"
43− replicateM_ n (get' *> post' "cats")
44− close'
45− pure n
37+runHttp = runM . runHttp'
38+
39+-- open' :: String -> HttpM ()
40+-- open' = send . Open
41+
42+-- close' :: HttpM ()
43+-- close' = send Close
44+
45+-- post' :: String -> HttpM String
46+-- post' = send . Post
47+
48+-- get' :: HttpM String
49+-- get' = send Get
50+
51+-- runHttp' :: Eff (Http ': r) w -> Eff r w
52+-- runHttp' (Val x) = pure x
53+-- runHttp' (E u q) = case decomp u of
54+-- Right (Open _) -> runHttp (qApp q ())
55+-- Right Close -> runHttp (qApp q ())
56+-- Right (Post d) -> runHttp (qApp q d)
57+-- Right Get -> runHttp (qApp q "")
58+-- Left u' -> E u' (tsingleton (runHttp . qApp q ))
59+
60+-- runHttp :: HttpM a -> IO a
61+-- runHttp = runM . runHttp'
instances/Poly/Stateful.hs+13−3
@@ -1,7 +1,17 @@
1+{-# LANGUAGE DataKinds, TypeApplications #-}
2+
13module Poly.Stateful where
24
35import Polysemy
4−import Polysemy.State
6+import Polysemy.State as State
7+
8+type StateM = Sem '[State Int]
9+
10+get :: StateM Int
11+get = State.get @Int
12+
13+put :: Int -> StateM ()
14+put = State.put @Int
515
6−countDownPut :: Member (State Int) r => Sem r Int
7−countDownPut = get >>= (\n -> if n < 0 then pure n else put (n - 1) *> countDownPut)
16+runStateful :: Int -> StateM a -> (Int, a)
17+runStateful n x = run $ State.runState n x
instances/Poly/StatefulExcept.hs+16−4
@@ -1,8 +1,20 @@
1+{-# LANGUAGE TypeApplications, DataKinds #-}
12module Poly.StatefulExcept where
23
34import Polysemy
4−import Polysemy.Error
5−import Polysemy.State
5+import Polysemy.State as State
6+import Polysemy.Error as Err
67
7−countDownExc :: (Member (State Int) r, Member (Error String) r) => Sem r a
8−countDownExc = get @Int >>= (\n -> if n <= 0 then throw "what" else put @Int (n - 1) *> countDownExc)
8+type StateM = Sem '[State Int, Error String]
9+
10+get :: StateM Int
11+get = State.get @Int
12+
13+put :: Int -> StateM ()
14+put = State.put @Int
15+
16+throw :: String -> StateM a
17+throw = Err.throw
18+
19+runStatefulExcept :: Int -> StateM a -> Either String (Int, a)
20+runStatefulExcept n x = run . runError $ State.runState n x
instances/Shallow/Bench.hsdeleted−19
@@ -1,19 +0,0 @@
1−module Shallow.Bench
2− ( countDownBench,
3− countDownExcBench,
4− httpBench,
5− )
6−where
7−
8−import Shallow.HTTP
9−import Shallow.Stateful
10−import Shallow.StatefulExcept
11−
12−countDownBench :: Int -> (Int, Int)
13−countDownBench = countDownPut
14−
15−countDownExcBench :: Int -> Either String (Int, Int)
16−countDownExcBench = countDownExc
17−
18−httpBench :: Int -> IO Int
19−httpBench = doHTTP
instances/Shallow/HTTP.hs+4−11
@@ -1,9 +1,9 @@
1−module Shallow.HTTP where
1+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
22
3−import Control.Monad
3+module Shallow.HTTP where
44
5−newtype HttpM a = HttpM {runHttp :: IO a}
6− deriving newtype (Applicative, Functor, Monad)
5+newtype HttpM a = HttpM { runHttp :: IO a}
6+ deriving (Applicative, Functor, Monad)
77
88get' :: HttpM String
99get' = pure "lmao"
@@ -16,10 +16,3 @@ close' = pure ()
1616
1717open' :: String -> HttpM ()
1818open' _ = pure ()
19−
20−doHTTP :: Int -> IO Int
21−doHTTP n = runHttp $ do
22− open' "cats"
23− replicateM_ n (get' *> post' "cats")
24− close'
25− pure n
instances/Shallow/Stateful.hs+1−6
@@ -2,7 +2,7 @@ module Shallow.Stateful where
22
33import Control.Monad
44
5−newtype StateM a = StateM {unStateM :: Int -> (Int, a)}
5+newtype StateM a = StateM { unStateM :: Int -> (Int, a) }
66
77instance Functor StateM where
88 fmap f (StateM a) = StateM (\n -> fmap f (a n))
@@ -22,8 +22,3 @@ put x = StateM (\_ -> (x, ()))
2222
2323runStateful :: Int -> StateM a -> (Int, a)
2424runStateful n (StateM f) = f $! n
25−
26−countDownPut :: Int -> (Int, Int)
27−countDownPut start = runStateful start go
28− where
29− go = get >>= (\n -> if n < 0 then pure n else put (n - 1) *> go)
instances/Shallow/StatefulExcept.hs+6−12
@@ -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))
@@ -30,8 +29,3 @@ throw s = StateM (\_ -> Left s)
3029
3130runStatefulExcept :: Int -> StateM a -> Either String (Int, a)
3231runStatefulExcept n (StateM f) = f $! n
33−
34−countDownExc :: Int -> Either String (Int, Int)
35−countDownExc start = runStatefulExcept start go
36− where
37− go = get >>= (\n -> if n <= 0 then throw "what" else put (n - 1) *> go)
package.yamldeleted−37
@@ -1,37 +0,0 @@
1−name: effects-benchmarks
2−
3−benchmarks:
4− effects-benchmarks:
5− main: Main.hs
6− dependencies:
7− - base
8− - polysemy
9− - freer-simple
10− - fused-effects
11− - mtl
12− - extensible-effects
13− - gauge
14− - weigh
15− - effectful
16− - effectful-core
17− source-dirs:
18− - instances
19− - src
20− default-extensions:
21− - DeriveAnyClass
22− - DeriveFunctor
23− - DeriveGeneric
24− - DerivingStrategies
25− - FlexibleInstances
26− - GADTs
27− - GeneralizedNewtypeDeriving
28− - KindSignatures
29− - MultiParamTypeClasses
30− - TypeOperators
31− - UndecidableInstances
32− - DataKinds
33− - FlexibleContexts
34− - TypeApplications
35− - LambdaCase
36− - ScopedTypeVariables
37− - DerivingStrategies
src/Bench/Countdown.hsnew file+14
@@ -0,0 +1,14 @@
1+{-# LANGUAGE FlexibleContexts #-}
2+
3+module Bench.Countdown where
4+
5+import qualified Bench.Signature.Stateful as S
6+import qualified Bench.Signature.StatefulExcept as SE
7+
8+countDownPut :: Int -> (Int, Int)
9+countDownPut start = S.runStateful start go where
10+ go = S.get >>= (\n -> if n < 0 then pure n else S.put (n - 1) *> go)
11+
12+countDownExc :: Int -> Either String (Int, Int)
13+countDownExc start = SE.runStatefulExcept start go where
14+ go = SE.get >>= (\n -> if n <= 0 then SE.throw "what" else SE.put (n - 1) *> go)
src/Bench/HTTP.hsnew file+11
@@ -0,0 +1,11 @@
1+module Bench.HTTP where
2+
3+import Bench.Signature.HTTP
4+import Control.Monad
5+
6+doHTTP :: Int -> IO Int
7+doHTTP n = runHttp $ do
8+ open' "cats"
9+ replicateM_ n (get' *> post' "cats")
10+ close'
11+ pure n
src/Bench/Signature/HTTP.hsignew file+19
@@ -0,0 +1,19 @@
1+signature Bench.Signature.HTTP
2+ ( HttpM
3+ , open'
4+ , close'
5+ , post'
6+ , get'
7+ , runHttp
8+ ) where
9+
10+data HttpM a
11+
12+instance Applicative HttpM
13+instance Monad HttpM
14+
15+open' :: String -> HttpM ()
16+get' :: HttpM String
17+post' :: String -> HttpM String
18+close' :: HttpM ()
19+runHttp :: HttpM a -> IO a
src/Bench/Signature/Stateful.hsignew file+17
@@ -0,0 +1,17 @@
1+{-# LANGUAGE KindSignatures #-}
2+signature Bench.Signature.Stateful
3+ ( StateM
4+ , get
5+ , put
6+ , runStateful
7+ ) where
8+
9+data StateM a
10+
11+instance Applicative StateM
12+instance Monad StateM
13+
14+get :: StateM Int
15+put :: Int -> StateM ()
16+runStateful :: Int -> StateM a -> (Int, a)
17+
src/Bench/Signature/StatefulExcept.hsignew file+17
@@ -0,0 +1,17 @@
1+signature Bench.Signature.StatefulExcept
2+ ( StateM
3+ , get
4+ , put
5+ , throw
6+ , runStatefulExcept
7+ ) where
8+
9+data StateM a
10+
11+instance Applicative StateM
12+instance Monad StateM
13+
14+get :: StateM Int
15+put :: Int -> StateM ()
16+throw :: String -> StateM a
17+runStatefulExcept :: Int -> StateM a -> Either String (Int, a)
src/FreerSimple.hsnew file+73
@@ -0,0 +1,73 @@
1+{-# LANGUAGE TypeOperators, GADTs, FlexibleContexts, DataKinds #-}
2+
3+module FreerSimple (marks) where
4+
5+import Control.Monad
6+import Control.Monad.Freer
7+import Control.Monad.Freer.State
8+import Control.Monad.Freer.Error
9+import Gauge
10+
11+data HTTP a where
12+ Open :: String -> HTTP ()
13+ Close :: HTTP ()
14+ Post :: String -> HTTP String
15+ HGet :: HTTP String
16+
17+open' :: Member HTTP r => String -> Eff r ()
18+open' = send . Open
19+
20+close' :: Member HTTP r => Eff r ()
21+close' = send Close
22+
23+post' :: Member HTTP r => String -> Eff r String
24+post' = send . Post
25+
26+get' :: Member HTTP r => Eff r String
27+get' = send HGet
28+
29+runHTTP :: Eff (HTTP ': e) b -> Eff e b
30+runHTTP = interpret
31+ (\x -> case x of
32+ Open _ -> pure ()
33+ Close -> pure ()
34+ Post a -> pure a
35+ HGet -> pure "gotten")
36+
37+prog :: Member HTTP r => Eff r ()
38+prog = open' "cats" >> get' >> post' "cats" >> close'
39+
40+p :: Member HTTP r => Int -> Eff r ()
41+p count = open' "cats" >> replicateM_ count (get' >> post' "cats") >> close'
42+
43+oneGet :: Int -> (Int, Int)
44+oneGet n = run (runState n get)
45+
46+countDown :: Int -> (Int,Int)
47+countDown start = run (runState start go)
48+ where go = get >>= (\n -> if n <= 0 then pure n else put (n-1) >> go)
49+
50+countDownExc :: Int -> Either String (Int,Int)
51+countDownExc start = run $ runError (runState start go)
52+ where go = get >>= (\n -> if n <= (0 :: Int) then throwError "wat" else put (n-1) >> go)
53+
54+-- prog :: (Monad m, Member HTTP sig, Carrier sig m) => m ()
55+-- prog = open' "cats" >> get' >> post' "cats" >> close'
56+
57+-- p :: (Monad m, Member HTTP sig, Carrier sig m) => Int -> m ()
58+-- p count = open' "cats" >> replicateM_ count (get' >> post' "cats") >> close'
59+
60+marks :: Benchmark
61+marks = bgroup "freer-simple"
62+ [ bgroup "State"
63+ [ bench "get" $ whnf oneGet 0
64+ , bench "countdown" $ whnf countDown 100
65+ ]
66+ , bgroup "State + Error"
67+ [ bench "countdownExc" $ whnf countDownExc 10000
68+ ]
69+ , bgroup "HTTP DSL"
70+ [ bench "simple" $ whnf (run . runHTTP) prog
71+ , bench "replicated" $ whnf (run . runHTTP . p) 100000
72+ ]
73+ ]
src/HigherOrder.hsnew file+76
@@ -0,0 +1,76 @@
1+{-# LANGUAGE DeriveFunctor, FlexibleContexts, FlexibleInstances, KindSignatures, MultiParamTypeClasses,
2+ TypeApplications, TypeOperators, UndecidableInstances #-}
3+
4+module HigherOrder (marks) where
5+
6+import Control.Effect
7+import Control.Monad
8+import Data.Coerce
9+import Gauge.Main
10+
11+data HTTP (m :: * -> *) k
12+ = Open String k
13+ | Close k
14+ | Post String (String -> k)
15+ | HGet (String -> k)
16+ deriving Functor
17+
18+instance HFunctor HTTP where
19+ hmap _ = coerce
20+
21+open' :: (Member HTTP sig, Carrier sig m) => String -> m ()
22+open' s = send (Open s (gen ()))
23+
24+close' :: (Member HTTP sig, Carrier sig m) => m ()
25+close' = send (Close (gen ()))
26+
27+post' :: (Member HTTP sig, Carrier sig m) => String -> m String
28+post' s = send (Post s gen)
29+
30+get' :: (Member HTTP sig, Carrier sig m) => m String
31+get' = send (HGet gen)
32+
33+newtype HTTPC m a = HTTPC { runHTTPC :: m a }
34+
35+instance (Carrier sig m) => Carrier (HTTP :+: sig) (HTTPC m) where
36+ gen = HTTPC . gen
37+ alg = algS \/ (HTTPC . alg . handlePure runHTTPC) where
38+ algS (Open _ k) = k
39+ algS (Close k) = k
40+ algS (Post s k) = k s
41+ algS (HGet k) = k ""
42+
43+runHTTP :: (Carrier sig m) => Eff (HTTPC m) a -> m a
44+runHTTP = runHTTPC . interpret
45+
46+oneGet :: Int -> (Int, Int)
47+oneGet n = run (runState n get)
48+
49+countDown :: Int -> (Int,Int)
50+countDown start = run (runState start go)
51+ where go = get >>= (\n -> if n <= 0 then pure n else put (n-1) >> go)
52+
53+countDownExc :: Int -> Either String (Int,Int)
54+countDownExc start = run $ runError (runState start go)
55+ where go = get >>= (\n -> if n <= (0 :: Int) then throwError "wat" else put (n-1) >> go)
56+
57+prog :: (Monad m, Member HTTP sig, Carrier sig m) => m ()
58+prog = open' "cats" >> get' >> post' "cats" >> close'
59+
60+p :: (Monad m, Member HTTP sig, Carrier sig m) => Int -> m ()
61+p count = open' "cats" >> replicateM_ count (get' >> post' "cats") >> close'
62+
63+marks :: Benchmark
64+marks = bgroup "higher-order-effects"
65+ [ bgroup "State"
66+ [ bench "get" $ whnf oneGet 0
67+ , bench "countdown" $ whnf countDown 100
68+ ]
69+ , bgroup "State + Error"
70+ [ bench "countdownExc" $ whnf countDownExc 10000
71+ ]
72+ , bgroup "HTTP DSL"
73+ [ bench "simple" $ whnf (run . runHTTP) prog
74+ , bench "replicated" $ whnf (run . runHTTP . p) 100000
75+ ]
76+ ]
src/JVEffects.hsnew file+72
@@ -0,0 +1,72 @@
1+{-# LANGUAGE TypeApplications, KindSignatures, TypeOperators, GADTs, FlexibleContexts, DataKinds #-}
2+
3+module JVEffects (marks) where
4+
5+import Control.Monad
6+import Control.Monad.Effect
7+import Control.Monad.Effect.Exception
8+import Control.Monad.Effect.State
9+import Gauge
10+
11+oneGet :: Int -> (Int, Int)
12+oneGet n = run @Eff (runState n get)
13+
14+countDown :: Int -> (Int,Int)
15+countDown start = run @Eff (runState start go)
16+ where go = get >>= (\n -> if n <= 0 then pure n else put (n-1) >> go)
17+
18+countDownExc :: Int -> Either String (Int,Int)
19+countDownExc start = run @Eff $ runError (runState start go)
20+ where go = get >>= (\n -> if n <= (0 :: Int) then throwError "wat" else put (n-1) >> go)
21+
22+data HTTP (m :: * -> *) out where
23+ Open :: String -> HTTP m ()
24+ Close :: HTTP m ()
25+ Post :: String -> HTTP m String
26+ HGet :: HTTP m String
27+
28+instance Effect HTTP where
29+ handleState _ _ _ = error "Rob said we didn't need this"
30+
31+instance PureEffect HTTP
32+
33+open' :: Member HTTP r => String -> Eff r ()
34+open' = send . Open
35+
36+close' :: Member HTTP r => Eff r ()
37+close' = send Close
38+
39+post' :: Member HTTP r => String -> Eff r String
40+post' = send . Post
41+
42+get' :: Member HTTP r => Eff r String
43+get' = send HGet
44+
45+runHTTP :: PureEffects e => Eff (HTTP ': e) b -> Eff e b
46+runHTTP = interpret
47+ (\x -> case x of
48+ Open _ -> pure ()
49+ Close -> pure ()
50+ Post a -> pure a
51+ HGet -> pure "gotten")
52+
53+prog :: Member HTTP r => Eff r ()
54+prog = open' "cats" >> get' >> post' "cats" >> close'
55+
56+p :: Member HTTP r => Int -> Eff r ()
57+p count = open' "cats" >> replicateM_ count (get' >> post' "cats") >> close'
58+
59+marks :: Benchmark
60+marks = bgroup "joshvera/effects"
61+ [ bgroup "State"
62+ [ bench "get" $ whnf oneGet 0
63+ , bench "countdown" $ whnf countDown 100
64+ ]
65+ , bgroup "State + Error"
66+ [ bench "countdownExc" $ whnf countDownExc 10000
67+ ]
68+ , bgroup "HTTP DSL"
69+ [ bench "simple" $ whnf (run . runHTTP) prog
70+ , bench "replicated" $ whnf (run . runHTTP . p) 100000
71+ ]
72+ ]
src/MTL.hsnew file+27
@@ -0,0 +1,27 @@
1+module MTL (marks) where
2+
3+import qualified Control.Monad.State as MTL
4+import qualified Control.Monad.Except as MTL
5+import Gauge
6+
7+oneGet :: Int -> (Int, Int)
8+oneGet = MTL.runState MTL.get
9+
10+countDown :: Int -> (Int,Int)
11+countDown = MTL.runState go
12+ where go = MTL.get >>= (\n -> if n <= 0 then pure n else MTL.put (n-1) >> go)
13+
14+countDownExc :: Int -> Either String (Int,Int)
15+countDownExc = MTL.runStateT go
16+ where go = MTL.get >>= (\n -> if n <= (0 :: Int) then MTL.throwError "wat" else MTL.put (n-1) >> go)
17+
18+marks :: Benchmark
19+marks = bgroup "MTL"
20+ [ bgroup "State"
21+ [ bench "get" $ whnf oneGet 0
22+ , bench "countdown" $ whnf countDown 100
23+ ]
24+ , bgroup "State + Error"
25+ [ bench "countdownExc" $ whnf countDownExc 10000
26+ ]
27+ ]
src/Main.hs+37−78
@@ -1,90 +1,49 @@
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)
14−import qualified MTL.Bench as MTL
15−import qualified Poly.Bench as Poly
16−import qualified Shallow.Bench as Shallow
17−import qualified Weigh
187
19−wruns :: Int
20−wruns = 1
8+import qualified Fused.Countdown as Fused
9+import qualified Simple.Countdown as Simple
10+import qualified Shallow.Countdown as Shallow
11+import qualified MTL.Countdown as MTL
12+import qualified Poly.Countdown as Poly
13+
14+import qualified Fused.HTTPM as Fused
15+import qualified Simple.HTTPM as Simple
16+import qualified MTL.HTTPM as MTL
17+import qualified Shallow.HTTPM as Shallow
18+import qualified Poly.HTTPM as Poly
19+
20+#define SUITE(nam,v) [ bench "fused-effects" (nf Fused.nam v) \
21+ , bench "mtl" (nf MTL.nam v) \
22+ , bench "polysemy" (nf Poly.nam v) \
23+ , bench "freer-simple" (nf Simple.nam v) \
24+ , bench "shallow" (nf Shallow.nam v) ]
2125
2226runs :: Int
23−runs = 100000
27+runs = 10000
2428
2529main :: IO ()
26−main = do
27− putStrLn "*** Time benchmarks ***"
28− 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)
64− ]
30+main = defaultMain
31+ [
32+ bgroup "Countdown"
33+ [ bgroup "Put" SUITE(countDownPut, runs)
34+ , bgroup "Put+Exc" SUITE(countDownExc, runs)
6535 ]
36+ , bgroup "HTTP"
37+ [ bench "fused-effects" (nfAppIO Fused.doHTTP runs)
38+ , bench "polysemy" (nfAppIO Poly.doHTTP runs)
39+ , bench "Deep embedding" (nfAppIO MTL.doHTTP runs)
40+ , bench "Shallow embedding" (nfAppIO Shallow.doHTTP runs)
41+ , bench "freer-simple" (nfAppIO Simple.doHTTP runs)
42+ ]
43+ ]
44+
45+bareDown :: Int -> (Int, Int)
46+bareDown st = if st <= 0 then (st, st) else bareDown (st - 1)
6647
67− putStrLn "*** Space benchmarks (these will take some time to run) ***"
68− 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− ]
48+bareDownExc :: Int -> Either String (Int, Int)
49+bareDownExc st = if st <= 0 then Left "what" else bareDownExc (st - 1)
stack.yamldeleted−78
@@ -1,78 +0,0 @@
1−# This file was automatically generated by 'stack init'
2−#
3−# Some commonly used options have been documented as comments in this file.
4−# For advanced use and comprehensive documentation of the format, please see:
5−# https://docs.haskellstack.org/en/stable/yaml_configuration/
6−
7−# Resolver to choose a 'specific' stackage snapshot or a compiler version.
8−# A snapshot resolver dictates the compiler version and the set of packages
9−# to be used for project dependencies. For example:
10−#
11−# resolver: lts-3.5
12−# resolver: nightly-2015-09-21
13−# resolver: ghc-7.10.2
14−#
15−# The location of a snapshot can be provided as a file or url. Stack assumes
16−# a snapshot provided as a file might change, whereas a url resource does not.
17−#
18−# resolver: ./custom-snapshot.yaml
19−# resolver: https://example.com/snapshots/2018-01-01.yaml
20−resolver: lts-18.21
21−
22−# User packages to be built.
23−# Various formats can be used as shown in the example below.
24−#
25−# packages:
26−# - some-directory
27−# - https://example.com/foo/bar/baz-0.0.2.tar.gz
28−# subdirs:
29−# - auto-update
30−# - wai
31−packages:
32− - .
33−# Dependency packages to be pulled from upstream that are not in the resolver.
34−# These entries can reference officially published versions as well as
35−# forks / in-progress versions pinned to a git hash. For example:
36−#
37−# extra-deps:
38−# - acme-missiles-0.3
39−# - git: https://github.com/commercialhaskell/stack.git
40−# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
41−#
42−extra-deps:
43− - fused-effects-1.1.1.1
44− - git: https://github.com/arybczak/effectful.git
45− commit: 0d0283948ddd3204f69cdc60871978efe21452ae
46− subdir: effectful
47− - git: https://github.com/arybczak/effectful.git
48− commit: 0d0283948ddd3204f69cdc60871978efe21452ae
49− subdir: effectful-core
50−
51−# Override default flag values for local packages and extra-deps
52−# flags: {}
53−
54−# Extra package databases containing global packages
55−# extra-package-dbs: []
56−
57−# Control whether we use the GHC we find on the path
58−# system-ghc: true
59−#
60−# Require a specific version of stack, using version ranges
61−# require-stack-version: -any # Default
62−# require-stack-version: ">=2.3"
63−#
64−# Override the architecture used by stack, especially useful on Windows
65−# arch: i386
66−# arch: x86_64
67−#
68−# Extra directories used by stack for building
69−# extra-include-dirs: [/path/to/dir]
70−# extra-lib-dirs: [/path/to/dir]
71−#
72−# Allow a newer minor version of GHC than the snapshot specifies
73−# compiler-check: newer-minor
74−
75−ghc-options:
76− "$everything": -O2
77−
78−rebuild-ghc-options: true