From e41298e996415c43a3afc33ebd5d39301aa6f8c7 Mon Sep 17 00:00:00 2001 From: Bryan O'Sullivan Date: Sat, 13 Apr 2013 20:35:18 -0700 Subject: [PATCH] Add GHC generics support everywhere --- Criterion/Analysis/Types.hs | 15 ++++++++------- Criterion/Config.hs | 17 ++++++++++------- Criterion/Environment.hs | 7 ++++--- Criterion/Internal.hs | 6 +++++- Criterion/Report.hs | 9 +++++---- criterion.cabal | 4 ++-- 6 files changed, 34 insertions(+), 24 deletions(-) diff --git a/Criterion/Analysis/Types.hs b/Criterion/Analysis/Types.hs index d9483950..bca82539 100644 --- a/Criterion/Analysis/Types.hs +++ b/Criterion/Analysis/Types.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE DeriveDataTypeable, OverloadedStrings, RecordWildCards #-} +{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, OverloadedStrings, + RecordWildCards #-} -- | -- Module : Criterion.Analysis.Types -- Copyright : (c) 2011 Bryan O'Sullivan @@ -19,10 +20,10 @@ module Criterion.Analysis.Types ) where import Control.DeepSeq (NFData(rnf)) -import Data.Data (Data) +import Data.Data (Data, Typeable) import Data.Int (Int64) import Data.Monoid (Monoid(..)) -import Data.Typeable (Typeable) +import GHC.Generics (Generic) import qualified Statistics.Resampling.Bootstrap as B -- | Outliers from sample data, calculated using the boxplot @@ -38,7 +39,7 @@ data Outliers = Outliers { -- ^ Between 1.5 and 3 times the IQR above the third quartile. , highSevere :: {-# UNPACK #-} !Int64 -- ^ More than 3 times the IQR above the third quartile. - } deriving (Eq, Read, Show, Typeable, Data) + } deriving (Eq, Read, Show, Typeable, Data, Generic) instance NFData Outliers @@ -49,7 +50,7 @@ data OutlierEffect = Unaffected -- ^ Less than 1% effect. | Moderate -- ^ Between 10% and 50%. | Severe -- ^ Above 50% (i.e. measurements -- are useless). - deriving (Eq, Ord, Read, Show, Typeable, Data) + deriving (Eq, Ord, Read, Show, Typeable, Data, Generic) instance NFData OutlierEffect @@ -71,7 +72,7 @@ data OutlierVariance = OutlierVariance { -- ^ Brief textual description of effect. , ovFraction :: Double -- ^ Quantitative description of effect (a fraction between 0 and 1). - } deriving (Eq, Read, Show, Typeable, Data) + } deriving (Eq, Read, Show, Typeable, Data, Generic) instance NFData OutlierVariance where rnf OutlierVariance{..} = rnf ovEffect `seq` rnf ovDesc `seq` rnf ovFraction @@ -81,7 +82,7 @@ data SampleAnalysis = SampleAnalysis { anMean :: B.Estimate , anStdDev :: B.Estimate , anOutlierVar :: OutlierVariance - } deriving (Eq, Show, Typeable, Data) + } deriving (Eq, Read, Show, Typeable, Data, Generic) instance NFData SampleAnalysis where rnf SampleAnalysis{..} = diff --git a/Criterion/Config.hs b/Criterion/Config.hs index 50d622bf..c05c5699 100644 --- a/Criterion/Config.hs +++ b/Criterion/Config.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-} -- | -- Module : Criterion.Config @@ -22,26 +22,29 @@ module Criterion.Config , ljust ) where -import Data.Data (Data) +import Data.Data (Data, Typeable) import Data.Function (on) import Data.Monoid (Monoid(..), Last(..)) -import Data.Typeable (Typeable) +import GHC.Generics (Generic) data MatchType = Prefix | Glob - deriving (Eq, Ord, Bounded, Enum, Read, Show, Typeable) + deriving (Eq, Ord, Bounded, Enum, Read, Show, Typeable, Data, + Generic) -- | Control the amount of information displayed. data Verbosity = Quiet | Normal | Verbose - deriving (Eq, Ord, Bounded, Enum, Read, Show, Typeable) + deriving (Eq, Ord, Bounded, Enum, Read, Show, Typeable, Data, + Generic) -- | Print some information and exit, without running any benchmarks. data PrintExit = Nada -- ^ Do not actually print-and-exit. (Default.) | List -- ^ Print a list of known benchmarks. | Version -- ^ Print version information (if known). | Help -- ^ Print a help\/usaage message. - deriving (Eq, Ord, Bounded, Enum, Read, Show, Typeable, Data) + deriving (Eq, Ord, Bounded, Enum, Read, Show, Typeable, Data, + Generic) instance Monoid PrintExit where mempty = Nada @@ -63,7 +66,7 @@ data Config = Config { , cfgVerbosity :: Last Verbosity -- ^ Whether to run verbosely. , cfgJUnitFile :: Last FilePath -- ^ Filename of JUnit report. , cfgMeasure :: Last Bool -- ^ Whether to do any measurement. - } deriving (Eq, Read, Show, Typeable) + } deriving (Eq, Read, Show, Typeable, Generic) instance Monoid Config where mempty = emptyConfig diff --git a/Criterion/Environment.hs b/Criterion/Environment.hs index 31211828..97873ac2 100644 --- a/Criterion/Environment.hs +++ b/Criterion/Environment.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveDataTypeable, TypeOperators #-} +{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, TypeOperators #-} -- | -- Module : Criterion.Environment @@ -24,7 +24,8 @@ import Criterion.IO (note) import Criterion.Measurement (getTime, runForAtLeast, time_) import Criterion.Monad (Criterion) import qualified Data.Vector.Unboxed as U -import Data.Typeable (Typeable) +import Data.Data (Data, Typeable) +import GHC.Generics (Generic) -- | Measured aspects of the execution environment. data Environment = Environment { @@ -32,7 +33,7 @@ data Environment = Environment { -- ^ Clock resolution (in seconds). , envClockCost :: {-# UNPACK #-} !Double -- ^ The cost of a single clock call (in seconds). - } deriving (Eq, Read, Show, Typeable) + } deriving (Eq, Read, Show, Typeable, Data, Generic) -- | Measure the execution environment. measureEnvironment :: Criterion Environment diff --git a/Criterion/Internal.hs b/Criterion/Internal.hs index 4191b0d4..1ff601d6 100644 --- a/Criterion/Internal.hs +++ b/Criterion/Internal.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, RecordWildCards #-} -- | -- Module : Criterion -- Copyright : (c) 2009, 2010, 2011 Bryan O'Sullivan @@ -29,6 +29,7 @@ module Criterion.Internal import Control.Monad (replicateM_, when, mplus) import Control.Monad.Trans (liftIO) +import Data.Data (Data, Typeable) import Criterion.Analysis (Outliers(..), OutlierEffect(..), OutlierVariance(..), SampleAnalysis(..), analyseSample, classifyOutliers, noteOutliers) @@ -42,6 +43,7 @@ import Criterion.Types (Benchmarkable(..), Benchmark(..), Pure, bench, bgroup, nf, nfIO, whnf, whnfIO) import qualified Data.Vector.Unboxed as U import Data.Monoid (getLast) +import GHC.Generics (Generic) import Statistics.Resampling.Bootstrap (Estimate(..)) import Statistics.Types (Sample) import System.Mem (performGC) @@ -120,9 +122,11 @@ data Result = Result { description :: String , sampleAnalysis :: SampleAnalysis , _outliers :: Outliers } + deriving (Eq, Read, Show, Typeable, Data, Generic) type ResultForest = [ResultTree] data ResultTree = Single Result | Compare ResultForest + deriving (Eq, Read, Show, Typeable, Data, Generic) -- | Run, and analyse, one or more benchmarks. runAndAnalyse :: (String -> Bool) -- ^ A predicate that chooses diff --git a/Criterion/Report.hs b/Criterion/Report.hs index e5fd78fb..6ebc9117 100644 --- a/Criterion/Report.hs +++ b/Criterion/Report.hs @@ -1,5 +1,5 @@ -{-# LANGUAGE DeriveDataTypeable, OverloadedStrings, RecordWildCards, - ScopedTypeVariables #-} +{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, OverloadedStrings, + RecordWildCards, ScopedTypeVariables #-} -- | -- Module : Criterion.Report @@ -34,6 +34,7 @@ import Criterion.Config (cfgReport, cfgTemplate, fromLJ) import Criterion.Monad (Criterion, getConfig) import Data.Data (Data, Typeable) import Data.Monoid (Last(..)) +import GHC.Generics (Generic) import Paths_criterion (getDataFileName) import Statistics.Sample.KernelDensity (kde) import Statistics.Types (Sample) @@ -55,7 +56,7 @@ data Report = Report { , reportTimes :: Sample , reportAnalysis :: SampleAnalysis , reportOutliers :: Outliers - } deriving (Eq, Show, Typeable, Data) + } deriving (Eq, Read, Show, Typeable, Data, Generic) -- | The path to the template and other files used for generating -- reports. @@ -163,7 +164,7 @@ includeFile searchPath name = liftIO $ foldr go (return B.empty) searchPath -- | A problem arose with a template. data TemplateException = TemplateNotFound FilePath -- ^ The template could not be found. - deriving (Eq, Show, Typeable, Data) + deriving (Eq, Read, Show, Typeable, Data, Generic) instance Exception TemplateException diff --git a/criterion.cabal b/criterion.cabal index a67db73c..6c0ae9ab 100644 --- a/criterion.cabal +++ b/criterion.cabal @@ -1,5 +1,5 @@ name: criterion -version: 0.7.0.0 +version: 0.7.1.0 synopsis: Robust, reliable performance measurement and analysis license: BSD3 license-file: LICENSE @@ -67,7 +67,7 @@ library mtl >= 2, mwc-random >= 0.8.0.3, parsec >= 3.1.0, - statistics >= 0.10.0.0, + statistics >= 0.10.4.0, time, transformers, vector >= 0.7.1,