criterion 1.1.4.0 → 1.2.0.0

raw patch · 17 files changed

+657/−186 lines, 17 filesdep +base-compatdep +exceptionsdep +microstachedep −hastachedep ~basedep ~bytestringdep ~deepseqnew-component:exe:criterion-reportnew-uploaderPVP ok

version bump matches the API change (PVP)

Dependencies added: base-compat, exceptions, microstache

Dependencies removed: hastache

Dependency ranges changed: base, bytestring, deepseq, optparse-applicative, statistics

API changes (from Hackage documentation)

Files

• Criterion.hs +5/−0
• Criterion/Analysis.hs +10/−8
• Criterion/Internal.hs +25/−19
• Criterion/Main.hs +7/−2
• Criterion/Main/Options.hs +6/−5
• Criterion/Measurement.hs +57/−4
• Criterion/Monad/Internal.hs +3/−2
• Criterion/Report.hs +95/−81
• Criterion/Types.hs +152/−22
• app/Options.hs +50/−0
• app/Report.hs +32/−0
• changelog.md +35/−3
• criterion.cabal +43/−22
• templates/default.tpl +11/−11
• tests/Cleanup.hs +111/−0
• tests/Sanity.hs +10/−0
• tests/Tests.hs +5/−7

@@ -17,6 +17,11 @@     -- * Creating a benchmark suite     , Benchmark     , env+    , envWithCleanup+    , perBatchEnv+    , perBatchEnvWithCleanup+    , perRunEnv+    , perRunEnvWithCleanup     , bench     , bgroup     -- ** Running a benchmark

@@ -47,10 +47,10 @@ import Statistics.Function (sort) import Statistics.Quantile (weightedAvg) import Statistics.Regression (bootstrapRegress, olsRegress)-import Statistics.Resampling (resample)+import Statistics.Resampling (Estimator(..),resample) import Statistics.Sample (mean) import Statistics.Sample.KernelDensity (kde)-import Statistics.Types (Estimator(..), Sample)+import Statistics.Types (Sample) import System.Random.MWC (GenIO) import qualified Data.List as List import qualified Data.Map as Map@@ -58,6 +58,7 @@ import qualified Data.Vector.Generic as G import qualified Data.Vector.Unboxed as U import qualified Statistics.Resampling.Bootstrap as B+import qualified Statistics.Types                as B import Prelude  -- | Classify outliers in a data set, using the boxplot technique.@@ -81,11 +82,12 @@  -- | Compute the extent to which outliers in the sample data affect -- the sample mean and standard deviation.-outlierVariance :: B.Estimate  -- ^ Bootstrap estimate of sample mean.-                -> B.Estimate  -- ^ Bootstrap estimate of sample-                               --   standard deviation.-                -> Double      -- ^ Number of original iterations.-                -> OutlierVariance+outlierVariance+  :: B.Estimate B.ConfInt Double -- ^ Bootstrap estimate of sample mean.+  -> B.Estimate B.ConfInt Double -- ^ Bootstrap estimate of sample+                                 --   standard deviation.+  -> Double                      -- ^ Number of original iterations.+  -> OutlierVariance outlierVariance µ σ a = OutlierVariance effect desc varOutMin   where     ( effect, desc ) | varOutMin < 0.01 = (Unaffected, "no")@@ -160,7 +162,7 @@   rs <- mapM (\(ps,r) -> regress gen ps r meas) $         ((["iters"],"time"):regressions)   resamps <- liftIO $ resample gen ests resamples stime-  let [estMean,estStdDev] = B.bootstrapBCA confInterval stime ests resamps+  let [estMean,estStdDev] = B.bootstrapBCA confInterval stime resamps       ov = outlierVariance estMean estStdDev (fromIntegral n)       an = SampleAnalysis {                anRegress    = rs

@@ -22,22 +22,23 @@ import Control.DeepSeq (rnf) import Control.Exception (evaluate) import Control.Monad (foldM, forM_, void, when, unless)+import Control.Monad.Catch (MonadMask, finally) import Control.Monad.Reader (ask, asks) import Control.Monad.Trans (MonadIO, liftIO) import Control.Monad.Trans.Except-import qualified Data.Binary as Binary +import qualified Data.Binary as Binary import Data.Int (Int64) import qualified Data.ByteString.Lazy.Char8 as L import Criterion.Analysis (analyseSample, noteOutliers) import Criterion.IO (header, headerRoot, critVersion, readJSONReports, writeJSONReports) import Criterion.IO.Printf (note, printError, prolix, writeCsv)-import Criterion.Measurement (runBenchmark, secs)+import Criterion.Measurement (runBenchmark, runBenchmarkable_, secs) import Criterion.Monad (Criterion) import Criterion.Report (report) import Criterion.Types hiding (measure) import qualified Data.Map as Map import qualified Data.Vector as V-import Statistics.Resampling.Bootstrap (Estimate(..))+import Statistics.Types (Estimate(..),ConfInt(..),confidenceInterval,cl95,confidenceLevel) import System.Directory (getTemporaryDirectory, removeFile) import System.IO (IOMode(..), hClose, openTempFile, openFile, hPutStr, openBinaryFile) import Text.Printf (printf)@@ -79,10 +80,11 @@         _ <- bs r2 (regResponder ++ ":") regRSquare         forM_ (Map.toList regCoeffs) $ \(prd,val) ->           bs (printf "%.3g") ("  " ++ prd) val-      writeCsv (desc,-                estPoint anMean, estLowerBound anMean, estUpperBound anMean,-                estPoint anStdDev, estLowerBound anStdDev,-                estUpperBound anStdDev)+      writeCsv+        (desc,+         estPoint anMean,   fst $ confidenceInterval anMean,   snd $ confidenceInterval anMean,+         estPoint anStdDev, fst $ confidenceInterval anStdDev, snd $ confidenceInterval anStdDev+        )       when (verbosity == Verbose || (ovEffect > Slight && verbosity > Quiet)) $ do         when (verbosity == Verbose) $ noteOutliers reportOutliers         _ <- note "variance introduced by outliers: %d%% (%s)\n"@@ -90,13 +92,17 @@         return ()       _ <- note "\n"       return (Analysed rpt)-      where bs :: (Double -> String) -> String -> Estimate -> Criterion ()-            bs f metric Estimate{..} =+      where bs :: (Double -> String) -> String -> Estimate ConfInt Double -> Criterion ()+            bs f metric e@Estimate{..} =               note "%-20s %-10s (%s .. %s%s)\n" metric-                   (f estPoint) (f estLowerBound) (f estUpperBound)-                   (if estConfidenceLevel == 0.95 then ""-                    else printf ", ci %.3f" estConfidenceLevel)+                   (f estPoint) (f $ fst $ confidenceInterval e) (f $ snd $ confidenceInterval e)+                   (let cl = confIntCL estError+                        str | cl == cl95 = ""+                            | otherwise  = printf ", ci %.3f" (confidenceLevel cl)+                    in str+                   ) + -- | Run a single benchmark and analyse its performance. runAndAnalyseOne :: Int -> String -> Benchmarkable -> Criterion DataRecord runAndAnalyseOne i desc bm = do@@ -122,7 +128,7 @@   -- The type we write to the file is ReportFileContents, a triple.   -- But here we ASSUME that the tuple will become a JSON array.   -- This assumption lets us stream the reports to the file incrementally:-  liftIO $ hPutStr handle $ "[ \"" ++ headerRoot ++ "\", " ++ +  liftIO $ hPutStr handle $ "[ \"" ++ headerRoot ++ "\", " ++                              "\"" ++ critVersion ++ "\", [ "    for select bs $ \idx desc bm -> do@@ -139,7 +145,7 @@     res <- readJSONReports jsonFile     case res of       Left err -> error $ "error reading file "++jsonFile++":\n  "++show err-      Right (_,_,rs) -> +      Right (_,_,rs) ->        case mbJsonFile of          Just _ -> return rs          _      -> removeFile jsonFile >> return rs@@ -160,7 +166,7 @@     Just file -> liftIO $ do       handle <- openBinaryFile file ReadWriteMode       L.hPut handle header-      forM_ reports $ \rpt ->  +      forM_ reports $ \rpt ->         L.hPut handle (Binary.encode rpt)       hClose handle @@ -175,20 +181,20 @@ runFixedIters iters select bs =   for select bs $ \_idx desc bm -> do     _ <- note "benchmarking %s\n" desc-    liftIO $ runRepeatedly bm iters+    liftIO $ runBenchmarkable_ bm iters  -- | Iterate over benchmarks.-for :: MonadIO m => (String -> Bool) -> Benchmark+for :: (MonadMask m, MonadIO m) => (String -> Bool) -> Benchmark     -> (Int -> String -> Benchmarkable -> m ()) -> m () for select bs0 handle = go (0::Int) ("", bs0) >> return ()   where-    go !idx (pfx, Environment mkenv mkbench)+    go !idx (pfx, Environment mkenv cleanenv mkbench)       | shouldRun pfx mkbench = do         e <- liftIO $ do           ee <- mkenv           evaluate (rnf ee)           return ee-        go idx (pfx, mkbench e)+        go idx (pfx, mkbench e) `finally` liftIO (cleanenv e)       | otherwise = return idx     go idx (pfx, Benchmark desc b)       | select desc' = do handle idx desc' b; return $! idx + 1

@@ -31,6 +31,11 @@     , Benchmark     -- * Creating a benchmark suite     , env+    , envWithCleanup+    , perBatchEnv+    , perBatchEnvWithCleanup+    , perRunEnv+    , perRunEnvWithCleanup     , bench     , bgroup     -- ** Running a benchmark@@ -145,9 +150,9 @@   case wat of     List -> mapM_ putStrLn . sort . concatMap benchNames $ bs     Version -> putStrLn versionInfo-    RunIters iters matchType benches -> do+    RunIters cfg iters matchType benches -> do       shouldRun <- selectBenches matchType benches bsgroup-      withConfig defaultConfig $+      withConfig cfg $         runFixedIters iters shouldRun bsgroup     Run cfg matchType benches -> do       shouldRun <- selectBenches matchType benches bsgroup

@@ -22,7 +22,7 @@     ) where  -- Temporary: to support pre-AMP GHC 7.8.4:-import Data.Monoid +import Data.Monoid  import Control.Monad (when) import Criterion.Analysis (validateAccessors)@@ -39,6 +39,7 @@ import Options.Applicative.Help.Pretty ((.$.)) import Options.Applicative.Types import Paths_criterion (version)+import Statistics.Types (mkCL,cl95) import Text.PrettyPrint.ANSI.Leijen (Doc, text) import qualified Data.Map as M import Prelude@@ -57,7 +58,7 @@             -- ^ List all benchmarks.           | Version             -- ^ Print the version.-          | RunIters Int64 MatchType [String]+          | RunIters Config Int64 MatchType [String]             -- ^ Run the given benchmarks, without collecting or             -- analysing performance numbers.           | Run Config MatchType [String]@@ -67,7 +68,7 @@ -- | Default benchmarking configuration. defaultConfig :: Config defaultConfig = Config {-      confInterval = 0.95+      confInterval = cl95     , forceGC      = True     , timeLimit    = 5     , resamples    = 1000@@ -93,7 +94,7 @@     (Version <$ switch (long "version" <> help "Show version info"))   where     runIters = matchNames $-      RunIters <$> option auto+      RunIters <$> config cfg <*> option auto                   (long "iters" <> short 'n' <> metavar "ITERS" <>                    help "Run benchmarks, don't analyse")     matchNames wat = wat@@ -104,7 +105,7 @@  config :: Config -> Parser Config config Config{..} = Config-  <$> option (range 0.001 0.999)+  <$> option (mkCL <$> range 0.001 0.999)       (long "ci" <> short 'I' <> metavar "CI" <> value confInterval <>        help "Confidence interval")   <*> (not <$> switch (long "no-gc" <> short 'G' <>

@@ -1,4 +1,5 @@ {-# LANGUAGE Trustworthy #-}+{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE BangPatterns, CPP, ForeignFunctionInterface,     ScopedTypeVariables #-} @@ -23,12 +24,17 @@     , secs     , measure     , runBenchmark+    , runBenchmarkable+    , runBenchmarkable_     , measured     , applyGCStats     , threshold     ) where  import Criterion.Types (Benchmarkable(..), Measured(..))+import Control.Applicative ((<*))+import Control.DeepSeq (NFData(rnf))+import Control.Exception (finally,evaluate) import Data.Int (Int64) import Data.List (unfoldr) import Data.Word (Word64)@@ -51,12 +57,12 @@ measure :: Benchmarkable        -- ^ Operation to benchmark.         -> Int64                -- ^ Number of iterations.         -> IO (Measured, Double)-measure (Benchmarkable run) iters = do+measure bm iters = runBenchmarkable bm iters addResults $ \act -> do   startStats <- getGCStats   startTime <- getTime   startCpuTime <- getCPUTime   startCycles <- getCycles-  run iters+  act   endTime <- getTime   endCpuTime <- getCPUTime   endCycles <- getCycles@@ -68,6 +74,26 @@            , measIters   = iters            }   return (m, endTime)+  where+    addResults :: (Measured, Double) -> (Measured, Double) -> (Measured, Double)+    addResults (!m1, !d1) (!m2, !d2) = (m3, d1 + d2)+      where+        add f = f m1 + f m2++        m3 = Measured+            { measTime               = add measTime+            , measCpuTime            = add measCpuTime+            , measCycles             = add measCycles+            , measIters              = add measIters++            , measAllocated          = add measAllocated+            , measNumGcs             = add measNumGcs+            , measBytesCopied        = add measBytesCopied+            , measMutatorWallSeconds = add measMutatorWallSeconds+            , measMutatorCpuSeconds  = add measMutatorCpuSeconds+            , measGcWallSeconds      = add measGcWallSeconds+            , measGcCpuSeconds       = add measGcCpuSeconds+            } {-# INLINE measure #-}  -- | The amount of time a benchmark must run for in order for us to@@ -83,6 +109,33 @@ threshold = 0.03 {-# INLINE threshold #-} +runBenchmarkable :: Benchmarkable -> Int64 -> (a -> a -> a) -> (IO () -> IO a) -> IO a+runBenchmarkable Benchmarkable{..} i comb f+    | perRun = work >>= go (i - 1)+    | otherwise = work+  where+    go 0 result = return result+    go !n !result = work >>= go (n - 1) . comb result++    count | perRun = 1+          | otherwise = i++    work = do+        env <- allocEnv count+        let clean = cleanEnv count env+            run = runRepeatedly env count++        clean `seq` run `seq` evaluate $ rnf env++        performGC+        f run `finally` clean <* performGC+    {-# INLINE work #-}+{-# INLINE runBenchmarkable #-}++runBenchmarkable_ :: Benchmarkable -> Int64 -> IO ()+runBenchmarkable_ bm i = runBenchmarkable bm i (\() () -> ()) id+{-# INLINE runBenchmarkable_ #-}+ -- | Run a single benchmark, and return measurements collected while -- executing it, along with the amount of time the measurement process -- took.@@ -93,8 +146,8 @@              -- exceeded in order to generate enough data to perform              -- meaningful statistical analyses.              -> IO (V.Vector Measured, Double)-runBenchmark bm@(Benchmarkable run) timeLimit = do-  run 1+runBenchmark bm timeLimit = do+  runBenchmarkable_ bm 1   start <- performGC >> getTime   let loop [] !_ !_ _ = error "unpossible!"       loop (iters:niters) prev count acc = do

@@ -18,8 +18,9 @@     ) where  -- Temporary: to support pre-AMP GHC 7.8.4:-import Control.Applicative +import Control.Applicative +import Control.Monad.Catch (MonadThrow, MonadCatch, MonadMask) import Control.Monad.Reader (MonadReader(..), ReaderT) import Control.Monad.Trans (MonadIO) import Criterion.Types (Config)@@ -36,7 +37,7 @@ -- | The monad in which most criterion code executes. newtype Criterion a = Criterion {       runCriterion :: ReaderT Crit IO a-    } deriving (Functor, Applicative, Monad, MonadIO)+    } deriving (Functor, Applicative, Monad, MonadIO, MonadThrow, MonadCatch, MonadMask)  instance MonadReader Config Criterion where     ask     = config `fmap` Criterion ask

@@ -33,28 +33,28 @@ import Control.Monad.Reader (ask) import Criterion.Monad (Criterion) import Criterion.Types-import Data.Aeson.Encode (encodeToTextBuilder)-import Data.Aeson.Types (toJSON)+import Data.Aeson (ToJSON (..), Value(..), object, (.=), Value, encode) import Data.Data (Data, Typeable) import Data.Foldable (forM_)+import Data.Monoid ((<>)) import GHC.Generics (Generic) import Paths_criterion (getDataFileName) import Statistics.Function (minMax) import System.Directory (doesFileExist) import System.FilePath ((</>), (<.>), isPathSeparator)-import Text.Hastache (MuType(..))-import Text.Hastache.Context (mkGenericContext, mkStrContext, mkStrContextM)+import Text.Microstache (Key (..), Template (..), Node (..), compileMustacheText, renderMustache)+import Prelude ()+import Prelude.Compat import qualified Control.Exception as E import qualified Data.Text as T+import qualified Data.Text.Lazy.Encoding as TLE import qualified Data.Text.IO as T import qualified Data.Text.Lazy as TL-import qualified Data.Text.Lazy.Builder as TL import qualified Data.Text.Lazy.IO as TL import qualified Data.Vector.Generic as G import qualified Data.Vector.Unboxed as U import qualified Language.Javascript.Flot as Flot import qualified Language.Javascript.JQuery as JQuery-import qualified Text.Hastache as H  -- | Trim long flat tails from a KDE plot. tidyTails :: KDE -> KDE@@ -83,107 +83,121 @@     tpl <- loadTemplate [td,"."] template     TL.writeFile name =<< formatReport reports tpl --- | Format a series of 'Report' values using the given Hastache--- template.+-- | Format a series of 'Report' values using the given Mustache template. formatReport :: [Report]-             -> T.Text    -- ^ Hastache template.+             -> TL.Text    -- ^ Mustache template.              -> IO TL.Text-formatReport reports template = do-  templates <- getTemplateDir-  let context "report"    = return $ MuList $ map inner reports-      context "json"      = return $ MuVariable (encode reports)-      context "include"   = return $ MuLambdaM $ includeFile [templates]-      context "js-jquery" = fmap MuVariable $ TL.readFile =<< JQuery.file-      context "js-flot"   = fmap MuVariable $ TL.readFile =<< Flot.file Flot.Flot-      context _           = return $ MuNothing-      encode v = TL.toLazyText . encodeToTextBuilder . toJSON $ v-      inner r@Report{..} = mkStrContextM $ \nym ->-                         case nym of-                           "name"     -> return . MuVariable . H.htmlEscape .-                                         TL.pack $ reportName-                           "json"     -> return $ MuVariable (encode r)-                           "number"   -> return $ MuVariable reportNumber-                           "iters"    -> return $ vector "x" iters-                           "times"    -> return $ vector "x" times-                           "cycles"   -> return $ vector "x" cycles-                           "kdetimes" -> return $ vector "x" kdeValues-                           "kdepdf"   -> return $ vector "x" kdePDF-                           "kde"      -> return $ vector2 "time" "pdf" kdeValues kdePDF+formatReport reports templateName = do+    template0 <- case compileMustacheText "tpl" templateName of+        Left err -> fail (show err) -- TODO: throw a template exception?+        Right x -> return x++    jQuery <- T.readFile =<< JQuery.file+    flot <- T.readFile =<< Flot.file Flot.Flot++    -- includes, only top level+    templates <- getTemplateDir+    template <- includeTemplate (includeFile [templates]) template0++    let context = object+            [ "json"      .= reports+            , "report"    .= map inner reports+            , "js-jquery" .= jQuery+            , "js-flot"   .= flot+            ]++    return (renderMustache template context)+  where+    includeTemplate :: (FilePath -> IO T.Text) -> Template -> IO Template+    includeTemplate f Template {..} = fmap+        (Template templateActual)+        (traverse (traverse (includeNode f)) templateCache)++    includeNode :: (FilePath -> IO T.Text) -> Node -> IO Node+    includeNode f (Section (Key ["include"]) [TextBlock fp]) =+        fmap TextBlock (f (T.unpack fp))+    includeNode _ n = return n++    -- Merge Report with it's analysis and outliers+    merge :: ToJSON a => a -> Value -> Value+    merge x y = case toJSON x of+        Object x' -> case y of+            Object y' -> Object (x' <> y')+            _         -> y+        _         -> y++    inner r@Report {..} = merge reportAnalysis $ merge reportOutliers $ object+        [ "name"     .= reportName+        , "json"     .= TLE.decodeUtf8 (encode r)+        , "number"   .= reportNumber+        , "iters"    .= vector "x" iters+        , "times"    .= vector "x" times+        , "cycles"   .= vector "x" cycles+        , "kdetimes" .= vector "x" kdeValues+        , "kdepdf"   .= vector "x" kdePDF+        , "kde"      .= vector2 "time" "pdf" kdeValues kdePDF+        ]+      where+        [KDE{..}]   = reportKDEs+        iters       = measure measIters reportMeasured+        times       = measure measTime reportMeasured+        cycles      = measure measCycles reportMeasured+{-                            ('a':'n':_)-> mkGenericContext reportAnalysis $                                          H.encodeStr nym                            _          -> mkGenericContext reportOutliers $                                          H.encodeStr nym-          where [KDE{..}]   = reportKDEs-                iters       = measure measIters reportMeasured-                times       = measure measTime reportMeasured-                cycles      = measure measCycles reportMeasured-      config = H.defaultConfig {-                 H.muEscapeFunc = H.emptyEscape-               , H.muTemplateFileDir = Just templates-               , H.muTemplateFileExt = Just ".tpl"-               }-  H.hastacheStr config template context+-}  -- | Render the elements of a vector. ----- For example, given this piece of Haskell:------ @'mkStrContext' $ \\name ->--- case name of---   \"foo\" -> 'vector' \"x\" foo@--- -- It will substitute each value in the vector for @x@ in the--- following Hastache template:+-- following Mustache template: -- -- > {{#foo}} -- >  {{x}} -- > {{/foo}}-vector :: (Monad m, G.Vector v a, H.MuVar a) =>-          String                -- ^ Name to use when substituting.+vector :: (G.Vector v a, ToJSON a) =>+          T.Text                -- ^ Name to use when substituting.        -> v a-       -> MuType m-{-# SPECIALIZE vector :: String -> U.Vector Double -> MuType IO #-}-vector name v = MuList . map val . G.toList $ v-    where val i = mkStrContext $ \nym ->-                  if nym == name-                  then MuVariable i-                  else MuNothing+       -> Value+{-# SPECIALIZE vector :: T.Text -> U.Vector Double -> Value #-}+vector name v = toJSON . map val . G.toList $ v where+    val i = object [ name .= i ]  -- | Render the elements of two vectors.-vector2 :: (Monad m, G.Vector v a, G.Vector v b, H.MuVar a, H.MuVar b) =>-           String               -- ^ Name for elements from the first vector.-        -> String               -- ^ Name for elements from the second vector.+vector2 :: (G.Vector v a, G.Vector v b, ToJSON a, ToJSON b) =>+           T.Text               -- ^ Name for elements from the first vector.+        -> T.Text               -- ^ Name for elements from the second vector.         -> v a                  -- ^ First vector.         -> v b                  -- ^ Second vector.-        -> MuType m-{-# SPECIALIZE vector2 :: String -> String -> U.Vector Double -> U.Vector Double-                       -> MuType IO #-}-vector2 name1 name2 v1 v2 = MuList $ zipWith val (G.toList v1) (G.toList v2)-    where val i j = mkStrContext $ \nym ->-                    case undefined of-                      _| nym == name1 -> MuVariable i-                       | nym == name2 -> MuVariable j-                       | otherwise    -> MuNothing+        -> Value+{-# SPECIALIZE vector2 :: T.Text -> T.Text -> U.Vector Double -> U.Vector Double+                       -> Value #-}+vector2 name1 name2 v1 v2 = toJSON $ zipWith val (G.toList v1) (G.toList v2) where+    val i j = object+        [ name1 .= i+        , name2 .= j+        ]  -- | Attempt to include the contents of a file based on a search path. -- Returns 'B.empty' if the search fails or the file could not be read. ----- Intended for use with Hastache's 'MuLambdaM', for example:+-- Intended for preprocessing Mustache files, e.g. replacing sections ----- @context \"include\" = 'MuLambdaM' $ 'includeFile' ['templateDir']@+-- @+-- {{#include}}file.txt{{/include}+-- @ ----- Hastache template expansion is /not/ performed within the included--- file.  No attempt is made to ensure that the included file path is--- safe, i.e. that it does not refer to an unexpected file such as--- \"@/etc/passwd@\".+-- with file contents. includeFile :: (MonadIO m) =>                [FilePath]       -- ^ Directories to search.-            -> T.Text          -- ^ Name of the file to search for.+            -> FilePath         -- ^ Name of the file to search for.             -> m T.Text-{-# SPECIALIZE includeFile :: [FilePath] -> T.Text -> IO T.Text #-}+{-# SPECIALIZE includeFile :: [FilePath] -> FilePath -> IO T.Text #-} includeFile searchPath name = liftIO $ foldr go (return T.empty) searchPath     where go dir next = do-            let path = dir </> H.decodeStr name+            let path = dir </> name             T.readFile path `E.catch` \(_::IOException) -> next  -- | A problem arose with a template.@@ -193,7 +207,7 @@  instance Exception TemplateException --- | Load a Hastache template file.+-- | Load a Mustache template file. -- -- If the name is an absolute or relative path, the search path is -- /not/ used, and the name is treated as a literal path.@@ -202,15 +216,15 @@ -- not be found, or an 'IOException' if no template could be loaded. loadTemplate :: [FilePath]      -- ^ Search path.              -> FilePath        -- ^ Name of template file.-             -> IO T.Text+             -> IO TL.Text loadTemplate paths name-    | any isPathSeparator name = T.readFile name+    | any isPathSeparator name = TL.readFile name     | otherwise                = go Nothing paths   where go me (p:ps) = do           let cur = p </> name <.> "tpl"           x <- doesFileExist cur           if x-            then T.readFile cur `E.catch` \e -> go (me `mplus` Just e) ps+            then TL.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

@@ -1,4 +1,5 @@ {-# LANGUAGE Trustworthy #-}+{-# LANGUAGE RankNTypes #-} {-# LANGUAGE DeriveDataTypeable, DeriveGeneric, GADTs, RecordWildCards #-} {-# OPTIONS_GHC -funbox-strict-fields #-} @@ -44,6 +45,11 @@     , rescale     -- * Benchmark construction     , env+    , envWithCleanup+    , perBatchEnv+    , perBatchEnvWithCleanup+    , perRunEnv+    , perRunEnvWithCleanup     , bench     , bgroup     , addPrefix@@ -78,7 +84,8 @@ import GHC.Generics (Generic) import qualified Data.Vector as V import qualified Data.Vector.Unboxed as U-import qualified Statistics.Resampling.Bootstrap as B+import qualified Statistics.Types as St+import           Statistics.Resampling.Bootstrap () import Prelude  -- | Control the amount of information displayed.@@ -90,7 +97,7 @@  -- | Top-level benchmarking configuration. data Config = Config {-      confInterval :: Double+      confInterval :: St.CL Double       -- ^ Confidence interval for bootstrap estimation (greater than       -- 0, less than 1).     , forceGC      :: Bool@@ -123,11 +130,26 @@       -- ^ Template file to use if writing a report.     } deriving (Eq, Read, Show, Typeable, Data, Generic) + -- | A pure function or impure action that can be benchmarked. The -- 'Int64' parameter indicates the number of times to run the given -- function or action.-newtype Benchmarkable = Benchmarkable { runRepeatedly :: Int64 -> IO () }+data Benchmarkable = forall a . NFData a =>+    Benchmarkable+      { allocEnv :: Int64 -> IO a+      , cleanEnv :: Int64 -> a -> IO ()+      , runRepeatedly :: a -> Int64 -> IO ()+      , perRun :: Bool+      } +noop :: Monad m => a -> m ()+noop = const $ return ()+{-# INLINE noop #-}++toBenchmarkable :: (Int64 -> IO ()) -> Benchmarkable+toBenchmarkable f = Benchmarkable noop (const noop) (const f) False+{-# INLINE toBenchmarkable #-}+ -- | A collection of measurements made while benchmarking. -- -- Measurements related to garbage collection are tagged with __GC__.@@ -298,35 +320,35 @@ whnf = pureFunc id {-# INLINE whnf #-} --- | Apply an argument to a function, and evaluate the result to head+-- | Apply an argument to a function, and evaluate the result to -- normal form (NF). nf :: NFData b => (a -> b) -> a -> Benchmarkable nf = pureFunc rnf {-# INLINE nf #-}  pureFunc :: (b -> c) -> (a -> b) -> a -> Benchmarkable-pureFunc reduce f0 x0 = Benchmarkable $ go f0 x0+pureFunc reduce f0 x0 = toBenchmarkable (go f0 x0)   where go f x n           | n <= 0    = return ()           | otherwise = evaluate (reduce (f x)) >> go f x (n-1) {-# INLINE pureFunc #-} --- | Perform an action, then evaluate its result to head normal form.+-- | Perform an action, then evaluate its result to normal form. -- This is particularly useful for forcing a lazy 'IO' action to be -- completely performed. nfIO :: NFData a => IO a -> Benchmarkable-nfIO = impure rnf+nfIO = toBenchmarkable . impure rnf {-# INLINE nfIO #-}  -- | Perform an action, then evaluate its result to weak head normal -- form (WHNF).  This is useful for forcing an 'IO' action whose result -- is an expression to be evaluated down to a more useful value. whnfIO :: IO a -> Benchmarkable-whnfIO = impure id+whnfIO = toBenchmarkable . impure id {-# INLINE whnfIO #-} -impure :: (a -> b) -> IO a -> Benchmarkable-impure strategy a = Benchmarkable go+impure :: (a -> b) -> IO a -> Int64 -> IO ()+impure strategy a = go   where go n           | n <= 0    = return ()           | otherwise = a >>= (evaluate . strategy) >> go (n-1)@@ -342,7 +364,8 @@ -- -- * A (possibly nested) group of 'Benchmark's, created with 'bgroup'. data Benchmark where-    Environment  :: NFData env => IO env -> (env -> Benchmark) -> Benchmark+    Environment  :: NFData env+                 => IO env -> (env -> IO a) -> (env -> Benchmark) -> Benchmark     Benchmark    :: String -> Benchmarkable -> Benchmark     BenchGroup   :: String -> [Benchmark] -> Benchmark @@ -429,8 +452,115 @@     -- ^ Take the newly created environment and make it available to     -- the given benchmarks.     -> Benchmark-env = Environment+env alloc = Environment alloc noop +-- | Same as `env`, but but allows for an additional callback+-- to clean up the environment. Resource clean up is exception safe, that is,+-- it runs even if the 'Benchmark' throws an exception.+envWithCleanup+    :: NFData env+    => IO env+    -- ^ Create the environment.  The environment will be evaluated to+    -- normal form before being passed to the benchmark.+    -> (env -> IO a)+    -- ^ Clean up the created environment.+    -> (env -> Benchmark)+    -- ^ Take the newly created environment and make it available to+    -- the given benchmarks.+    -> Benchmark+envWithCleanup = Environment++-- | Create a Benchmarkable where a fresh environment is allocated for every+-- batch of runs of the benchmarkable.+--+-- The environment is evaluated to normal form before the benchmark is run.+--+-- When using 'whnf', 'whnfIO', etc. Criterion creates a 'Benchmarkable'+-- whichs runs a batch of @N@ repeat runs of that expressions. Criterion may+-- run any number of these batches to get accurate measurements. Environments+-- created by 'env' and 'envWithCleanup', are shared across all these batches+-- of runs.+--+-- This is fine for simple benchmarks on static input, but when benchmarking+-- IO operations where these operations can modify (and especially grow) the+-- environment this means that later batches might have their accuracy effected+-- due to longer, for example, longer garbage collection pauses.+--+-- An example: Suppose we want to benchmark writing to a Chan, if we allocate+-- the Chan using environment and our benchmark consists of @writeChan env ()@,+-- the contents and thus size of the Chan will grow with every repeat. If+-- Criterion runs a 1,000 batches of 1,000 repeats, the result is that the+-- channel will have 999,000 items in it by the time the last batch is run.+-- Since GHC GC has to copy the live set for every major GC this means our last+-- set of writes will suffer a lot of noise of the previous repeats.+--+-- By allocating a fresh environment for every batch of runs this function+-- should eliminate this effect.+perBatchEnv+    :: (NFData env, NFData b)+    => (Int64 -> IO env)+    -- ^ Create an environment for a batch of N runs. The environment will be+    -- evaluated to normal form before running.+    -> (env -> IO b)+    -- ^ Function returning the IO action that should be benchmarked with the+    -- newly generated environment.+    -> Benchmarkable+perBatchEnv alloc = perBatchEnvWithCleanup alloc (const noop)++-- | Same as `perBatchEnv`, but but allows for an additional callback+-- to clean up the environment. Resource clean up is exception safe, that is,+-- it runs even if the 'Benchmark' throws an exception.+perBatchEnvWithCleanup+    :: (NFData env, NFData b)+    => (Int64 -> IO env)+    -- ^ Create an environment for a batch of N runs. The environment will be+    -- evaluated to normal form before running.+    -> (Int64 -> env -> IO ())+    -- ^ Clean up the created environment.+    -> (env -> IO b)+    -- ^ Function returning the IO action that should be benchmarked with the+    -- newly generated environment.+    -> Benchmarkable+perBatchEnvWithCleanup alloc clean work+    = Benchmarkable alloc clean (impure rnf . work) False++-- | Create a Benchmarkable where a fresh environment is allocated for every+-- run of the operation to benchmark. This is useful for benchmarking mutable+-- operations that need a fresh environment, such as sorting a mutable Vector.+--+-- As with 'env' and 'perBatchEnv' the environment is evaluated to normal form+-- before the benchmark is run.+--+-- This introduces extra noise and result in reduce accuracy compared to other+-- Criterion benchmarks. But allows easier benchmarking for mutable operations+-- than was previously possible.+perRunEnv+    :: (NFData env, NFData b)+    => IO env+    -- ^ Action that creates the environment for a single run.+    -> (env -> IO b)+    -- ^ Function returning the IO action that should be benchmarked with the+    -- newly genereted environment.+    -> Benchmarkable+perRunEnv alloc = perRunEnvWithCleanup alloc noop++-- | Same as `perRunEnv`, but but allows for an additional callback+-- to clean up the environment. Resource clean up is exception safe, that is,+-- it runs even if the 'Benchmark' throws an exception.+perRunEnvWithCleanup+    :: (NFData env, NFData b)+    => IO env+    -- ^ Action that creates the environment for a single run.+    -> (env -> IO ())+    -- ^ Clean up the created environment.+    -> (env -> IO b)+    -- ^ Function returning the IO action that should be benchmarked with the+    -- newly genereted environment.+    -> Benchmarkable+perRunEnvWithCleanup alloc clean work = bm { perRun = True }+  where+    bm = perBatchEnvWithCleanup (const alloc) (const clean) work+ -- | Create a single benchmark. bench :: String                 -- ^ A name to identify the benchmark.       -> Benchmarkable          -- ^ An activity to be benchmarked.@@ -455,12 +585,12 @@ -- | Retrieve the names of all benchmarks.  Grouped benchmarks are -- prefixed with the name of the group they're in. benchNames :: Benchmark -> [String]-benchNames (Environment _ b) = benchNames (b undefined)+benchNames (Environment _ _ b) = benchNames (b undefined) benchNames (Benchmark d _)   = [d] benchNames (BenchGroup d bs) = map (addPrefix d) . concatMap benchNames $ bs  instance Show Benchmark where-    show (Environment _ b) = "Environment _ " ++ show (b undefined)+    show (Environment _ _ b) = "Environment _ _" ++ show (b undefined)     show (Benchmark d _)   = "Benchmark " ++ show d     show (BenchGroup d _)  = "BenchGroup " ++ show d @@ -551,11 +681,11 @@ data Regression = Regression {     regResponder  :: String     -- ^ Name of the responding variable.-  , regCoeffs     :: Map String B.Estimate+  , regCoeffs     :: Map String (St.Estimate St.ConfInt Double)     -- ^ Map from name to value of predictor coefficients.-  , regRSquare    :: B.Estimate+  , regRSquare    :: St.Estimate St.ConfInt Double     -- ^ R&#0178; goodness-of-fit estimate.-  } deriving (Eq, Read, Show, Typeable, Data, Generic)+  } deriving (Eq, Read, Show, Typeable, Generic)  instance FromJSON Regression instance ToJSON Regression@@ -576,14 +706,14 @@     , anOverhead   :: Double       -- ^ Estimated measurement overhead, in seconds.  Estimation is       -- performed via linear regression.-    , anMean       :: B.Estimate+    , anMean       :: St.Estimate St.ConfInt Double       -- ^ Estimated mean.-    , anStdDev     :: B.Estimate+    , anStdDev     :: St.Estimate St.ConfInt Double       -- ^ Estimated standard deviation.     , anOutlierVar :: OutlierVariance       -- ^ Description of the effects of outliers on the estimated       -- variance.-    } deriving (Eq, Read, Show, Typeable, Data, Generic)+    } deriving (Eq, Read, Show, Typeable, Generic)  instance FromJSON SampleAnalysis instance ToJSON SampleAnalysis@@ -633,7 +763,7 @@       -- ^ Analysis of outliers.     , reportKDEs     :: [KDE]       -- ^ Data for a KDE of times.-    } deriving (Eq, Read, Show, Typeable, Data, Generic)+    } deriving (Eq, Read, Show, Typeable, Generic)  instance FromJSON Report instance ToJSON Report@@ -654,7 +784,7 @@  data DataRecord = Measurement Int String (V.Vector Measured)                 | Analysed Report-                deriving (Eq, Read, Show, Typeable, Data, Generic)+                deriving (Eq, Read, Show, Typeable, Generic)  instance Binary DataRecord where   put (Measurement i n v) = putWord8 0 >> put i >> put n >> put v

@@ -0,0 +1,50 @@+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, RecordWildCards #-}+module Options+    (+      CommandLine(..)+    , commandLine+    , parseCommandLine+    , versionInfo+    ) where++import Data.Monoid ((<>), mconcat)+import Data.Version (showVersion)+import Data.Data (Data, Typeable)+import GHC.Generics (Generic)+import Paths_criterion (version)+import Options.Applicative++data CommandLine+    = Report { jsonFile :: FilePath, outputFile :: FilePath, templateFile :: FilePath }+    | Version+    deriving (Eq, Read, Show, Typeable, Data, Generic)++reportOptions :: Parser CommandLine+reportOptions = Report <$> measurements <*> outputFile <*> templateFile+  where+    measurements = strArgument $ mconcat+        [metavar "INPUT-JSON", help "Json file to read Criterion output from."]++    outputFile = strArgument $ mconcat+        [metavar "OUTPUT-FILE", help "File to output formatted report too."]++    templateFile = strOption $ mconcat+        [ long "template", short 't', metavar "FILE", value "default",+          help "Template to use for report." ]++parseCommand :: Parser CommandLine+parseCommand =+  (Version <$ switch (long "version" <> help "Show version info")) <|>+  (subparser $+    command "report" (info reportOptions (progDesc "Generate report.")))++commandLine :: ParserInfo CommandLine+commandLine = info (helper <*> parseCommand) $+  header versionInfo <>+  fullDesc++parseCommandLine :: IO CommandLine+parseCommandLine = execParser commandLine++versionInfo :: String+versionInfo = "criterion " ++ showVersion version

@@ -0,0 +1,32 @@+{-# LANGUAGE RecordWildCards #-}+module Main (main) where++import System.Exit (exitSuccess, exitFailure)+import System.IO (hPutStrLn, stderr)++import Criterion.IO (readJSONReports)+import Criterion.Main (defaultConfig)+import Criterion.Monad (withConfig)+import Criterion.Report (report)+import Criterion.Types (Config(reportFile, template))++import Options++main :: IO ()+main = do+    cmd <- parseCommandLine+    case cmd of+        Version -> putStrLn versionInfo >> exitSuccess+        Report{..} -> do+            let config = defaultConfig+                  { reportFile = Just outputFile+                  , template = templateFile+                  }++            res <- readJSONReports jsonFile+            case res of+                Left err -> do+                    hPutStrLn stderr $ "Error reading file: " ++ jsonFile+                    hPutStrLn stderr $ "  " ++ show err+                    exitFailure+                Right (_,_,rpts) -> withConfig config $ report rpts

@@ -1,15 +1,47 @@+1.2.0.0++* Use `statistics-0.14`.++* Replace the `hastache` dependency with `microstache`.++* Add support for per-run allocation/cleanup of the environment with+  `perRunEnv` and `perRunEnvWithCleanup`,++* Add support for per-batch allocation/cleanup with+  `perBatchEnv` and `perBatchEnvWithCleanup`.++* Add `envWithCleanup`, a variant of `env` with cleanup support.++* Add the `criterion-report` executable, which creates reports from previously+  created JSON files.+ 1.1.4.0  * Unicode output is now correctly printed on Windows. -1.1.3.1+1.1.4.0  * Add Safe Haskell annotations. -1.1.3.0- * Add `--json` option for writing reports in JSON rather than binary   format.  Also: various bugfixes related to this.++* Use the `js-jquery` and `js-flot` libraries to substitute in JavaScript code+  into the default HTML report template.++* Use the `code-page` library to ensure that `criterion` prints out Unicode+  characters (like ², which `criterion` uses in reports) in a UTF-8-compatible+  code page on Windows.++* Give an explicit implementation for `get` in the `Binary Regression`+  instance. This should fix sporadic `criterion` failures with older versions+  of `binary`.++* Use `tasty` instead of `test-framework` in the test suites.++* Restore support for 32-bit Intel CPUs.++* Restore build compatibilty with GHC 7.4.  1.1.1.0 

@@ -1,5 +1,5 @@ name:           criterion-version:        1.1.4.0+version:        1.2.0.0 synopsis:       Robust, reliable performance measurement and analysis license:        BSD3 license-file:   LICENSE@@ -17,6 +17,13 @@   examples/*.cabal   examples/*.hs   examples/*.html+tested-with:+  GHC==7.4.2,+  GHC==7.6.3,+  GHC==7.8.4,+  GHC==7.10.3,+  GHC==8.0.2,+  GHC==8.2.1  data-files:   templates/*.css@@ -76,6 +83,7 @@     aeson >= 0.8,     ansi-wl-pprint >= 0.6.7.2,     base >= 4.5 && < 5,+    base-compat >= 0.9,     binary >= 0.5.1.0,     bytestring >= 0.9 && < 1.0,     cassava >= 0.3.0.0,@@ -83,16 +91,17 @@     containers,     deepseq >= 1.1.0.0,     directory,+    exceptions >= 0.8.2 && < 0.9,     filepath,     Glob >= 0.7.2,-    hastache >= 0.6.0,+    microstache >= 1 && < 1.1,     js-flot,     js-jquery,     mtl >= 2,     mwc-random >= 0.8.0.3,     optparse-applicative >= 0.13,     parsec >= 3.1.0,-    statistics >= 0.13.2.1,+    statistics >= 0.14 && < 0.15,     text >= 0.11,     time,     transformers,@@ -111,27 +120,20 @@   else     ghc-options: -O2 --- [2016.05.30] RRN: I'm not sure where this was going.--- It looks like it was meant for post-facto analysis of--- reports?  Will have to ask BOS.------------------------------------------------------------ executable criterion---   hs-source-dirs: app---   main-is:        App.hs---   other-modules:---     Options----   ghc-options:---     -Wall -threaded -rtsopts+Executable criterion-report+  GHC-Options:          -Wall -rtsopts+  Main-Is:              Report.hs+  Other-Modules:        Options+  Hs-Source-Dirs:       app ---   build-depends:---     base,---     criterion,---     optparse-applicative---   if impl(ghc < 7.6)---     build-depends:---       ghc-prim+  Build-Depends:+    base,+    criterion,+    optparse-applicative >= 0.13 +  if impl(ghc < 7.6)+    build-depends:+      ghc-prim  test-suite sanity   type:           exitcode-stdio-1.0@@ -148,6 +150,7 @@     base,     bytestring,     criterion,+    deepseq,     tasty,     tasty-hunit @@ -171,6 +174,24 @@     tasty-quickcheck,     vector,     aeson >= 0.8++test-suite cleanup+  type:           exitcode-stdio-1.0+  hs-source-dirs: tests+  main-is:        Cleanup.hs++  ghc-options:+    -Wall -threaded -O0 -rtsopts++  build-depends:+    HUnit,+    base,+    bytestring,+    criterion,+    deepseq,+    directory,+    tasty,+    tasty-hunit  source-repository head   type:     git

@@ -4,10 +4,10 @@     <meta http-equiv="Content-Type" content="text/html; charset=utf-8">     <title>criterion report</title>     <script language="javascript" type="text/javascript">-      {{js-jquery}}+      {{{js-jquery}}}     </script>     <script language="javascript" type="text/javascript">-      {{js-flot}}+      {{{js-flot}}}     </script>     <script language="javascript" type="text/javascript">       {{#include}}js/jquery.criterion.js{{/include}}@@ -73,15 +73,15 @@    </tr>    <tr>     <td>Mean execution time</td>-    <td><span class="confinterval citime">{{anMean.estLowerBound}}</span></td>+    <td><span class="confinterval citime">{{anMean.estError.confIntLDX}}</span></td>     <td><span class="time">{{anMean.estPoint}}</span></td>-    <td><span class="confinterval citime">{{anMean.estUpperBound}}</span></td>+    <td><span class="confinterval citime">{{anMean.estError.confIntUDX}}</span></td>    </tr>    <tr>     <td>Standard deviation</td>-    <td><span class="confinterval citime">{{anStdDev.estLowerBound}}</span></td>+    <td><span class="confinterval citime">{{anStdDev.estError.confIntLDX}}</span></td>     <td><span class="time">{{anStdDev.estPoint}}</span></td>-    <td><span class="confinterval citime">{{anStdDev.estUpperBound}}</span></td>+    <td><span class="confinterval citime">{{anStdDev.estError.confIntUDX}}</span></td>    </tr>   </tbody>  </table>@@ -177,19 +177,19 @@         return $.renderTime(olsTime.estPoint);       });     $(".olstimelb" + number).text(function() {-        return $.renderTime(olsTime.estLowerBound);+        return $.renderTime(olsTime.estError.confIntLDX);       });     $(".olstimeub" + number).text(function() {-        return $.renderTime(olsTime.estUpperBound);+        return $.renderTime(olsTime.estError.confIntUDX);       });     $(".olsr2pt" + number).text(function() {         return rgrs.regRSquare.estPoint.toFixed(3);       });     $(".olsr2lb" + number).text(function() {-        return rgrs.regRSquare.estLowerBound.toFixed(3);+        return rgrs.regRSquare.estError.confIntLDX.toFixed(3);       });     $(".olsr2ub" + number).text(function() {-        return rgrs.regRSquare.estUpperBound.toFixed(3);+        return rgrs.regRSquare.estError.confIntUDX.toFixed(3);       });     mean *= scale;     kdetimes = $.scaleBy(scale, kdetimes);@@ -271,7 +271,7 @@       $.addTooltip("#cycles" + number, function(x,y) { return x + ' cycles'; });     }   };-  var reports = {{json}};+  var reports = {{{json}}};   reports.map(mangulate);    var benches = [{{#report}}"{{name}}",{{/report}}];

@@ -0,0 +1,111 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++import Criterion.Main (Benchmark, bench, nfIO)+import Criterion.Types (Config(..), Verbosity(Quiet))+import Control.Applicative (pure)+import Control.DeepSeq (NFData(..))+import Control.Exception (Exception, try, throwIO)+import Control.Monad (when)+import Data.Typeable (Typeable)+import System.Directory (doesFileExist, removeFile)+import System.Environment (withArgs)+import System.IO ( Handle, IOMode(ReadWriteMode), SeekMode(AbsoluteSeek)+                 , hClose, hFileSize, hSeek, openFile)+import Test.Tasty (TestTree, defaultMain, testGroup)+import Test.Tasty.HUnit (testCase)+import Test.HUnit (assertFailure)+import qualified Criterion.Main as C+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS++instance NFData Handle where+    rnf !_ = ()++data CheckResult = ShouldThrow | WrongData deriving (Show, Typeable)++instance Exception CheckResult++type BenchmarkWithFile =+  String -> IO Handle -> (Handle -> IO ()) -> (Handle -> IO ()) -> Benchmark++perRun :: BenchmarkWithFile+perRun name alloc clean work =+  bench name $ C.perRunEnvWithCleanup alloc clean work++perBatch :: BenchmarkWithFile+perBatch name alloc clean work =+  bench name $ C.perBatchEnvWithCleanup (const alloc) (const clean) work++envWithCleanup :: BenchmarkWithFile+envWithCleanup name alloc clean work =+  C.envWithCleanup alloc clean $ bench name . nfIO . work++testCleanup :: Bool -> String -> BenchmarkWithFile -> TestTree+testCleanup shouldFail name withEnvClean = testCase name $ do+    existsBefore <- doesFileExist testFile+    when existsBefore $ failTest "Input file already exists"++    result <- runTest . withEnvClean name alloc clean $ \hnd -> do+        result <- hFileSize hnd >>= BS.hGet hnd . fromIntegral+        resetHandle hnd+        when (result /= testData) $ throwIO WrongData+        when shouldFail $ throwIO ShouldThrow++    case result of+        Left WrongData -> failTest "Incorrect result read from file"+        Left ShouldThrow -> return ()+        Right _ | shouldFail -> failTest "Failed to throw exception"+                | otherwise -> return ()++    existsAfter <- doesFileExist testFile+    when existsAfter $ do+        removeFile testFile+        failTest "Failed to delete file"+  where+    testFile :: String+    testFile = "tmp"++    testData :: ByteString+    testData = "blah"++    runTest :: Benchmark -> IO (Either CheckResult ())+    runTest = withArgs (["-n","1"]) . try . C.defaultMainWith config . pure+      where+        config = C.defaultConfig { verbosity = Quiet , timeLimit = 1 }++    failTest :: String -> IO ()+    failTest s = assertFailure $ s ++ " in test: " ++ name ++ "!"++    resetHandle :: Handle -> IO ()+    resetHandle hnd = hSeek hnd AbsoluteSeek 0++    alloc :: IO Handle+    alloc = do+        hnd <- openFile testFile ReadWriteMode+        BS.hPut hnd testData+        resetHandle hnd+        return hnd++    clean :: Handle -> IO ()+    clean hnd = do+        hClose hnd+        removeFile testFile++testSuccess :: String -> BenchmarkWithFile -> TestTree+testSuccess = testCleanup False++testFailure :: String -> BenchmarkWithFile -> TestTree+testFailure = testCleanup True++main :: IO ()+main = defaultMain $ testGroup "cleanup"+    [ testSuccess "perRun Success" perRun+    , testFailure "perRun Failure" perRun+    , testSuccess "perBatch Success" perBatch+    , testFailure "perBatch Failure" perBatch+    , testSuccess "envWithCleanup Success" envWithCleanup+    , testFailure "envWithCleanup Failure" envWithCleanup+    ]

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-}  import Criterion.Main (bench, bgroup, env, whnf)@@ -10,6 +11,10 @@ import qualified Control.Exception as E import qualified Data.ByteString as B +#if !MIN_VERSION_bytestring(0,10,0)+import Control.DeepSeq (NFData (..))+#endif+ fib :: Int -> Int fib = sum . go   where go 0 = [0]@@ -53,3 +58,8 @@ getArgEnv =   fmap words (getEnv "ARGS") `E.catch`   \(_ :: E.SomeException) -> return []++#if !MIN_VERSION_bytestring(0,10,0)+instance NFData B.ByteString where+    rnf bs = bs `seq` ()+#endif

@@ -1,12 +1,10 @@-{-# LANGUAGE NegativeLiterals #-}- module Main (main) where  import Criterion.Types import qualified Data.Aeson as Aeson import qualified Data.Vector as V import Properties-import Statistics.Resampling.Bootstrap (Estimate(..))+import Statistics.Types (estimateFromErr, mkCL) import Test.Tasty (defaultMain, testGroup) import Test.Tasty.HUnit (testCase) import Test.HUnit@@ -16,7 +14,7 @@  where   m1 = Measured 4.613000783137977e-05 3.500000000000378e-05 31432 1 0 0 0 0.0 0.0 0.0 0.0   v1 = V.fromList [m1]-  est1 = Estimate 0.0 0.0 0.0 0.0+  est1 = estimateFromErr 0.0 (0.0, 0.0) (mkCL 0.0)   s1 = SampleAnalysis [] 0.0 est1 est1 (OutlierVariance Unaffected "" 0.0)  m2 :: Measured@@ -25,9 +23,9 @@               , measCycles = 6208               , measIters = 1 -              , measAllocated = -9223372036854775808-              , measNumGcs = -9223372036854775808-              , measBytesCopied = -9223372036854775808+              , measAllocated = minBound+              , measNumGcs = minBound+              , measBytesCopied = minBound                , measMutatorWallSeconds = -1/0               , measMutatorCpuSeconds = -1/0