criterion 0.6.0.1 → 0.6.1.1

raw patch · 6 files changed

+112/−17 lines, 6 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Criterion.hs +81/−7
• Criterion/Config.hs +4/−0
• Criterion/Main.hs +6/−3
• Criterion/Report.hs +4/−4
• Criterion/Types.hs +16/−2
• criterion.cabal +1/−1

@@ -25,7 +25,7 @@     , runAndAnalyse     ) where -import Control.Monad ((<=<), replicateM_, when)+import Control.Monad (replicateM_, when, mplus) import Control.Monad.Trans (liftIO) import Criterion.Analysis (Outliers(..), OutlierEffect(..), OutlierVariance(..),                            SampleAnalysis(..), analyseSample,@@ -39,6 +39,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 Statistics.Resampling.Bootstrap (Estimate(..)) import Statistics.Types (Sample) import System.Mem (performGC)@@ -62,6 +63,9 @@   when (fromLJ cfgVerbosity cfg > Normal || estTime > 5) $     note "collecting %d samples, %d iterations each, in estimated %s\n"        sampleCount newIters (secs estTime)+  -- Run the GC to make sure garabage created by previous benchmarks+  -- don't affect this benchmark.+  liftIO performGC   times <- liftIO . fmap (U.map ((/ newItersD) . subtract (envClockCost env))) .            U.replicateM sampleCount $ do              when (fromLJ cfgPerformGC cfg) $ performGC@@ -100,14 +104,24 @@                       (secs $ estPoint e)                       (secs $ estLowerBound e) (secs $ estUpperBound e)                       (estConfidenceLevel e)-                    summary $ printf "%g,%g,%g" +                    summary $ printf "%g,%g,%g"                       (estPoint e)                       (estLowerBound e) (estUpperBound e) -plotAll :: [(String, Sample, SampleAnalysis, Outliers)] -> Criterion ()++plotAll :: [Result] -> Criterion () plotAll descTimes = do-  report (zipWith (\n (d,t,a,o) -> Report n d t a o) [0..] descTimes)+  report (zipWith (\n (Result d t a o) -> Report n d t a o) [0..] descTimes) +data Result = Result { description    :: String+                     , _sample        :: Sample+                     , sampleAnalysis :: SampleAnalysis+                     , _outliers      :: Outliers+                     }++type ResultForest = [ResultTree]+data ResultTree = Single Result | Compare ResultForest+ -- | Run, and analyse, one or more benchmarks. runAndAnalyse :: (String -> Bool) -- ^ A predicate that chooses                                   -- whether to run a benchmark by its@@ -115,15 +129,75 @@               -> Environment               -> Benchmark               -> Criterion ()-runAndAnalyse p env = plotAll <=< go ""-  where go pfx (Benchmark desc b)+runAndAnalyse p env bs' = do+  rts <- go "" bs'++  mbCompareFile <- getConfigItem $ getLast . cfgCompareFile+  case mbCompareFile of+    Nothing -> return ()+    Just compareFile -> do+      liftIO $ writeFile compareFile $ resultForestToCSV rts++  plotAll $ flatten rts++  where go :: String -> Benchmark -> Criterion ResultForest+        go pfx (Benchmark desc b)             | p desc'   = do _ <- note "\nbenchmarking %s\n" desc'                              summary (show desc' ++ ",") -- String will be quoted                              (x,an,out) <- runAndAnalyseOne env desc' b-                             return [(desc',x,an,out)]+                             let result = Result desc' x an out+                             return [Single result]             | otherwise = return []             where desc' = prefix pfx desc         go pfx (BenchGroup desc bs) =             concat `fmap` mapM (go (prefix pfx desc)) bs+        go pfx (BenchCompare bs) = ((:[]) . Compare . concat) `fmap` mapM (go pfx) bs+         prefix ""  desc = desc         prefix pfx desc = pfx ++ '/' : desc++        flatten :: ResultForest -> [Result]+        flatten [] = []+        flatten (Single r    : rs) = r : flatten rs+        flatten (Compare crs : rs) = flatten crs ++ flatten rs++resultForestToCSV :: ResultForest -> String+resultForestToCSV = unlines+                  . ("Reference,Name,% faster than reference" :)+                  . map (\(ref, n, p) -> printf "%s,%s,%.0f" ref n p)+                  . top+        where+          top :: ResultForest -> [(String, String, Double)]+          top [] = []+          top (Single _     : rts) = top rts+          top (Compare rts' : rts) = cmpRT rts' ++ top rts++          cmpRT :: ResultForest -> [(String, String, Double)]+          cmpRT [] = []+          cmpRT (Single r     : rts) = cmpWith r rts+          cmpRT (Compare rts' : rts) = case getReference rts' of+                                         Nothing -> cmpRT rts+                                         Just r  -> cmpRT rts' ++ cmpWith r rts++          cmpWith :: Result -> ResultForest -> [(String, String, Double)]+          cmpWith _   [] = []+          cmpWith ref (Single r     : rts) = cmp ref r : cmpWith ref rts+          cmpWith ref (Compare rts' : rts) = cmpRT rts'       +++                                             cmpWith ref rts' +++                                             cmpWith ref rts++          getReference :: ResultForest -> Maybe Result+          getReference []                   = Nothing+          getReference (Single r     : _)   = Just r+          getReference (Compare rts' : rts) = getReference rts' `mplus`+                                              getReference rts++cmp :: Result -> Result -> (String, String, Double)+cmp ref r = (description ref, description r, percentFaster)+    where+      percentFaster = (meanRef - meanR) / meanRef * 100++      meanRef = mean ref+      meanR   = mean r++      mean = estPoint . anMean . sampleAnalysis

@@ -53,6 +53,7 @@     , cfgReport       :: Last FilePath -- ^ Filename of report.     , cfgSamples      :: Last Int    -- ^ Number of samples to collect.     , cfgSummaryFile  :: Last FilePath -- ^ Filename of summary CSV.+    , cfgCompareFile  :: Last FilePath -- ^ Filename of the comparison CSV.     , cfgTemplate     :: Last FilePath -- ^ Filename of report template.     , cfgVerbosity    :: Last Verbosity -- ^ Whether to run verbosely.     } deriving (Eq, Read, Show, Typeable)@@ -72,6 +73,7 @@                 , cfgReport       = mempty                 , cfgSamples      = ljust 100                 , cfgSummaryFile  = mempty+                , cfgCompareFile  = mempty                 , cfgTemplate     = ljust "report.tpl"                 , cfgVerbosity    = ljust Normal                 }@@ -98,6 +100,7 @@               , cfgResamples    = mempty               , cfgSamples      = mempty               , cfgSummaryFile  = mempty+              , cfgCompareFile  = mempty               , cfgTemplate     = mempty               , cfgVerbosity    = mempty               }@@ -113,6 +116,7 @@     , cfgResamples    = app cfgResamples a b     , cfgSamples      = app cfgSamples a b     , cfgSummaryFile  = app cfgSummaryFile a b+    , cfgCompareFile  = app cfgCompareFile a b     , cfgTemplate     = app cfgTemplate a b     , cfgVerbosity    = app cfgVerbosity a b     }

@@ -31,6 +31,7 @@     -- * Constructing benchmarks     , bench     , bgroup+    , bcompare     , nf     , whnf     , nfIO@@ -50,7 +51,7 @@ import Criterion.IO (note, printError) import Criterion.Monad (Criterion, withConfig) import Criterion.Types (Benchmarkable(..), Benchmark(..), Pure, bench,-                        benchNames, bgroup, nf, nfIO, whnf, whnfIO)+                        benchNames, bgroup, bcompare, nf, nfIO, whnf, whnfIO) import Data.List (isPrefixOf, sort) import Data.Monoid (Monoid(..), Last(..)) import System.Console.GetOpt@@ -111,6 +112,8 @@           "template file to use"  , Option ['u'] ["summary"] (ReqArg (\s -> return $ mempty { cfgSummaryFile = ljust s }) "FILENAME")           "produce a summary CSV file of all results"+ , Option ['r'] ["compare"] (ReqArg (\s -> return $ mempty { cfgCompareFile = ljust s }) "FILENAME")+          "produce a CSV file of comparisons\nagainst reference benchmarks.\nSee the bcompare combinator"  , Option ['V'] ["version"] (noArg mempty { cfgPrintExit = Version })           "display version, then exit"  , Option ['v'] ["verbose"] (noArg mempty { cfgVerbosity = ljust Verbose })@@ -118,7 +121,7 @@  ]  printBanner :: Config -> IO ()-printBanner cfg = withConfig cfg $ +printBanner cfg = withConfig cfg $     case cfgBanner cfg of       Last (Just b) -> note "%s\n" b       _             -> note "Hey, nobody told me what version I am!\n"@@ -175,7 +178,7 @@ -- >              -- Always GC between runs. -- >              cfgPerformGC = ljust True -- >            }--- > +-- > -- > main = defaultMainWith myConfig (return ()) [ -- >          bench "fib 30" $ whnf fib 30 -- >        ]

@@ -26,7 +26,7 @@     , vector2     ) where -import Control.Exception (Exception, IOException, catch, throwIO)+import Control.Exception (Exception, IOException, throwIO) import Control.Monad (mplus) import Control.Monad.IO.Class (MonadIO(liftIO)) import Criterion.Analysis (Outliers(..), SampleAnalysis(..))@@ -35,7 +35,6 @@ import Data.Data (Data, Typeable) import Data.Monoid (Last(..)) import Paths_criterion (getDataFileName)-import Prelude hiding (catch) import Statistics.Sample.KernelDensity (kde) import Statistics.Types (Sample) import System.Directory (doesFileExist)@@ -43,6 +42,7 @@ import System.IO.Unsafe (unsafePerformIO) import Text.Hastache (MuType(..)) import Text.Hastache.Context (mkGenericContext, mkStrContext)+import qualified Control.Exception as E import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy as L import qualified Data.Vector.Generic as G@@ -158,7 +158,7 @@ includeFile searchPath name = liftIO $ foldr go (return B.empty) searchPath     where go dir next = do             let path = dir </> H.decodeStr name-            B.readFile path `catch` \(_::IOException) -> next+            B.readFile path `E.catch` \(_::IOException) -> next  -- | A problem arose with a template. data TemplateException =@@ -184,7 +184,7 @@           let cur = p </> name           x <- doesFileExist cur           if x-            then B.readFile cur `catch` \e -> go (me `mplus` Just e) ps+            then B.readFile cur `E.catch` \e -> go (me `mplus` Just e) ps             else go me ps         go (Just e) _ = throwIO (e::IOException)         go _        _ = throwIO . TemplateNotFound $ name

@@ -35,6 +35,7 @@     , whnfIO     , bench     , bgroup+    , bcompare     , benchNames     ) where @@ -103,8 +104,9 @@ -- with a name, created with 'bench', or a (possibly nested) group of -- 'Benchmark's, created with 'bgroup'. data Benchmark where-    Benchmark  :: Benchmarkable b => String -> b -> Benchmark-    BenchGroup :: String -> [Benchmark] -> Benchmark+    Benchmark    :: Benchmarkable b => String -> b -> Benchmark+    BenchGroup   :: String -> [Benchmark] -> Benchmark+    BenchCompare :: [Benchmark] -> Benchmark  -- | Create a single benchmark. bench :: Benchmarkable b =>@@ -119,12 +121,24 @@        -> Benchmark bgroup = BenchGroup +-- | Compare benchmarks against a reference benchmark+-- (The first 'bench' in the given list).+--+-- The results of the comparisons are written to a CSV file specified using the+-- @-r@ command line flag. The CSV file uses the following format:+--+-- @Reference,Name,% faster than the reference@+bcompare :: [Benchmark] -> Benchmark+bcompare = BenchCompare+ -- | Retrieve the names of all benchmarks.  Grouped benchmarks are -- prefixed with the name of the group they're in. benchNames :: Benchmark -> [String] benchNames (Benchmark d _)   = [d] benchNames (BenchGroup d bs) = map ((d ++ "/") ++) . concatMap benchNames $ bs+benchNames (BenchCompare bs) =                       concatMap benchNames $ bs  instance Show Benchmark where     show (Benchmark d _)  = ("Benchmark " ++ show d)     show (BenchGroup d _) = ("BenchGroup " ++ show d)+    show (BenchCompare _) = ("BenchCompare")

@@ -1,5 +1,5 @@ name:           criterion-version:        0.6.0.1+version:        0.6.1.1 synopsis:       Robust, reliable performance measurement and analysis license:        BSD3 license-file:   LICENSE