{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
module Distribution.Types.Benchmark (
Benchmark(..),
emptyBenchmark,
benchmarkType,
benchmarkModules,
benchmarkModulesAutogen
) where
import Prelude ()
import Distribution.Compat.Prelude
import Distribution.Types.BuildInfo
import Distribution.Types.BenchmarkType
import Distribution.Types.BenchmarkInterface
import Distribution.Types.UnqualComponentName
import Distribution.ModuleName
import qualified Distribution.Types.BuildInfo.Lens as L
data Benchmark = Benchmark {
benchmarkName :: UnqualComponentName,
benchmarkInterface :: BenchmarkInterface,
benchmarkBuildInfo :: BuildInfo
}
deriving (Generic, Show, Read, Eq, Typeable, Data)
instance Binary Benchmark
instance Structured Benchmark
instance NFData Benchmark where rnf = genericRnf
instance L.HasBuildInfo Benchmark where
buildInfo f (Benchmark x1 x2 x3) = fmap (\y1 -> Benchmark x1 x2 y1) (f x3)
instance Monoid Benchmark where
mempty = Benchmark {
benchmarkName = mempty,
benchmarkInterface = mempty,
benchmarkBuildInfo = mempty
}
mappend = (<>)
instance Semigroup Benchmark where
a <> b = Benchmark {
benchmarkName = combine' benchmarkName,
benchmarkInterface = combine benchmarkInterface,
benchmarkBuildInfo = combine benchmarkBuildInfo
}
where combine field = field a `mappend` field b
combine' field = case ( unUnqualComponentName $ field a
, unUnqualComponentName $ field b) of
("", _) -> field b
(_, "") -> field a
(x, y) -> error $ "Ambiguous values for test field: '"
++ x ++ "' and '" ++ y ++ "'"
emptyBenchmark :: Benchmark
emptyBenchmark = mempty
benchmarkType :: Benchmark -> BenchmarkType
benchmarkType benchmark = case benchmarkInterface benchmark of
BenchmarkExeV10 ver _ -> BenchmarkTypeExe ver
BenchmarkUnsupported benchmarktype -> benchmarktype
benchmarkModules :: Benchmark -> [ModuleName]
benchmarkModules benchmark = otherModules (benchmarkBuildInfo benchmark)
benchmarkModulesAutogen :: Benchmark -> [ModuleName]
benchmarkModulesAutogen benchmark = autogenModules (benchmarkBuildInfo benchmark)