git.iko.soy/effects-benchmarks
on f50cd09 help sign in
c7e3543
swap
0 ahead, 19 behind
.gitignore−1
since splitsnapshots
unifiedsplit
@@ -1,5 +1,4 @@
1.stack-work
1.stack-work
2.DS_Store
2.DS_Store
3core-html/
3core-html/
4−dist
5dist-newstyle/
4dist-newstyle/
README.md−387
@@ -1,388 +1 @@
1# effects-benchmarks
1# 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
2
13
3−-- This file has been generated from package.yaml by hpack version 0.34.4.
14+common shared
4−--
15+ default-language: Haskell2010
5−-- see: https://github.com/sol/hpack
16+ ghc-options: -Wall -Werror -O2
17+ build-depends: base >= 4.7 && < 5
6
18
7−name: effects-benchmarks
19+library benchmark-signatures
8−version: 0.0.0
20+ import: shared
9−license: BSD3
21+ hs-source-dirs: src
10−license-file: LICENSE
22+ signatures: Bench.Signature.Stateful
11−build-type: Simple
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
12
67
13benchmark effects-benchmarks
68benchmark effects-benchmarks
69+ import: shared
14− type: exitcode-stdio-1.0
70+ 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:
71+ hs-source-dirs: src
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+ build-depends: benchmark-signatures
72− base
73+ , instances-for-mtl
73− , effectful
74+ , instances-for-fused-effects
74− , effectful-core
75− , extensible-effects
76− , freer-simple
75+ , instances-for-freer-simple
77− , fused-effects
76+ , instances-for-polysemy
77+ , instances-for-shallow
78+ , dump-core
78− , gauge
79+ , gauge
79− , mtl
80+ , polysemy
80− , polysemy
81+ main-is: Main.hs
81− , weigh
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)
82− default-language: Haskell2010
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+
1module ExtEff.HTTP where
3module ExtEff.HTTP where
2
4
3import Control.Eff
5import Control.Eff
4import Control.Eff.Extend
6import Control.Eff.Extend
5−import Control.Monad
6import Data.Function
7import Data.Function
7
8
9+type HttpM = Eff '[HTTP, Lift IO]
10+
8data HTTP a where
11data HTTP a where
9 Open :: String -> HTTP ()
12 Open :: String -> HTTP ()
10 Close :: HTTP ()
13 Close :: HTTP ()
11− Post :: String -> HTTP String
14+ Post :: String -> HTTP String
12− HGet :: HTTP String
15+ HGet :: HTTP String
13
16
14−open' :: Member HTTP e => String -> Eff e ()
17+open' :: String -> HttpM ()
15−open' = send . Open
18+open' = send . Open
16
19
17−close' :: Member HTTP e => Eff e ()
20+close' :: HttpM ()
18close' = send Close
21close' = send Close
19
22
20−post' :: Member HTTP e => String -> Eff e String
23+post' :: String -> HttpM String
21post' = send . Post
24post' = send . Post
22
25
23−get' :: Member HTTP e => Eff e String
26+get' :: HttpM String
24get' = send HGet
27get' = send HGet
25
28
26instance Handle HTTP r b (Eff e b) where
29instance Handle HTTP r b (Eff e b) where
27 handle h q req = case req of
30 handle h q req = case req of
28 Open _s -> h (q ^$ ())
31 Open _s -> h (q ^$ ())
29− Close -> h (q ^$ ())
32+ Close -> h (q ^$ ())
30− Post s -> h (q ^$ ("posted " <> s))
33+ Post s -> h (q ^$ ("posted " <> s))
31− HGet -> h (q ^$ "contents")
34+ HGet -> h (q ^$ "contents")
32
35
33doHttp :: Eff (HTTP ': e) b -> Eff e b
36doHttp :: Eff (HTTP ': e) b -> Eff e b
34doHttp = fix (handle_relay pure)
37doHttp = fix (handle_relay pure)
35
38
36−runHttp :: Eff '[HTTP, Lift IO] a -> IO a
39+runHttp :: HttpM a -> IO a
37runHttp = runLift . doHttp
40runHttp = 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+
1module ExtEff.Stateful where
3module ExtEff.Stateful where
2
4
3import Control.Eff
5import 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
5
16
6−countDownPut :: Member (State Int) r => Eff r Int
17+runStateful :: Int -> StateM a -> (Int, a)
7−countDownPut = get >>= (\n -> if n < 0 then pure n else put (n - 1) *> countDownPut)
18+runStateful n x = swap . run $ State.runState n x
instances/ExtEff/StatefulExcept.hs+16−3
@@ -1,8 +1,21 @@
1+{-# LANGUAGE TypeApplications, DataKinds #-}
1module ExtEff.StatefulExcept where
2module ExtEff.StatefulExcept where
2
3
3import Control.Eff
4import Control.Eff
5+import Control.Eff.State.Strict as State
4import Control.Eff.Exception
6import Control.Eff.Exception
5−import Control.Eff.State.Strict
7+import Data.Tuple
6
8
7−countDownExc :: (Member (State Int) r, Member (Exc String) r) => Eff r b
9+type StateM = Eff '[State Int, Exc String]
8−countDownExc = get @Int >>= (\n -> if n <= 0 then throwError "what" else put @Int (n - 1) *> countDownExc)
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+
1module Freer.HTTP where
3module Freer.HTTP where
2
4
3−import Control.Monad
4import Control.Monad.Freer
5import Control.Monad.Freer
5
6
7+type HttpM = Eff '[HTTP, IO]
8+
6data HTTP a where
9data HTTP a where
7 Open :: String -> HTTP ()
10 Open :: String -> HTTP ()
8 Close :: HTTP ()
11 Close :: HTTP ()
9− Post :: String -> HTTP String
12+ Post :: String -> HTTP String
10− HGet :: HTTP String
13+ HGet :: HTTP String
11
14
12−open' :: Member HTTP e => String -> Eff e ()
15+open' :: String -> HttpM ()
13−open' = send . Open
16+open' = send . Open
14
17
15−close' :: Member HTTP e => Eff e ()
18+close' :: HttpM ()
16close' = send Close
19close' = send Close
17
20
18−post' :: Member HTTP e => String -> Eff e String
21+post' :: String -> HttpM String
19post' = send . Post
22post' = send . Post
20
23
21−get' :: Member HTTP e => Eff e String
24+get' :: HttpM String
22get' = send HGet
25get' = send HGet
23
26
24doHttp :: Eff (HTTP ': e) b -> Eff e b
27doHttp :: Eff (HTTP ': e) b -> Eff e b
25−doHttp =
26− interpret
28+doHttp = interpret
27− ( \x -> case x of
29+ (\x -> case x of
28− Open _ -> pure ()
30+ Open _ -> pure ()
29− Close -> pure ()
31+ Close -> pure ()
30− Post a -> pure ("posted" <> a)
32+ Post a -> pure ("posted" <> a)
31− HGet -> pure "gotten"
33+ HGet -> pure "gotten")
32− )
34+
33−
34−runHttp :: Eff '[HTTP, IO] a -> IO a
35+runHttp :: HttpM a -> IO a
35runHttp = runM . doHttp
36runHttp = 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 #-}
1module Freer.StatefulExcept where
2module Freer.StatefulExcept where
2
3
3import Control.Monad.Freer
4import Control.Monad.Freer
5+import Control.Monad.Freer.State as State
4import Control.Monad.Freer.Error
6import Control.Monad.Freer.Error
5−import Control.Monad.Freer.State
7+import Data.Tuple
6
8
7−countDownExc :: (Member (State Int) e, Member (Error String) e) => Eff e b
9+type StateM = Eff '[State Int, Error String]
8−countDownExc = go
10+
9− where
11+get :: StateM Int
10− go = get @Int >>= (\n -> if n <= 0 then throwError "what" else put @Int (n - 1) *> go)
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+
1module Fused.HTTP where
3module Fused.HTTP where
2
4
3−import Control.Algebra
5+import Control.Effect
6+import Control.Effect.Sum
4−import Control.Carrier.Lift
7+import Control.Effect.Carrier
5−import Control.Monad
8+import Data.Coerce
6import Control.Monad.IO.Class
9import Control.Monad.IO.Class
7−import Data.Functor
8−import GHC.Generics (Generic1)
9
10
10−newtype HttpC m a = HttpC {runHttpC :: m a}
11+newtype HttpC m a = HttpC { runHttpC :: m a }
11− deriving newtype (Applicative, Functor, Monad, MonadIO)
12+ deriving (Applicative, Functor, Monad, MonadIO)
12
13
13−data HTTP (m :: * -> *) k where
14+data HTTP (m :: * -> *) k
14− Open :: String -> HTTP m ()
15+ = Open String k
15− Close :: HTTP m ()
16+ | Close k
16− Post :: String -> HTTP m String
17+ | Post String (String -> k)
17− HGet :: HTTP m String
18+ | HGet (String -> k)
19+ deriving Functor
18
20
19−open' :: Has HTTP sig m => String -> m ()
21+instance Effect HTTP where
20−open' s = send (Open s)
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)
21
26
22−close' :: Has HTTP sig m => m ()
27+instance HFunctor HTTP where
23−close' = send Close
28+ hmap _ = coerce
24
29
25−post' :: Has HTTP sig m => String -> m String
30+open' :: String -> HttpM ()
26−post' s = send (Post s)
31+open' s = send (Open s (pure ()))
27
32
28−get' :: Has HTTP sig m => m String
33+close' :: HttpM ()
29−get' = send HGet
34+close' = send (Close (pure ()))
30
35
31−instance (Algebra sig m) => Algebra (HTTP :+: sig) (HttpC m) where
36+post' :: String -> HttpM String
32− alg hdl (L act) ctx = case act of
33− Open _ -> pure ctx
34− Close -> pure ctx
35− Post s -> pure $ ctx $> ("posted " <> s)
37+post' s = send (Post s pure)
36− HGet -> pure $ ctx $> "lmao"
37− alg hdl (R other) ctx = HttpC (alg (runHttpC . hdl) other ctx)
38
38
39+get' :: HttpM String
40+get' = send (HGet pure)
41+
39−runHttp :: HttpC (LiftC IO) a -> IO a
42+type HttpM = HttpC (LiftC IO)
40−runHttp = runM . runHttpC
41
43
42−doHTTP :: Has HTTP sig m => Int -> m Int
44+instance (Effect sig, Carrier sig m) => Carrier (HTTP :+: sig) (HttpC m) where
43−doHTTP n = do
45+ eff (L act) = case act of
44− open' "cats"
46+ Open _ k -> k
45− replicateM_ n (get' *> post' "cats")
47+ Close k -> k
46− close'
48+ Post s k -> k ("posted " <> s)
47− pure n
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+
1module Fused.Stateful where
3module Fused.Stateful where
2
4
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
4
15
5−countDownPut :: Has (State Int) sig m => m Int
16+runStateful :: Int -> StateM a -> (Int, a)
6−countDownPut = get >>= (\n -> if n < 0 then pure n else put (n - 1) *> countDownPut)
17+runStateful n x = run $ State.runState n x
instances/Fused/StatefulExcept.hs+17−4
@@ -1,8 +1,21 @@
1+{-# LANGUAGE TypeApplications #-}
2+
1module Fused.StatefulExcept where
3module Fused.StatefulExcept where
2
4
5+import Control.Effect (run, PureC)
6+import Control.Effect.State.Strict as State
3import Control.Effect.Error
7import Control.Effect.Error
4−import Control.Effect.State
5
8
6−countDownExc :: (Has (State Int) sig m, Has (Error String) sig m) => m a
9+type StateM = StateC Int (ErrorC String PureC)
7−countDownExc =
10+
8− get @Int >>= (\n -> if n <= 0 then throwError "what" else put @Int (n - 1) *> countDownExc)
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+
1module MTL.HTTP where
3module MTL.HTTP where
2
4
3import Control.Applicative
5import Control.Applicative
@@ -16,7 +18,7 @@ instance Functor HttpM where
16 fmap = liftA
18 fmap = liftA
17
19
18instance Applicative HttpM where
20instance Applicative HttpM where
19− pure = Pure
21+ pure = Pure
20 (<*>) = ap
22 (<*>) = ap
21
23
22instance Monad HttpM where
24instance Monad HttpM where
@@ -36,17 +38,10 @@ open' = Open
36
38
37runHttp :: HttpM a -> IO a
39runHttp :: HttpM a -> IO a
38runHttp = \case
40runHttp = \case
39− Pure x -> pure x
41+ Pure x -> pure x
40− Lift m -> m
42+ Lift m -> m
41 Then x f -> runHttp x >>= runHttp . f
43 Then x f -> runHttp x >>= runHttp . f
42− Open _ -> pure ()
44+ Open _ -> pure ()
43− Shut -> pure ()
45+ Shut -> pure ()
44− Post s -> pure ("posted " <> s)
46+ Post s -> pure ("posted " <> s)
45− HGet -> pure "lmap"
47+ HGet -> pure "lmap"
46−
47−doHTTP :: Int -> HttpM Int
48−doHTTP n = do
49− open' "cats"
50− replicateM_ n (get' *> post' "cats")
51− close'
52− pure n
instances/MTL/Stateful.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 @@
1module MTL.StatefulExcept where
1module MTL.StatefulExcept where
2
2
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
5
7
6−countDownExc :: (MonadState Int m, MonadError String m) => m a
8+type StateM = MTL.StateT Int (MTL.ExceptT String Identity)
7−countDownExc = get >>= (\n -> if n <= 0 then throwError "what" else put (n - 1) *> countDownExc)
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 #-}
2
2
3module Poly.HTTP where
3module Poly.HTTP where
4
4
5−import Control.Monad
6import Polysemy
5import Polysemy
7
6
8−type HttpM = Sem '[Http, Final IO]
7+type HttpM = Sem '[Http, Lift IO]
9
8
10data Http (m :: * -> *) a where
9data Http (m :: * -> *) a where
11− HOpen :: String -> Http m ()
10+ HOpen :: String -> Http m ()
12 HClose :: Http m ()
11 HClose :: Http m ()
13− HPost :: String -> Http m String
12+ HPost :: String -> Http m String
14− HGet :: Http m String
13+ HGet :: Http m String
15
14
16makeSem ''Http
15makeSem ''Http
17
16
18−open' :: Member Http r => String -> Sem r ()
17+open' :: String -> HttpM ()
19−open' = hOpen
18+open' = hOpen
20
19
21−close' :: Member Http r => Sem r ()
20+close' :: HttpM ()
22close' = hClose
21close' = hClose
23
22
24−post' :: Member Http r => String -> Sem r String
23+post' :: String -> HttpM String
25post' = hPost
24post' = hPost
26
25
27−get' :: Member Http r => Sem r String
26+get' :: HttpM String
28get' = hGet
27get' = hGet
29
28
30runHttp' :: Sem (Http ': r) a -> Sem r a
29runHttp' :: Sem (Http ': r) a -> Sem r a
31runHttp' = interpret $ \case
30runHttp' = interpret $ \case
32 HOpen _ -> pure ()
31 HOpen _ -> pure ()
33− HClose -> pure ()
32+ HClose -> pure ()
34 HPost s -> pure ("posted " <> s)
33 HPost s -> pure ("posted " <> s)
35− HGet -> pure "contents"
34+ HGet -> pure "contents"
36
35
37runHttp :: HttpM a -> IO a
36runHttp :: HttpM a -> IO a
38−runHttp = runFinal . runHttp'
37+runHttp = runM . runHttp'
39−
38+
40−doHTTP :: Member Http r => Int -> Sem r Int
39+-- open' :: String -> HttpM ()
41−doHTTP n = do
40+-- open' = send . Open
42− open' "cats"
41+
43− replicateM_ n (get' *> post' "cats")
42+-- close' :: HttpM ()
44− close'
43+-- close' = send Close
45− pure n
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+
1module Poly.Stateful where
3module Poly.Stateful where
2
4
3import Polysemy
5import 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
5
15
6−countDownPut :: Member (State Int) r => Sem r Int
16+runStateful :: Int -> StateM a -> (Int, a)
7−countDownPut = get >>= (\n -> if n < 0 then pure n else put (n - 1) *> countDownPut)
17+runStateful n x = run $ State.runState n x
instances/Poly/StatefulExcept.hs+16−4
@@ -1,8 +1,20 @@
1+{-# LANGUAGE TypeApplications, DataKinds #-}
1module Poly.StatefulExcept where
2module Poly.StatefulExcept where
2
3
3import Polysemy
4import Polysemy
4−import Polysemy.Error
5+import Polysemy.State as State
5−import Polysemy.State
6+import Polysemy.Error as Err
6
7
7−countDownExc :: (Member (State Int) r, Member (Error String) r) => Sem r a
8+type StateM = Sem '[State Int, Error String]
8−countDownExc = get @Int >>= (\n -> if n <= 0 then throw "what" else put @Int (n - 1) *> countDownExc)
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 #-}
2
2
3−import Control.Monad
3+module Shallow.HTTP where
4
4
5−newtype HttpM a = HttpM {runHttp :: IO a}
5+newtype HttpM a = HttpM { runHttp :: IO a}
6− deriving newtype (Applicative, Functor, Monad)
6+ deriving (Applicative, Functor, Monad)
7
7
8get' :: HttpM String
8get' :: HttpM String
9get' = pure "lmao"
9get' = pure "lmao"
@@ -16,10 +16,3 @@ close' = pure ()
16
16
17open' :: String -> HttpM ()
17open' :: String -> HttpM ()
18open' _ = pure ()
18open' _ = 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
2
2
3import Control.Monad
3import Control.Monad
4
4
5−newtype StateM a = StateM {unStateM :: Int -> (Int, a)}
5+newtype StateM a = StateM { unStateM :: Int -> (Int, a) }
6
6
7instance Functor StateM where
7instance Functor StateM where
8 fmap f (StateM a) = StateM (\n -> fmap f (a n))
8 fmap f (StateM a) = StateM (\n -> fmap f (a n))
@@ -22,8 +22,3 @@ put x = StateM (\_ -> (x, ()))
22
22
23runStateful :: Int -> StateM a -> (Int, a)
23runStateful :: Int -> StateM a -> (Int, a)
24runStateful n (StateM f) = f $! n
24runStateful 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+
1module Shallow.StatefulExcept where
3module Shallow.StatefulExcept where
2
4
3import Control.Monad
5import Control.Monad
4
6
5−newtype StateM a = StateM {unStateM :: Int -> Either String (Int, a)}
7+newtype StateM a = StateM { unStateM :: Int -> Either String (Int, a) }
6
8
7instance Functor StateM where
9instance Functor StateM where
8 fmap f (StateM a) = StateM (\n -> fmap (fmap f) (a n))
10 fmap f (StateM a) = StateM (\n -> fmap (fmap f) (a n))
@@ -12,12 +14,9 @@ instance Applicative StateM where
12 (<*>) = ap
14 (<*>) = ap
13
15
14instance Monad StateM where
16instance Monad StateM where
15− (StateM a) >>= f =
16− StateM
17− ( \n -> case a n of
17+ (StateM a) >>= f = StateM (\n -> case a n of
18− Left s -> Left s
18+ Left s -> Left s
19− Right (n', x) -> unStateM (f x) n'
19+ Right (n', x) -> unStateM (f x) n')
20− )
21
20
22get :: StateM Int
21get :: StateM Int
23get = StateM (\n -> Right (n, n))
22get = StateM (\n -> Right (n, n))
@@ -30,8 +29,3 @@ throw s = StateM (\_ -> Left s)
30
29
31runStatefulExcept :: Int -> StateM a -> Either String (Int, a)
30runStatefulExcept :: Int -> StateM a -> Either String (Int, a)
32runStatefulExcept n (StateM f) = f $! n
31runStatefulExcept 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 #-}
1+{-# LANGUAGE FlexibleContexts, GADTs, CPP #-}
3−{-# LANGUAGE GADTs #-}
4
2
5module Main where
3module Main where
6
4
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
12import Gauge (bench, bgroup, nf, nfAppIO)
5import Gauge (bench, bgroup, nf, nfAppIO)
13import Gauge.Main (defaultMain)
6import 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
18
7
19−wruns :: Int
8+import qualified Fused.Countdown as Fused
20−wruns = 1
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) ]
21
25
22runs :: Int
26runs :: Int
23−runs = 100000
27+runs = 10000
24
28
25main :: IO ()
29main :: IO ()
26−main = do
27− putStrLn "*** Time benchmarks ***"
28− defaultMain
30+main = defaultMain
29− [ bgroup
31+ [
30− "Countdown"
32+ bgroup "Countdown"
31− [ bgroup
33+ [ bgroup "Put" SUITE(countDownPut, runs)
32− "Put"
34+ , bgroup "Put+Exc" SUITE(countDownExc, runs)
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− ]
65 ]
35 ]
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)
66
47
67− putStrLn "*** Space benchmarks (these will take some time to run) ***"
48+bareDownExc :: Int -> Either String (Int, Int)
68− Weigh.mainWith $ do
49+bareDownExc st = if st <= 0 then Left "what" else bareDownExc (st - 1)
69− Weigh.wgroup "Countdown" $
70− sequence_
71− [ Weigh.func "fused-effects" Fused.countDownBench wruns,
72− Weigh.func "mtl" MTL.countDownBench wruns,
73− Weigh.func "polysemy" Poly.countDownBench wruns,
74− Weigh.func "freer-simple" Freer.countDownBench wruns,
75− Weigh.func "extensible-effects" ExtEff.countDownBench wruns,
76− Weigh.func "shallow" Shallow.countDownBench wruns,
77− Weigh.func "effectful - static" EffectfulStatic.countDownBench runs,
78− Weigh.func "effectful - dynamic" EffectfulDynamic.countDownBench runs
79− ]
80− Weigh.wgroup "Countdown + exc" $
81− sequence_
82− [ Weigh.func "fused-effects" Fused.countDownExcBench wruns,
83− Weigh.func "mtl" MTL.countDownExcBench wruns,
84− Weigh.func "polysemy" Poly.countDownExcBench wruns,
85− Weigh.func "freer-simple" Freer.countDownExcBench wruns,
86− Weigh.func "extensible-effects" ExtEff.countDownExcBench wruns,
87− Weigh.func "shallow" Shallow.countDownExcBench wruns,
88− Weigh.func "effectful - static" EffectfulStatic.countDownExcBench runs,
89− Weigh.func "effectful - dynamic" EffectfulDynamic.countDownExcBench runs
90− ]
stack.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