Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal On branch : master
http://hackage.haskell.org/trac/ghc/changeset/ed2bd8fba59ce78a838ef19d5e4dd624360784aa >--------------------------------------------------------------- commit ed2bd8fba59ce78a838ef19d5e4dd624360784aa Author: Johan Tibell <[email protected]> Date: Tue Oct 11 17:58:49 2011 +0000 Add a Benchmark data type for representing 'benchmark' sections >--------------------------------------------------------------- cabal/Distribution/PackageDescription.hs | 123 +++++++++++++++++++++++++++++- 1 files changed, 119 insertions(+), 4 deletions(-) diff --git a/cabal/Distribution/PackageDescription.hs b/cabal/Distribution/PackageDescription.hs index 35370ee..244d453 100644 --- a/cabal/Distribution/PackageDescription.hs +++ b/cabal/Distribution/PackageDescription.hs @@ -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, @@ -501,6 +510,112 @@ testType test = case testInterface test of 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 -- Consider refactoring into executable and library versions. _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
