cabal-benchmarks/bench/CabalBenchmarks.hs

   1 {-# OPTIONS_GHC -fno-warn-deprecations #-}
   2 module Main where
   3
   4 import Test.Tasty.Bench                       (bench, bgroup, defaultMain, env, nf, whnf)
   5 import Distribution.PackageDescription.Parsec (parseGenericPackageDescriptionMaybe)
   6 import Distribution.Parsec                    (eitherParsec)
   7 import Distribution.Version
   8
   9 import qualified Data.ByteString as BS
  10
  11 import qualified Distribution.Types.VersionInterval.Legacy as Old
  12 import qualified Distribution.Types.VersionInterval        as New
  13
  14 -------------------------------------------------------------------------------
  15 -- Main
  16 -------------------------------------------------------------------------------
  17
  18 main :: IO ()
  19 main = defaultMain
  20     [ bgroup "parseGPD"
  21         [ env (BS.readFile "Cabal/Cabal.cabal") $ \bs ->
  22           bench "Cabal" $ whnf parseGenericPackageDescriptionMaybe bs
  23         , env (BS.readFile "cabal-benchmarks/cabal-benchmarks.cabal") $ \bs ->
  24           bench "cabal-benchmarks" $ whnf parseGenericPackageDescriptionMaybe bs
  25         ]
  26
  27     , bgroup "normaliseVersionRange" $
  28         let suite name f = bgroup name
  29                 [ env bigVersionRange1 $ \vr -> bench "dnf1" $ nf f vr
  30                 , env bigVersionRange2 $ \vr -> bench "dnf2" $ nf f vr
  31                 , env bigVersionRange3 $ \vr -> bench "cnf1" $ nf f vr
  32                 , env bigVersionRange4 $ \vr -> bench "cnf2" $ nf f vr
  33                 , env bigVersionRange5 $ \vr -> bench "mix1" $ nf f vr
  34                 , env bigVersionRange6 $ \vr -> bench "mix2" $ nf f vr
  35                 , env bigVersionRange7 $ \vr -> bench "pat1" $ nf f vr
  36                 , env bigVersionRange8 $ \vr -> bench "pat2" $ nf f vr
  37                 , env bigVersionRange9 $ \vr -> bench "pat3" $ nf f vr
  38                 , env bigVersionRangeA $ \vr -> bench "pat4" $ nf f vr
  39                 ]
  40         in  [ suite "def" normaliseVersionRange
  41             , suite "old" oldNormaliseVersionRange
  42             , suite "new" newNormaliseVersionRange
  43             ]
  44     ]
  45
  46 -------------------------------------------------------------------------------
  47 -- VersionRanges normalisation
  48 -------------------------------------------------------------------------------
  49
  50 oldNormaliseVersionRange :: VersionRange -> VersionRange
  51 oldNormaliseVersionRange = Old.fromVersionIntervals . Old.toVersionIntervals
  52
  53 newNormaliseVersionRange :: VersionRange -> VersionRange
  54 newNormaliseVersionRange = New.normaliseVersionRange2
  55
  56 bigVersionRange1 :: IO VersionRange
  57 bigVersionRange1 = either fail return $ eitherParsec
  58     "(>=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)"
  59
  60 bigVersionRange2 :: IO VersionRange
  61 bigVersionRange2 = either fail return $ eitherParsec
  62     "(>=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)"
  63
  64 bigVersionRange3 :: IO VersionRange
  65 bigVersionRange3 = either fail return $ eitherParsec
  66     ">=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"
  67
  68 bigVersionRange4 :: IO VersionRange
  69 bigVersionRange4 = either fail return $ eitherParsec
  70     ">=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)"
  71
  72 bigVersionRange5 :: IO VersionRange
  73 bigVersionRange5 = either fail return $ eitherParsec
  74     ">=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"
  75
  76 bigVersionRange6 :: IO VersionRange
  77 bigVersionRange6 = fmap New.normaliseVersionRange2 bigVersionRange5
  78
  79 bigVersionRange7 :: IO VersionRange
  80 bigVersionRange7 = return $
  81     i2 $ i2 $ u (b 0 1) (b 0 1)
  82   where
  83     i2 x = i x x
  84     i = intersectVersionRanges
  85     u = unionVersionRanges
  86     b x y = intersectVersionRanges (laterVersion (v x)) (earlierVersion (v y))
  87     v x = mkVersion [x]
  88
  89 bigVersionRange8 :: IO VersionRange
  90 bigVersionRange8 = return $
  91     i2 $ i2 $ i2 $ u (b 0 1) (b 0 1)
  92   where
  93     i2 x = i x x
  94     i = intersectVersionRanges
  95     u = unionVersionRanges
  96     b x y = intersectVersionRanges (laterVersion (v x)) (earlierVersion (v y))
  97     v x = mkVersion [x]
  98
  99 bigVersionRange9 :: IO VersionRange
 100 bigVersionRange9 = return $
 101     i2 $ i2 $ i2 $ i2 $ u (b 0 1) (b 0 1)
 102   where
 103     i2 x = i x x
 104     i = intersectVersionRanges
 105     u = unionVersionRanges
 106     b x y = intersectVersionRanges (laterVersion (v x)) (earlierVersion (v y))
 107     v x = mkVersion [x]
 108
 109 bigVersionRangeA :: IO VersionRange
 110 bigVersionRangeA = return $
 111     i2 $ i2 $ i2 $ i2 $ i2 $ u (b 0 1) (b 0 1)
 112   where
 113     i2 x = i x x
 114     i = intersectVersionRanges
 115     u = unionVersionRanges
 116     b x y = intersectVersionRanges (laterVersion (v x)) (earlierVersion (v y))
 117     v x = mkVersion [x]