{-# LANGUAGE BangPatterns, RecordWildCards #-}
-- |
-- Module      : Criterion
-- Copyright   : (c) 2009-2014 Bryan O'Sullivan
--
-- License     : BSD-style
-- Maintainer  : bos@serpentine.com
-- Stability   : experimental
-- Portability : GHC
--
-- Core benchmarking code.

module Criterion.Internal
    (
      runAndAnalyse
    , runAndAnalyseOne
    , runOne
    , runFixedIters
    ) where

import qualified Data.Aeson as Aeson
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 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, runBenchmarkable_, secs)
import Criterion.Monad (Criterion)
import Criterion.Report (report)
import Criterion.Types hiding (measure)
import Criterion.Measurement.Types.Internal (fakeEnvironment)
import qualified Data.Map as Map
import qualified Data.Vector as V
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)

-- | Run a single benchmark.
runOne :: Int -> String -> Benchmarkable -> Criterion DataRecord
runOne :: Int -> String -> Benchmarkable -> Criterion DataRecord
runOne Int
i String
desc Benchmarkable
bm = do
  Config{Double
Int
String
[([String], String)]
Maybe String
CL Double
Verbosity
template :: Config -> String
verbosity :: Config -> Verbosity
junitFile :: Config -> Maybe String
jsonFile :: Config -> Maybe String
csvFile :: Config -> Maybe String
reportFile :: Config -> Maybe String
rawDataFile :: Config -> Maybe String
regressions :: Config -> [([String], String)]
resamples :: Config -> Int
timeLimit :: Config -> Double
confInterval :: Config -> CL Double
template :: String
verbosity :: Verbosity
junitFile :: Maybe String
jsonFile :: Maybe String
csvFile :: Maybe String
reportFile :: Maybe String
rawDataFile :: Maybe String
regressions :: [([String], String)]
resamples :: Int
timeLimit :: Double
confInterval :: CL Double
..} <- Criterion Config
forall r (m :: * -> *). MonadReader r m => m r
ask
  (Vector Measured
meas,Double
timeTaken) <- IO (Vector Measured, Double) -> Criterion (Vector Measured, Double)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Vector Measured, Double)
 -> Criterion (Vector Measured, Double))
-> IO (Vector Measured, Double)
-> Criterion (Vector Measured, Double)
forall a b. (a -> b) -> a -> b
$ Benchmarkable -> Double -> IO (Vector Measured, Double)
runBenchmark Benchmarkable
bm Double
timeLimit
  Bool -> Criterion () -> Criterion ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Double
timeTaken Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
timeLimit Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1.25) (Criterion () -> Criterion ())
-> (Criterion Any -> Criterion ()) -> Criterion Any -> Criterion ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Criterion Any -> Criterion ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Criterion Any -> Criterion ()) -> Criterion Any -> Criterion ()
forall a b. (a -> b) -> a -> b
$ String -> String -> Criterion Any
forall r. CritHPrintfType r => String -> r
prolix String
"measurement took %s\n" (Double -> String
secs Double
timeTaken)
  DataRecord -> Criterion DataRecord
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> String -> Vector Measured -> DataRecord
Measurement Int
i String
desc Vector Measured
meas)

-- | Analyse a single benchmark.
analyseOne :: Int -> String -> V.Vector Measured -> Criterion DataRecord
analyseOne :: Int -> String -> Vector Measured -> Criterion DataRecord
analyseOne Int
i String
desc Vector Measured
meas = do
  Config{Double
Int
String
[([String], String)]
Maybe String
CL Double
Verbosity
template :: String
verbosity :: Verbosity
junitFile :: Maybe String
jsonFile :: Maybe String
csvFile :: Maybe String
reportFile :: Maybe String
rawDataFile :: Maybe String
regressions :: [([String], String)]
resamples :: Int
timeLimit :: Double
confInterval :: CL Double
template :: Config -> String
verbosity :: Config -> Verbosity
junitFile :: Config -> Maybe String
jsonFile :: Config -> Maybe String
csvFile :: Config -> Maybe String
reportFile :: Config -> Maybe String
rawDataFile :: Config -> Maybe String
regressions :: Config -> [([String], String)]
resamples :: Config -> Int
timeLimit :: Config -> Double
confInterval :: Config -> CL Double
..} <- Criterion Config
forall r (m :: * -> *). MonadReader r m => m r
ask
  Any
_ <- String -> Int -> Criterion Any
forall r. CritHPrintfType r => String -> r
prolix String
"analysing with %d resamples\n" Int
resamples
  Either String Report
erp <- ExceptT String Criterion Report -> Criterion (Either String Report)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT String Criterion Report
 -> Criterion (Either String Report))
-> ExceptT String Criterion Report
-> Criterion (Either String Report)
forall a b. (a -> b) -> a -> b
$ Int -> String -> Vector Measured -> ExceptT String Criterion Report
analyseSample Int
i String
desc Vector Measured
meas
  case Either String Report
erp of
    Left String
err -> String -> String -> Criterion DataRecord
forall r. CritHPrintfType r => String -> r
printError String
"*** Error: %s\n" String
err
    Right rpt :: Report
rpt@Report{Int
String
[String]
[KDE]
Vector Measured
SampleAnalysis
Outliers
reportKDEs :: Report -> [KDE]
reportOutliers :: Report -> Outliers
reportAnalysis :: Report -> SampleAnalysis
reportMeasured :: Report -> Vector Measured
reportKeys :: Report -> [String]
reportName :: Report -> String
reportNumber :: Report -> Int
reportKDEs :: [KDE]
reportOutliers :: Outliers
reportAnalysis :: SampleAnalysis
reportMeasured :: Vector Measured
reportKeys :: [String]
reportName :: String
reportNumber :: Int
..} -> do
      let SampleAnalysis{[Regression]
Estimate ConfInt Double
OutlierVariance
anOutlierVar :: SampleAnalysis -> OutlierVariance
anStdDev :: SampleAnalysis -> Estimate ConfInt Double
anMean :: SampleAnalysis -> Estimate ConfInt Double
anRegress :: SampleAnalysis -> [Regression]
anOutlierVar :: OutlierVariance
anStdDev :: Estimate ConfInt Double
anMean :: Estimate ConfInt Double
anRegress :: [Regression]
..} = SampleAnalysis
reportAnalysis
          OutlierVariance{Double
String
OutlierEffect
ovFraction :: OutlierVariance -> Double
ovDesc :: OutlierVariance -> String
ovEffect :: OutlierVariance -> OutlierEffect
ovFraction :: Double
ovDesc :: String
ovEffect :: OutlierEffect
..} = OutlierVariance
anOutlierVar
          wibble :: String
wibble = case OutlierEffect
ovEffect of
                     OutlierEffect
Unaffected -> String
"unaffected" :: String
                     OutlierEffect
Slight -> String
"slightly inflated"
                     OutlierEffect
Moderate -> String
"moderately inflated"
                     OutlierEffect
Severe -> String
"severely inflated"
          ([Regression]
builtin, [Regression]
others) = Int -> [Regression] -> ([Regression], [Regression])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
1 [Regression]
anRegress
      let r2 :: t -> t
r2 t
n = String -> t -> t
forall r. PrintfType r => String -> r
printf String
"%.3f R\178" t
n
      [Regression] -> (Regression -> Criterion ()) -> Criterion ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Regression]
builtin ((Regression -> Criterion ()) -> Criterion ())
-> (Regression -> Criterion ()) -> Criterion ()
forall a b. (a -> b) -> a -> b
$ \Regression{String
Map String (Estimate ConfInt Double)
Estimate ConfInt Double
regRSquare :: Regression -> Estimate ConfInt Double
regCoeffs :: Regression -> Map String (Estimate ConfInt Double)
regResponder :: Regression -> String
regRSquare :: Estimate ConfInt Double
regCoeffs :: Map String (Estimate ConfInt Double)
regResponder :: String
..} ->
        case String
-> Map String (Estimate ConfInt Double)
-> Maybe (Estimate ConfInt Double)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
"iters" Map String (Estimate ConfInt Double)
regCoeffs of
          Maybe (Estimate ConfInt Double)
Nothing -> () -> Criterion ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Just Estimate ConfInt Double
t  -> (Double -> String)
-> String -> Estimate ConfInt Double -> Criterion ()
bs Double -> String
secs String
"time" Estimate ConfInt Double
t Criterion () -> Criterion () -> Criterion ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Double -> String)
-> String -> Estimate ConfInt Double -> Criterion ()
bs Double -> String
forall t t. (PrintfArg t, PrintfType t) => t -> t
r2 String
"" Estimate ConfInt Double
regRSquare
      (Double -> String)
-> String -> Estimate ConfInt Double -> Criterion ()
bs Double -> String
secs String
"mean" Estimate ConfInt Double
anMean
      (Double -> String)
-> String -> Estimate ConfInt Double -> Criterion ()
bs Double -> String
secs String
"std dev" Estimate ConfInt Double
anStdDev
      [Regression] -> (Regression -> Criterion ()) -> Criterion ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Regression]
others ((Regression -> Criterion ()) -> Criterion ())
-> (Regression -> Criterion ()) -> Criterion ()
forall a b. (a -> b) -> a -> b
$ \Regression{String
Map String (Estimate ConfInt Double)
Estimate ConfInt Double
regRSquare :: Estimate ConfInt Double
regCoeffs :: Map String (Estimate ConfInt Double)
regResponder :: String
regRSquare :: Regression -> Estimate ConfInt Double
regCoeffs :: Regression -> Map String (Estimate ConfInt Double)
regResponder :: Regression -> String
..} -> do
        ()
_ <- (Double -> String)
-> String -> Estimate ConfInt Double -> Criterion ()
bs Double -> String
forall t t. (PrintfArg t, PrintfType t) => t -> t
r2 (String
regResponder String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":") Estimate ConfInt Double
regRSquare
        [(String, Estimate ConfInt Double)]
-> ((String, Estimate ConfInt Double) -> Criterion ())
-> Criterion ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map String (Estimate ConfInt Double)
-> [(String, Estimate ConfInt Double)]
forall k a. Map k a -> [(k, a)]
Map.toList Map String (Estimate ConfInt Double)
regCoeffs) (((String, Estimate ConfInt Double) -> Criterion ())
 -> Criterion ())
-> ((String, Estimate ConfInt Double) -> Criterion ())
-> Criterion ()
forall a b. (a -> b) -> a -> b
$ \(String
prd,Estimate ConfInt Double
val) ->
          (Double -> String)
-> String -> Estimate ConfInt Double -> Criterion ()
bs (String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%.3g") (String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
prd) Estimate ConfInt Double
val
      (String, Double, Double, Double, Double, Double, Double)
-> Criterion ()
forall a. ToRecord a => a -> Criterion ()
writeCsv
        (String
desc,
         Estimate ConfInt Double -> Double
forall (e :: * -> *) a. Estimate e a -> a
estPoint Estimate ConfInt Double
anMean,   (Double, Double) -> Double
forall a b. (a, b) -> a
fst ((Double, Double) -> Double) -> (Double, Double) -> Double
forall a b. (a -> b) -> a -> b
$ Estimate ConfInt Double -> (Double, Double)
forall a. Num a => Estimate ConfInt a -> (a, a)
confidenceInterval Estimate ConfInt Double
anMean,   (Double, Double) -> Double
forall a b. (a, b) -> b
snd ((Double, Double) -> Double) -> (Double, Double) -> Double
forall a b. (a -> b) -> a -> b
$ Estimate ConfInt Double -> (Double, Double)
forall a. Num a => Estimate ConfInt a -> (a, a)
confidenceInterval Estimate ConfInt Double
anMean,
         Estimate ConfInt Double -> Double
forall (e :: * -> *) a. Estimate e a -> a
estPoint Estimate ConfInt Double
anStdDev, (Double, Double) -> Double
forall a b. (a, b) -> a
fst ((Double, Double) -> Double) -> (Double, Double) -> Double
forall a b. (a -> b) -> a -> b
$ Estimate ConfInt Double -> (Double, Double)
forall a. Num a => Estimate ConfInt a -> (a, a)
confidenceInterval Estimate ConfInt Double
anStdDev, (Double, Double) -> Double
forall a b. (a, b) -> b
snd ((Double, Double) -> Double) -> (Double, Double) -> Double
forall a b. (a -> b) -> a -> b
$ Estimate ConfInt Double -> (Double, Double)
forall a. Num a => Estimate ConfInt a -> (a, a)
confidenceInterval Estimate ConfInt Double
anStdDev
        )
      Bool -> Criterion () -> Criterion ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Verbosity
verbosity Verbosity -> Verbosity -> Bool
forall a. Eq a => a -> a -> Bool
== Verbosity
Verbose Bool -> Bool -> Bool
|| (OutlierEffect
ovEffect OutlierEffect -> OutlierEffect -> Bool
forall a. Ord a => a -> a -> Bool
> OutlierEffect
Slight Bool -> Bool -> Bool
&& Verbosity
verbosity Verbosity -> Verbosity -> Bool
forall a. Ord a => a -> a -> Bool
> Verbosity
Quiet)) (Criterion () -> Criterion ()) -> Criterion () -> Criterion ()
forall a b. (a -> b) -> a -> b
$ do
        Bool -> Criterion () -> Criterion ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Verbosity
verbosity Verbosity -> Verbosity -> Bool
forall a. Eq a => a -> a -> Bool
== Verbosity
Verbose) (Criterion () -> Criterion ()) -> Criterion () -> Criterion ()
forall a b. (a -> b) -> a -> b
$ Outliers -> Criterion ()
noteOutliers Outliers
reportOutliers
        Any
_ <- String -> Int -> String -> Criterion Any
forall r. CritHPrintfType r => String -> r
note String
"variance introduced by outliers: %d%% (%s)\n"
             (Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Double
ovFraction Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
100) :: Int) String
wibble
        () -> Criterion ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Any
_ <- String -> Criterion Any
forall r. CritHPrintfType r => String -> r
note String
"\n"
      DataRecord -> Criterion DataRecord
forall (m :: * -> *) a. Monad m => a -> m a
return (Report -> DataRecord
Analysed Report
rpt)
      where bs :: (Double -> String) -> String -> Estimate ConfInt Double -> Criterion ()
            bs :: (Double -> String)
-> String -> Estimate ConfInt Double -> Criterion ()
bs Double -> String
f String
metric e :: Estimate ConfInt Double
e@Estimate{Double
ConfInt Double
estError :: forall (e :: * -> *) a. Estimate e a -> e a
estError :: ConfInt Double
estPoint :: Double
estPoint :: forall (e :: * -> *) a. Estimate e a -> a
..} =
              String
-> String -> String -> String -> String -> String -> Criterion ()
forall r. CritHPrintfType r => String -> r
note String
"%-20s %-10s (%s .. %s%s)\n" String
metric
                   (Double -> String
f Double
estPoint) (Double -> String
f (Double -> String) -> Double -> String
forall a b. (a -> b) -> a -> b
$ (Double, Double) -> Double
forall a b. (a, b) -> a
fst ((Double, Double) -> Double) -> (Double, Double) -> Double
forall a b. (a -> b) -> a -> b
$ Estimate ConfInt Double -> (Double, Double)
forall a. Num a => Estimate ConfInt a -> (a, a)
confidenceInterval Estimate ConfInt Double
e) (Double -> String
f (Double -> String) -> Double -> String
forall a b. (a -> b) -> a -> b
$ (Double, Double) -> Double
forall a b. (a, b) -> b
snd ((Double, Double) -> Double) -> (Double, Double) -> Double
forall a b. (a -> b) -> a -> b
$ Estimate ConfInt Double -> (Double, Double)
forall a. Num a => Estimate ConfInt a -> (a, a)
confidenceInterval Estimate ConfInt Double
e)
                   (let cl :: CL Double
cl = ConfInt Double -> CL Double
forall a. ConfInt a -> CL Double
confIntCL ConfInt Double
estError
                        str :: String
str | CL Double
cl CL Double -> CL Double -> Bool
forall a. Eq a => a -> a -> Bool
== CL Double
forall a. Fractional a => CL a
cl95 = String
""
                            | Bool
otherwise  = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
", ci %.3f" (CL Double -> Double
forall a. Num a => CL a -> a
confidenceLevel CL Double
cl)
                    in String
str
                   )


-- | Run a single benchmark and analyse its performance.
runAndAnalyseOne :: Int -> String -> Benchmarkable -> Criterion DataRecord
runAndAnalyseOne :: Int -> String -> Benchmarkable -> Criterion DataRecord
runAndAnalyseOne Int
i String
desc Benchmarkable
bm = do
  Measurement Int
_ String
_ Vector Measured
meas <- Int -> String -> Benchmarkable -> Criterion DataRecord
runOne Int
i String
desc Benchmarkable
bm
  Int -> String -> Vector Measured -> Criterion DataRecord
analyseOne Int
i String
desc Vector Measured
meas

-- | Run, and analyse, one or more benchmarks.
runAndAnalyse :: (String -> Bool) -- ^ A predicate that chooses
                                  -- whether to run a benchmark by its
                                  -- name.
              -> Benchmark
              -> Criterion ()
runAndAnalyse :: (String -> Bool) -> Benchmark -> Criterion ()
runAndAnalyse String -> Bool
select Benchmark
bs = do
  Maybe String
mbJsonFile <- (Config -> Maybe String) -> Criterion (Maybe String)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Config -> Maybe String
jsonFile
  (String
jsonFile, Handle
handle) <- IO (String, Handle) -> Criterion (String, Handle)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (String, Handle) -> Criterion (String, Handle))
-> IO (String, Handle) -> Criterion (String, Handle)
forall a b. (a -> b) -> a -> b
$
    case Maybe String
mbJsonFile of
      Maybe String
Nothing -> do
        String
tmpDir <- IO String
getTemporaryDirectory
        String -> String -> IO (String, Handle)
openTempFile String
tmpDir String
"criterion.json"
      Just String
file -> do
        Handle
handle <- String -> IOMode -> IO Handle
openFile String
file IOMode
WriteMode
        (String, Handle) -> IO (String, Handle)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
file, Handle
handle)
  -- 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:
  IO () -> Criterion ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Criterion ()) -> IO () -> Criterion ()
forall a b. (a -> b) -> a -> b
$ Handle -> String -> IO ()
hPutStr Handle
handle (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"[ \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
headerRoot String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\", " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                             String
"\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
critVersion String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\", [ "

  (String -> Bool)
-> Benchmark
-> (Int -> String -> Benchmarkable -> Criterion ())
-> Criterion ()
forall (m :: * -> *).
(MonadMask m, MonadIO m) =>
(String -> Bool)
-> Benchmark -> (Int -> String -> Benchmarkable -> m ()) -> m ()
for String -> Bool
select Benchmark
bs ((Int -> String -> Benchmarkable -> Criterion ()) -> Criterion ())
-> (Int -> String -> Benchmarkable -> Criterion ()) -> Criterion ()
forall a b. (a -> b) -> a -> b
$ \Int
idx String
desc Benchmarkable
bm -> do
    Any
_ <- String -> String -> Criterion Any
forall r. CritHPrintfType r => String -> r
note String
"benchmarking %s\n" String
desc
    Analysed Report
rpt <- Int -> String -> Benchmarkable -> Criterion DataRecord
runAndAnalyseOne Int
idx String
desc Benchmarkable
bm
    Bool -> Criterion () -> Criterion ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
idx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (Criterion () -> Criterion ()) -> Criterion () -> Criterion ()
forall a b. (a -> b) -> a -> b
$
      IO () -> Criterion ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Criterion ()) -> IO () -> Criterion ()
forall a b. (a -> b) -> a -> b
$ Handle -> String -> IO ()
hPutStr Handle
handle String
", "
    IO () -> Criterion ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Criterion ()) -> IO () -> Criterion ()
forall a b. (a -> b) -> a -> b
$ Handle -> ByteString -> IO ()
L.hPut Handle
handle (Report -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode (Report
rpt::Report))

  IO () -> Criterion ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Criterion ()) -> IO () -> Criterion ()
forall a b. (a -> b) -> a -> b
$ Handle -> String -> IO ()
hPutStr Handle
handle String
" ] ]\n"
  IO () -> Criterion ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Criterion ()) -> IO () -> Criterion ()
forall a b. (a -> b) -> a -> b
$ Handle -> IO ()
hClose Handle
handle

  [Report]
rpts <- IO [Report] -> Criterion [Report]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Report] -> Criterion [Report])
-> IO [Report] -> Criterion [Report]
forall a b. (a -> b) -> a -> b
$ do
    Either String ReportFileContents
res <- String -> IO (Either String ReportFileContents)
readJSONReports String
jsonFile
    case Either String ReportFileContents
res of
      Left String
err -> String -> IO [Report]
forall a. HasCallStack => String -> a
error (String -> IO [Report]) -> String -> IO [Report]
forall a b. (a -> b) -> a -> b
$ String
"error reading file "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
jsonFileString -> String -> String
forall a. [a] -> [a] -> [a]
++String
":\n  "String -> String -> String
forall a. [a] -> [a] -> [a]
++String -> String
forall a. Show a => a -> String
show String
err
      Right (String
_,String
_,[Report]
rs) ->
       case Maybe String
mbJsonFile of
         Just String
_ -> [Report] -> IO [Report]
forall (m :: * -> *) a. Monad m => a -> m a
return [Report]
rs
         Maybe String
_      -> String -> IO ()
removeFile String
jsonFile IO () -> IO [Report] -> IO [Report]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Report] -> IO [Report]
forall (m :: * -> *) a. Monad m => a -> m a
return [Report]
rs

  [Report] -> Criterion ()
rawReport [Report]
rpts
  [Report] -> Criterion ()
report [Report]
rpts
  [Report] -> Criterion ()
json [Report]
rpts
  [Report] -> Criterion ()
junit [Report]
rpts


-- | Write out raw binary report files.  This has some bugs, including and not
-- limited to #68, and may be slated for deprecation.
rawReport :: [Report] -> Criterion ()
rawReport :: [Report] -> Criterion ()
rawReport [Report]
reports = do
  Maybe String
mbRawFile <- (Config -> Maybe String) -> Criterion (Maybe String)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Config -> Maybe String
rawDataFile
  case Maybe String
mbRawFile of
    Maybe String
Nothing   -> () -> Criterion ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just String
file -> IO () -> Criterion ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Criterion ()) -> IO () -> Criterion ()
forall a b. (a -> b) -> a -> b
$ do
      Handle
handle <- String -> IOMode -> IO Handle
openBinaryFile String
file IOMode
ReadWriteMode
      Handle -> ByteString -> IO ()
L.hPut Handle
handle ByteString
header
      [Report] -> (Report -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Report]
reports ((Report -> IO ()) -> IO ()) -> (Report -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Report
rpt ->
        Handle -> ByteString -> IO ()
L.hPut Handle
handle (Report -> ByteString
forall a. Binary a => a -> ByteString
Binary.encode Report
rpt)
      Handle -> IO ()
hClose Handle
handle


-- | Run a benchmark without analysing its performance.
runFixedIters :: Int64            -- ^ Number of loop iterations to run.
              -> (String -> Bool) -- ^ A predicate that chooses
                                  -- whether to run a benchmark by its
                                  -- name.
              -> Benchmark
              -> Criterion ()
runFixedIters :: Int64 -> (String -> Bool) -> Benchmark -> Criterion ()
runFixedIters Int64
iters String -> Bool
select Benchmark
bs =
  (String -> Bool)
-> Benchmark
-> (Int -> String -> Benchmarkable -> Criterion ())
-> Criterion ()
forall (m :: * -> *).
(MonadMask m, MonadIO m) =>
(String -> Bool)
-> Benchmark -> (Int -> String -> Benchmarkable -> m ()) -> m ()
for String -> Bool
select Benchmark
bs ((Int -> String -> Benchmarkable -> Criterion ()) -> Criterion ())
-> (Int -> String -> Benchmarkable -> Criterion ()) -> Criterion ()
forall a b. (a -> b) -> a -> b
$ \Int
_idx String
desc Benchmarkable
bm -> do
    Any
_ <- String -> String -> Criterion Any
forall r. CritHPrintfType r => String -> r
note String
"benchmarking %s\n" String
desc
    IO () -> Criterion ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Criterion ()) -> IO () -> Criterion ()
forall a b. (a -> b) -> a -> b
$ Benchmarkable -> Int64 -> IO ()
runBenchmarkable_ Benchmarkable
bm Int64
iters

-- | Iterate over benchmarks.
for :: (MonadMask m, MonadIO m) => (String -> Bool) -> Benchmark
    -> (Int -> String -> Benchmarkable -> m ()) -> m ()
for :: (String -> Bool)
-> Benchmark -> (Int -> String -> Benchmarkable -> m ()) -> m ()
for String -> Bool
select Benchmark
bs0 Int -> String -> Benchmarkable -> m ()
handle = Int -> (String, Benchmark) -> m Int
go (Int
0::Int) (String
"", Benchmark
bs0) m Int -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  where
    go :: Int -> (String, Benchmark) -> m Int
go !Int
idx (String
pfx, Environment IO env
mkenv env -> IO a
cleanenv env -> Benchmark
mkbench)
      | String -> (env -> Benchmark) -> Bool
forall a. String -> (a -> Benchmark) -> Bool
shouldRun String
pfx env -> Benchmark
mkbench = do
        env
e <- IO env -> m env
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO env -> m env) -> IO env -> m env
forall a b. (a -> b) -> a -> b
$ do
          env
ee <- IO env
mkenv
          () -> IO ()
forall a. a -> IO a
evaluate (env -> ()
forall a. NFData a => a -> ()
rnf env
ee)
          env -> IO env
forall (m :: * -> *) a. Monad m => a -> m a
return env
ee
        Int -> (String, Benchmark) -> m Int
go Int
idx (String
pfx, env -> Benchmark
mkbench env
e) m Int -> m a -> m Int
forall (m :: * -> *) a b. MonadMask m => m a -> m b -> m a
`finally` IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (env -> IO a
cleanenv env
e)
      | Bool
otherwise = Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
idx
    go Int
idx (String
pfx, Benchmark String
desc Benchmarkable
b)
      | String -> Bool
select String
desc' = do Int -> String -> Benchmarkable -> m ()
handle Int
idx String
desc' Benchmarkable
b; Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> m Int) -> Int -> m Int
forall a b. (a -> b) -> a -> b
$! Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
      | Bool
otherwise    = Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
idx
      where desc' :: String
desc' = String -> String -> String
addPrefix String
pfx String
desc
    go Int
idx (String
pfx, BenchGroup String
desc [Benchmark]
bs) =
      (Int -> (String, Benchmark) -> m Int)
-> Int -> [(String, Benchmark)] -> m Int
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Int -> (String, Benchmark) -> m Int
go Int
idx [(String -> String -> String
addPrefix String
pfx String
desc, Benchmark
b) | Benchmark
b <- [Benchmark]
bs]

    shouldRun :: String -> (a -> Benchmark) -> Bool
shouldRun String
pfx a -> Benchmark
mkbench =
      (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> Bool
select (String -> Bool) -> (String -> String) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
addPrefix String
pfx) ([String] -> Bool) -> (a -> [String]) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Benchmark -> [String]
benchNames (Benchmark -> [String]) -> (a -> Benchmark) -> a -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Benchmark
mkbench (a -> Bool) -> a -> Bool
forall a b. (a -> b) -> a -> b
$ a
forall env. env
fakeEnvironment

-- | Write summary JSON file (if applicable)
json :: [Report] -> Criterion ()
json :: [Report] -> Criterion ()
json [Report]
rs
  = do Maybe String
jsonOpt <- (Config -> Maybe String) -> Criterion (Maybe String)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Config -> Maybe String
jsonFile
       case Maybe String
jsonOpt of
         Just String
fn -> IO () -> Criterion ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Criterion ()) -> IO () -> Criterion ()
forall a b. (a -> b) -> a -> b
$ String -> [Report] -> IO ()
writeJSONReports String
fn [Report]
rs
         Maybe String
Nothing -> () -> Criterion ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Write summary JUnit file (if applicable)
junit :: [Report] -> Criterion ()
junit :: [Report] -> Criterion ()
junit [Report]
rs
  = do Maybe String
junitOpt <- (Config -> Maybe String) -> Criterion (Maybe String)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Config -> Maybe String
junitFile
       case Maybe String
junitOpt of
         Just String
fn -> IO () -> Criterion ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Criterion ()) -> IO () -> Criterion ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
writeFile String
fn String
msg
         Maybe String
Nothing -> () -> Criterion ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  where
    msg :: String
msg = String
"<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
          String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"<testsuite name=\"Criterion benchmarks\" tests=\"%d\">\n"
          ([Report] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Report]
rs) String -> String -> String
forall a. [a] -> [a] -> [a]
++
          (Report -> String) -> [Report] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Report -> String
forall t. PrintfType t => Report -> t
single [Report]
rs String -> String -> String
forall a. [a] -> [a] -> [a]
++
          String
"</testsuite>\n"
    single :: Report -> t
single Report{Int
String
[String]
[KDE]
Vector Measured
SampleAnalysis
Outliers
reportKDEs :: [KDE]
reportOutliers :: Outliers
reportAnalysis :: SampleAnalysis
reportMeasured :: Vector Measured
reportKeys :: [String]
reportName :: String
reportNumber :: Int
reportKDEs :: Report -> [KDE]
reportOutliers :: Report -> Outliers
reportAnalysis :: Report -> SampleAnalysis
reportMeasured :: Report -> Vector Measured
reportKeys :: Report -> [String]
reportName :: Report -> String
reportNumber :: Report -> Int
..} = String -> String -> Double -> t
forall r. PrintfType r => String -> r
printf String
"  <testcase name=\"%s\" time=\"%f\" />\n"
               (String -> String
attrEsc String
reportName) (Estimate ConfInt Double -> Double
forall (e :: * -> *) a. Estimate e a -> a
estPoint (Estimate ConfInt Double -> Double)
-> Estimate ConfInt Double -> Double
forall a b. (a -> b) -> a -> b
$ SampleAnalysis -> Estimate ConfInt Double
anMean (SampleAnalysis -> Estimate ConfInt Double)
-> SampleAnalysis -> Estimate ConfInt Double
forall a b. (a -> b) -> a -> b
$ SampleAnalysis
reportAnalysis)
    attrEsc :: String -> String
attrEsc = (Char -> String) -> String -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
esc
      where
        esc :: Char -> String
esc Char
'\'' = String
"&apos;"
        esc Char
'"'  = String
"&quot;"
        esc Char
'<'  = String
"&lt;"
        esc Char
'>'  = String
"&gt;"
        esc Char
'&'  = String
"&amp;"
        esc Char
c    = [Char
c]