Commit 482d4fcd authored by tibbe's avatar tibbe
Browse files

Add a Benchmark data type for representing 'benchmark' sections

parent 0c7e39d3
......@@ -8,10 +8,10 @@
--
-- This defines the data structure for the @.cabal@ file format. There are
-- several parts to this structure. It has top level info and then 'Library',
-- 'Executable', and 'TestSuite' sections each of which have associated
-- 'BuildInfo' data that's used to build the library, exe, or test. To further
-- complicate things there is both a 'PackageDescription' and a
-- 'GenericPackageDescription'. This distinction relates to cabal
-- 'Executable', 'TestSuite', and 'Benchmark' sections each of which have
-- associated 'BuildInfo' data that's used to build the library, exe, test, or
-- benchmark. To further complicate things there is both a 'PackageDescription'
-- and a 'GenericPackageDescription'. This distinction relates to cabal
-- configurations. When we initially read a @.cabal@ file we get a
-- 'GenericPackageDescription' which has all the conditional sections.
-- Before actually building a package we have to decide
......@@ -85,6 +85,15 @@ module Distribution.PackageDescription (
testModules,
enabledTests,
-- * Benchmarks
Benchmark(..),
BenchmarkInterface(..),
BenchmarkType(..),
benchmarkType,
knownBenchmarkTypes,
emptyBenchmark,
benchmarkModules,
-- * Build information
BuildInfo(..),
emptyBuildInfo,
......@@ -500,6 +509,112 @@ testType test = case testInterface test of
TestSuiteLibV09 ver _ -> TestTypeLib ver
TestSuiteUnsupported testtype -> testtype
-- ---------------------------------------------------------------------------
-- The Benchmark type
-- | A \"benchmark\" stanza in a cabal file.
--
data Benchmark = Benchmark {
benchmarkName :: String,
benchmarkInterface :: BenchmarkInterface,
benchmarkBuildInfo :: BuildInfo,
benchmarkEnabled :: Bool
-- TODO: See TODO for 'testEnabled'.
}
deriving (Show, Read, Eq)
-- | The benchmark interfaces that are currently defined. Each
-- benchmark must specify which interface it supports.
--
-- More interfaces may be defined in future, either new revisions or
-- totally new interfaces.
--
data BenchmarkInterface =
-- | Benchmark interface \"exitcode-stdio-1.0\". The benchmark
-- takes the form of an executable. It returns a zero exit code
-- for success, non-zero for failure. The stdout and stderr
-- channels may be logged. It takes no command line parameters
-- and nothing on stdin.
--
BenchmarkExeV10 Version FilePath
-- | A benchmark that does not conform to one of the above
-- interfaces for the given reason (e.g. unknown benchmark type).
--
| BenchmarkUnsupported BenchmarkType
deriving (Eq, Read, Show)
instance Monoid Benchmark where
mempty = Benchmark {
benchmarkName = mempty,
benchmarkInterface = mempty,
benchmarkBuildInfo = mempty,
benchmarkEnabled = False
}
mappend a b = Benchmark {
benchmarkName = combine' benchmarkName,
benchmarkInterface = combine benchmarkInterface,
benchmarkBuildInfo = combine benchmarkBuildInfo,
benchmarkEnabled = if benchmarkEnabled a then True
else benchmarkEnabled b
}
where combine field = field a `mappend` field b
combine' f = case (f a, f b) of
("", x) -> x
(x, "") -> x
(x, y) -> error "Ambiguous values for benchmark field: '"
++ x ++ "' and '" ++ y ++ "'"
instance Monoid BenchmarkInterface where
mempty = BenchmarkUnsupported (BenchmarkTypeUnknown mempty (Version [] []))
mappend a (BenchmarkUnsupported _) = a
mappend _ b = b
emptyBenchmark :: Benchmark
emptyBenchmark = mempty
-- | Get all the module names from a benchmark.
benchmarkModules :: Benchmark -> [ModuleName]
benchmarkModules benchmark = otherModules (benchmarkBuildInfo benchmark)
-- | The \"benchmark-type\" field in the benchmark stanza.
--
data BenchmarkType = BenchmarkTypeExe Version
-- ^ \"type: exitcode-stdio-x.y\"
| BenchmarkTypeUnknown String Version
-- ^ Some unknown benchmark type e.g. \"type: foo\"
deriving (Show, Read, Eq)
knownBenchmarkTypes :: [BenchmarkType]
knownBenchmarkTypes = [ BenchmarkTypeExe (Version [1,0] []) ]
instance Text BenchmarkType where
disp (BenchmarkTypeExe ver) = text "exitcode-stdio-" <> disp ver
disp (BenchmarkTypeUnknown name ver) = text name <> char '-' <> disp ver
parse = do
cs <- Parse.sepBy1 component (Parse.char '-')
_ <- Parse.char '-'
ver <- parse
let name = concat (intersperse "-" cs)
return $! case lowercase name of
"exitcode-stdio" -> BenchmarkTypeExe ver
_ -> BenchmarkTypeUnknown name ver
where
component = do
cs <- Parse.munch1 Char.isAlphaNum
if all Char.isDigit cs then Parse.pfail else return cs
-- each component must contain an alphabetic character, to avoid
-- ambiguity in identifiers like foo-1 (the 1 is the version number).
benchmarkType :: Benchmark -> BenchmarkType
benchmarkType benchmark = case benchmarkInterface benchmark of
BenchmarkExeV10 ver _ -> BenchmarkTypeExe ver
BenchmarkUnsupported benchmarktype -> benchmarktype
-- ---------------------------------------------------------------------------
-- The BuildInfo type
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment