1{-# LANGUAGE DeriveDataTypeable #-} 2{-# LANGUAGE DeriveGeneric #-} 3 4module Distribution.Types.Benchmark ( 5 Benchmark(..), 6 emptyBenchmark, 7 benchmarkType, 8 benchmarkModules, 9 benchmarkModulesAutogen 10) where 11 12import Prelude () 13import Distribution.Compat.Prelude 14 15import Distribution.Types.BuildInfo 16import Distribution.Types.BenchmarkType 17import Distribution.Types.BenchmarkInterface 18import Distribution.Types.UnqualComponentName 19 20import Distribution.ModuleName 21 22import qualified Distribution.Types.BuildInfo.Lens as L 23 24-- | A \"benchmark\" stanza in a cabal file. 25-- 26data Benchmark = Benchmark { 27 benchmarkName :: UnqualComponentName, 28 benchmarkInterface :: BenchmarkInterface, 29 benchmarkBuildInfo :: BuildInfo 30 } 31 deriving (Generic, Show, Read, Eq, Typeable, Data) 32 33instance Binary Benchmark 34instance Structured Benchmark 35instance NFData Benchmark where rnf = genericRnf 36 37instance L.HasBuildInfo Benchmark where 38 buildInfo f (Benchmark x1 x2 x3) = fmap (\y1 -> Benchmark x1 x2 y1) (f x3) 39 40instance Monoid Benchmark where 41 mempty = Benchmark { 42 benchmarkName = mempty, 43 benchmarkInterface = mempty, 44 benchmarkBuildInfo = mempty 45 } 46 mappend = (<>) 47 48instance Semigroup Benchmark where 49 a <> b = Benchmark { 50 benchmarkName = combine' benchmarkName, 51 benchmarkInterface = combine benchmarkInterface, 52 benchmarkBuildInfo = combine benchmarkBuildInfo 53 } 54 where combine field = field a `mappend` field b 55 combine' field = case ( unUnqualComponentName $ field a 56 , unUnqualComponentName $ field b) of 57 ("", _) -> field b 58 (_, "") -> field a 59 (x, y) -> error $ "Ambiguous values for test field: '" 60 ++ x ++ "' and '" ++ y ++ "'" 61 62emptyBenchmark :: Benchmark 63emptyBenchmark = mempty 64 65benchmarkType :: Benchmark -> BenchmarkType 66benchmarkType benchmark = case benchmarkInterface benchmark of 67 BenchmarkExeV10 ver _ -> BenchmarkTypeExe ver 68 BenchmarkUnsupported benchmarktype -> benchmarktype 69 70-- | Get all the module names from a benchmark. 71benchmarkModules :: Benchmark -> [ModuleName] 72benchmarkModules benchmark = otherModules (benchmarkBuildInfo benchmark) 73 74-- | Get all the auto generated module names from a benchmark. 75-- This are a subset of 'benchmarkModules'. 76benchmarkModulesAutogen :: Benchmark -> [ModuleName] 77benchmarkModulesAutogen benchmark = autogenModules (benchmarkBuildInfo benchmark) 78