-
Notifications
You must be signed in to change notification settings - Fork 709
/
Copy pathCabalBenchmarks.hs
117 lines (98 loc) · 4.65 KB
/
CabalBenchmarks.hs
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
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
{-# OPTIONS_GHC -fno-warn-deprecations #-}
module Main where
import Test.Tasty.Bench (bench, bgroup, defaultMain, env, nf, whnf)
import Distribution.PackageDescription.Parsec (parseGenericPackageDescriptionMaybe)
import Distribution.Parsec (eitherParsec)
import Distribution.Version
import qualified Data.ByteString as BS
import qualified Distribution.Types.VersionInterval.Legacy as Old
import qualified Distribution.Types.VersionInterval as New
-------------------------------------------------------------------------------
-- Main
-------------------------------------------------------------------------------
main :: IO ()
main = defaultMain
[ bgroup "parseGPD"
[ env (BS.readFile "Cabal/Cabal.cabal") $ \bs ->
bench "Cabal" $ whnf parseGenericPackageDescriptionMaybe bs
, env (BS.readFile "cabal-benchmarks/cabal-benchmarks.cabal") $ \bs ->
bench "cabal-benchmarks" $ whnf parseGenericPackageDescriptionMaybe bs
]
, bgroup "normaliseVersionRange" $
let suite name f = bgroup name
[ env bigVersionRange1 $ \vr -> bench "dnf1" $ nf f vr
, env bigVersionRange2 $ \vr -> bench "dnf2" $ nf f vr
, env bigVersionRange3 $ \vr -> bench "cnf1" $ nf f vr
, env bigVersionRange4 $ \vr -> bench "cnf2" $ nf f vr
, env bigVersionRange5 $ \vr -> bench "mix1" $ nf f vr
, env bigVersionRange6 $ \vr -> bench "mix2" $ nf f vr
, env bigVersionRange7 $ \vr -> bench "pat1" $ nf f vr
, env bigVersionRange8 $ \vr -> bench "pat2" $ nf f vr
, env bigVersionRange9 $ \vr -> bench "pat3" $ nf f vr
, env bigVersionRangeA $ \vr -> bench "pat4" $ nf f vr
]
in [ suite "def" normaliseVersionRange
, suite "old" oldNormaliseVersionRange
, suite "new" newNormaliseVersionRange
]
]
-------------------------------------------------------------------------------
-- VersionRanges normalisation
-------------------------------------------------------------------------------
oldNormaliseVersionRange :: VersionRange -> VersionRange
oldNormaliseVersionRange = Old.fromVersionIntervals . Old.toVersionIntervals
newNormaliseVersionRange :: VersionRange -> VersionRange
newNormaliseVersionRange = New.normaliseVersionRange2
bigVersionRange1 :: IO VersionRange
bigVersionRange1 = either fail return $ eitherParsec
"(>=1.2.0 && <1.3) || (>=1.3.0 && <1.4) || (>=1.4.0.0 && <1.5) || (>=1.5.0.0 && <1.6) || (>=1.7.0.0 && <1.8)"
bigVersionRange2 :: IO VersionRange
bigVersionRange2 = either fail return $ eitherParsec
"(>=1.2.0 && <1.3) || (>=1.4.0.0 && <1.5) || (>=1.3.0 && <1.4) || (>=1.5.0.0 && <1.6) || (>=1.7.0.0 && <1.8)"
bigVersionRange3 :: IO VersionRange
bigVersionRange3 = either fail return $ eitherParsec
">=1.2.0 && (<1.3 || >=1.3.0) && (<1.4 || >=1.4.0.0) && (<1.5 || >=1.5.0.0) && (<1.6 || >=1.7.0.0) && <1.8"
bigVersionRange4 :: IO VersionRange
bigVersionRange4 = either fail return $ eitherParsec
">=1.2.0 && <1.8 && (<1.4 || >=1.4.0.0) && (<1.3 || >=1.3.0) && (<1.5 || >=1.5.0.0) || (<1.6 && >=1.7.0.0)"
bigVersionRange5 :: IO VersionRange
bigVersionRange5 = either fail return $ eitherParsec
">=1.2.0 && (<1.3 || >=1.3.0) && (<1.4 || (>=1.4.0.0 && <1.5) || >=1.5.0.0) && (<1.6 || (>=1.7.0.0 && (<1.8 || >=1.9) && <1.10) || >=1.11) && <1.12"
bigVersionRange6 :: IO VersionRange
bigVersionRange6 = fmap New.normaliseVersionRange2 bigVersionRange5
bigVersionRange7 :: IO VersionRange
bigVersionRange7 = return $
i2 $ i2 $ u (b 0 1) (b 0 1)
where
i2 x = i x x
i = intersectVersionRanges
u = unionVersionRanges
b x y = intersectVersionRanges (laterVersion (v x)) (earlierVersion (v y))
v x = mkVersion [x]
bigVersionRange8 :: IO VersionRange
bigVersionRange8 = return $
i2 $ i2 $ i2 $ u (b 0 1) (b 0 1)
where
i2 x = i x x
i = intersectVersionRanges
u = unionVersionRanges
b x y = intersectVersionRanges (laterVersion (v x)) (earlierVersion (v y))
v x = mkVersion [x]
bigVersionRange9 :: IO VersionRange
bigVersionRange9 = return $
i2 $ i2 $ i2 $ i2 $ u (b 0 1) (b 0 1)
where
i2 x = i x x
i = intersectVersionRanges
u = unionVersionRanges
b x y = intersectVersionRanges (laterVersion (v x)) (earlierVersion (v y))
v x = mkVersion [x]
bigVersionRangeA :: IO VersionRange
bigVersionRangeA = return $
i2 $ i2 $ i2 $ i2 $ i2 $ u (b 0 1) (b 0 1)
where
i2 x = i x x
i = intersectVersionRanges
u = unionVersionRanges
b x y = intersectVersionRanges (laterVersion (v x)) (earlierVersion (v y))
v x = mkVersion [x]