{-# 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
..} <- forall r (m :: * -> *). MonadReader r m => m r
ask
  (Vector Measured
meas,Double
timeTaken) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Benchmarkable -> Double -> IO (Vector Measured, Double)
runBenchmark Benchmarkable
bm Double
timeLimit
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Double
timeTaken forall a. Ord a => a -> a -> Bool
> Double
timeLimit forall a. Num a => a -> a -> a
* Double
1.25) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall r. CritHPrintfType r => String -> r
prolix String
"measurement took %s\n" (Double -> String
secs Double
timeTaken)
  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
..} <- forall r (m :: * -> *). MonadReader r m => m r
ask
  Any
_ <- forall r. CritHPrintfType r => String -> r
prolix String
"analysing with %d resamples\n" Int
resamples
  Either String Report
erp <- forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT 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 -> 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) = forall a. Int -> [a] -> ([a], [a])
splitAt Int
1 [Regression]
anRegress
      let r2 :: t -> t
r2 t
n = forall r. PrintfType r => String -> r
printf String
"%.3f R\178" t
n
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Regression]
builtin 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 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 -> 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 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Double -> String)
-> String -> Estimate ConfInt Double -> Criterion ()
bs 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
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Regression]
others 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 forall {t} {t}. (PrintfArg t, PrintfType t) => t -> t
r2 (String
regResponder forall a. [a] -> [a] -> [a]
++ String
":") Estimate ConfInt Double
regRSquare
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall k a. Map k a -> [(k, a)]
Map.toList Map String (Estimate ConfInt Double)
regCoeffs) forall a b. (a -> b) -> a -> b
$ \(String
prd,Estimate ConfInt Double
val) ->
          (Double -> String)
-> String -> Estimate ConfInt Double -> Criterion ()
bs (forall r. PrintfType r => String -> r
printf String
"%.3g") (String
"  " forall a. [a] -> [a] -> [a]
++ String
prd) Estimate ConfInt Double
val
      forall a. ToRecord a => a -> Criterion ()
writeCsv
        (String
desc,
         forall (e :: * -> *) a. Estimate e a -> a
estPoint Estimate ConfInt Double
anMean,   forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. Num a => Estimate ConfInt a -> (a, a)
confidenceInterval Estimate ConfInt Double
anMean,   forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. Num a => Estimate ConfInt a -> (a, a)
confidenceInterval Estimate ConfInt Double
anMean,
         forall (e :: * -> *) a. Estimate e a -> a
estPoint Estimate ConfInt Double
anStdDev, forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. Num a => Estimate ConfInt a -> (a, a)
confidenceInterval Estimate ConfInt Double
anStdDev, forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. Num a => Estimate ConfInt a -> (a, a)
confidenceInterval Estimate ConfInt Double
anStdDev
        )
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Verbosity
verbosity forall a. Eq a => a -> a -> Bool
== Verbosity
Verbose Bool -> Bool -> Bool
|| (OutlierEffect
ovEffect forall a. Ord a => a -> a -> Bool
> OutlierEffect
Slight Bool -> Bool -> Bool
&& Verbosity
verbosity forall a. Ord a => a -> a -> Bool
> Verbosity
Quiet)) forall a b. (a -> b) -> a -> b
$ do
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Verbosity
verbosity forall a. Eq a => a -> a -> Bool
== Verbosity
Verbose) forall a b. (a -> b) -> a -> b
$ Outliers -> Criterion ()
noteOutliers Outliers
reportOutliers
        Any
_ <- forall r. CritHPrintfType r => String -> r
note String
"variance introduced by outliers: %d%% (%s)\n"
             (forall a b. (RealFrac a, Integral b) => a -> b
round (Double
ovFraction forall a. Num a => a -> a -> a
* Double
100) :: Int) String
wibble
        forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Any
_ <- forall r. CritHPrintfType r => String -> r
note String
"\n"
      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
..} =
              forall r. CritHPrintfType r => String -> r
note String
"%-20s %-10s (%s .. %s%s)\n" String
metric
                   (Double -> String
f Double
estPoint) (Double -> String
f forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. Num a => Estimate ConfInt a -> (a, a)
confidenceInterval Estimate ConfInt Double
e) (Double -> String
f forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. Num a => Estimate ConfInt a -> (a, a)
confidenceInterval Estimate ConfInt Double
e)
                   (let cl :: CL Double
cl = forall a. ConfInt a -> CL Double
confIntCL ConfInt Double
estError
                        str :: String
str | CL Double
cl forall a. Eq a => a -> a -> Bool
== forall a. Fractional a => CL a
cl95 = String
""
                            | Bool
otherwise  = forall r. PrintfType r => String -> r
printf String
", ci %.3f" (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 <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Config -> Maybe String
jsonFile
  (String
jsonFile, Handle
handle) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 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
        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:
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Handle -> String -> IO ()
hPutStr Handle
handle forall a b. (a -> b) -> a -> b
$ String
"[ \"" forall a. [a] -> [a] -> [a]
++ String
headerRoot forall a. [a] -> [a] -> [a]
++ String
"\", " forall a. [a] -> [a] -> [a]
++
                             String
"\"" forall a. [a] -> [a] -> [a]
++ String
critVersion forall a. [a] -> [a] -> [a]
++ String
"\", [ "

  forall (m :: * -> *).
(MonadMask m, MonadIO m) =>
(String -> Bool)
-> Benchmark -> (Int -> String -> Benchmarkable -> m ()) -> m ()
for String -> Bool
select Benchmark
bs forall a b. (a -> b) -> a -> b
$ \Int
idx String
desc Benchmarkable
bm -> do
    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
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
idx forall a. Eq a => a -> a -> Bool
== Int
0) forall a b. (a -> b) -> a -> b
$
      forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Handle -> String -> IO ()
hPutStr Handle
handle String
", "
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Handle -> ByteString -> IO ()
L.hPut Handle
handle (forall a. ToJSON a => a -> ByteString
Aeson.encode (Report
rpt::Report))

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

  [Report]
rpts <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 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 -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"error reading file "forall a. [a] -> [a] -> [a]
++String
jsonFileforall a. [a] -> [a] -> [a]
++String
":\n  "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
show String
err
      Right (String
_,String
_,[Report]
rs) ->
       case Maybe String
mbJsonFile of
         Just String
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return [Report]
rs
         Maybe String
_      -> String -> IO ()
removeFile String
jsonFile forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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 <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Config -> Maybe String
rawDataFile
  case Maybe String
mbRawFile of
    Maybe String
Nothing   -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just String
file -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 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
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Report]
reports forall a b. (a -> b) -> a -> b
$ \Report
rpt ->
        Handle -> ByteString -> IO ()
L.hPut Handle
handle (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 =
  forall (m :: * -> *).
(MonadMask m, MonadIO m) =>
(String -> Bool)
-> Benchmark -> (Int -> String -> Benchmarkable -> m ()) -> m ()
for String -> Bool
select Benchmark
bs forall a b. (a -> b) -> a -> b
$ \Int
_idx String
desc Benchmarkable
bm -> do
    Any
_ <- forall r. CritHPrintfType r => String -> r
note String
"benchmarking %s\n" String
desc
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 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 :: forall (m :: * -> *).
(MonadMask m, MonadIO m) =>
(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) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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)
      | forall {a}. String -> (a -> Benchmark) -> Bool
shouldRun String
pfx env -> Benchmark
mkbench = do
        env
e <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
          env
ee <- IO env
mkenv
          forall a. a -> IO a
evaluate (forall a. NFData a => a -> ()
rnf env
ee)
          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) forall (m :: * -> *) a b. MonadMask m => m a -> m b -> m a
`finally` forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (env -> IO a
cleanenv env
e)
      | Bool
otherwise = 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; forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Int
idx forall a. Num a => a -> a -> a
+ Int
1
      | Bool
otherwise    = 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) =
      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 =
      forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> Bool
select forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
addPrefix String
pfx) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Benchmark -> [String]
benchNames forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Benchmark
mkbench forall a b. (a -> b) -> a -> b
$ forall env. env
fakeEnvironment

-- | Write summary JSON file (if applicable)
json :: [Report] -> Criterion ()
json :: [Report] -> Criterion ()
json [Report]
rs
  = do Maybe String
jsonOpt <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Config -> Maybe String
jsonFile
       case Maybe String
jsonOpt of
         Just String
fn -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> [Report] -> IO ()
writeJSONReports String
fn [Report]
rs
         Maybe String
Nothing -> 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 <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Config -> Maybe String
junitFile
       case Maybe String
junitOpt of
         Just String
fn -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
writeFile String
fn String
msg
         Maybe String
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
  where
    msg :: String
msg = String
"<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n" forall a. [a] -> [a] -> [a]
++
          forall r. PrintfType r => String -> r
printf String
"<testsuite name=\"Criterion benchmarks\" tests=\"%d\">\n"
          (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Report]
rs) forall a. [a] -> [a] -> [a]
++
          forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {t}. PrintfType t => Report -> t
single [Report]
rs 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
..} = forall r. PrintfType r => String -> r
printf String
"  <testcase name=\"%s\" time=\"%f\" />\n"
               (String -> String
attrEsc String
reportName) (forall (e :: * -> *) a. Estimate e a -> a
estPoint forall a b. (a -> b) -> a -> b
$ SampleAnalysis -> Estimate ConfInt Double
anMean forall a b. (a -> b) -> a -> b
$ SampleAnalysis
reportAnalysis)
    attrEsc :: String -> String
attrEsc = 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]