1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
|
{-# language DeriveGeneric #-}
{-# language TypeFamilies #-}
module Main where
import Gauge
import Control.Newtype.Generics
import Data.Coerce
import Data.Foldable (foldMap)
import Data.Semigroup
import GHC.Generics
newtype MySumDerive = MySumDerive Int
deriving (Generic)
instance Newtype MySumDerive
instance Semigroup MySumDerive where
MySumDerive x <> MySumDerive y = MySumDerive (x + y)
instance Monoid MySumDerive where
mappend = (<>)
mempty = MySumDerive 0
newtype MySumManual = MySumManual Int
instance Newtype MySumManual where
type O MySumManual = Int
pack = MySumManual
unpack (MySumManual x) = x
instance Semigroup MySumManual where
MySumManual x <> MySumManual y = MySumManual (x + y)
instance Monoid MySumManual where
mappend = (<>)
mempty = MySumManual 0
mySumDerive :: [Int] -> Int
mySumDerive xs = ala MySumDerive foldMap xs
mySumManual :: [Int] -> Int
mySumManual xs = ala MySumManual foldMap xs
mySumOldschool :: [Int] -> Int
mySumOldschool xs = s
where MySumDerive s = foldMap MySumDerive xs
mySumCoerce :: [Int] -> Int
mySumCoerce xs = coerce (foldMap coerce xs :: MySumDerive)
mySumCoerce' :: [Int] -> Int
mySumCoerce' xs = coerce (mconcat (coerce xs) :: MySumDerive)
preludeSum :: [Int] -> Int
preludeSum xs = sum xs
main :: IO ()
main = defaultMain [
env (return [1..5 :: Int]) $ \ns ->
let bench' s f = bench s (whnf f ns)
in bgroup "[1..5 :: Int]"
[ bgroup "foldMap"
[ bench' "ala MySumDerive" mySumDerive
, bench' "ala MySumManual" mySumManual
, bench' "manual wrap & unwrap" mySumOldschool
, bench' "coerce" mySumCoerce
]
, bench' "coerce . mconcat . coerce" mySumCoerce'
, bench' "Prelude.sum" preludeSum
]
]
|
