{-# 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{..} <- Criterion Config
forall r (m :: * -> *). MonadReader r m => m r
ask
  (meas,timeTaken) <- liftIO $ runBenchmark bm timeLimit
  when (timeTaken > timeLimit * 1.25) .
    void $ prolix "measurement took %s\n" (secs timeTaken)
  return (Measurement i desc 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{..} <- Criterion Config
forall r (m :: * -> *). MonadReader r m => m r
ask
  _ <- prolix "analysing with %d resamples\n" resamples
  erp <- runExceptT $ analyseSample i desc meas
  case 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
reportNumber :: Int
reportName :: String
reportKeys :: [String]
reportMeasured :: Vector Measured
reportAnalysis :: SampleAnalysis
reportOutliers :: Outliers
reportKDEs :: [KDE]
reportKDEs :: Report -> [KDE]
reportOutliers :: Report -> Outliers
reportAnalysis :: Report -> SampleAnalysis
reportMeasured :: Report -> Vector Measured
reportKeys :: Report -> [String]
reportName :: Report -> String
reportNumber :: Report -> Int
..} -> do
      let SampleAnalysis{[Regression]
Estimate ConfInt Double
OutlierVariance
anRegress :: [Regression]
anMean :: Estimate ConfInt Double
anStdDev :: Estimate ConfInt Double
anOutlierVar :: OutlierVariance
anOutlierVar :: SampleAnalysis -> OutlierVariance
anStdDev :: SampleAnalysis -> Estimate ConfInt Double
anMean :: SampleAnalysis -> Estimate ConfInt Double
anRegress :: SampleAnalysis -> [Regression]
..} = SampleAnalysis
reportAnalysis
          OutlierVariance{Double
String
OutlierEffect
ovEffect :: OutlierEffect
ovDesc :: String
ovFraction :: Double
ovFraction :: OutlierVariance -> Double
ovDesc :: OutlierVariance -> String
ovEffect :: OutlierVariance -> 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
regResponder :: String
regCoeffs :: Map String (Estimate ConfInt Double)
regRSquare :: Estimate ConfInt Double
regRSquare :: Regression -> Estimate ConfInt Double
regCoeffs :: Regression -> Map String (Estimate ConfInt Double)
regResponder :: Regression -> 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 a. a -> Criterion a
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 a b. Criterion a -> Criterion b -> Criterion b
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 :: Regression -> Estimate ConfInt Double
regCoeffs :: Regression -> Map String (Estimate ConfInt Double)
regResponder :: Regression -> String
regResponder :: String
regCoeffs :: Map String (Estimate ConfInt Double)
regRSquare :: Estimate ConfInt Double
..} -> 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
        forM_ (Map.toList regCoeffs) $ \(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
        _ <- String -> Int -> String -> Criterion (ZonkAny 3)
forall r. CritHPrintfType r => String -> r
note String
"variance introduced by outliers: %d%% (%s)\n"
             (Double -> Int
forall b. Integral b => Double -> b
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
        return ()
      _ <- String -> Criterion (ZonkAny 0)
forall r. CritHPrintfType r => String -> r
note String
"\n"
      return (Analysed 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
estPoint :: forall (e :: * -> *) a. Estimate e a -> a
estPoint :: Double
estError :: ConfInt Double
estError :: forall (e :: * -> *) a. Estimate e a -> e 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 _ _ meas <- Int -> String -> Benchmarkable -> Criterion DataRecord
runOne Int
i String
desc Benchmarkable
bm
  analyseOne i desc 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
  mbJsonFile <- (Config -> Maybe String) -> Criterion (Maybe String)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Config -> Maybe String
jsonFile
  (jsonFile, handle) <- liftIO $
    case mbJsonFile of
      Maybe String
Nothing -> do
        tmpDir <- IO String
getTemporaryDirectory
        openTempFile tmpDir "criterion.json"
      Just String
file -> do
        handle <- String -> IOMode -> IO Handle
openFile String
file IOMode
WriteMode
        return (file, 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:
  liftIO $ hPutStr handle $ "[ \"" ++ headerRoot ++ "\", " ++
                             "\"" ++ critVersion ++ "\", [ "

  for select bs $ \Int
idx String
desc Benchmarkable
bm -> do
    _ <- String -> String -> Criterion (ZonkAny 5)
forall r. CritHPrintfType r => String -> r
note String
"benchmarking %s\n" String
desc
    Analysed rpt <- runAndAnalyseOne idx desc bm
    unless (idx == 0) $
      liftIO $ hPutStr handle ", "
    liftIO $ L.hPut handle (Aeson.encode (rpt::Report))

  liftIO $ hPutStr handle " ] ]\n"
  liftIO $ hClose handle

  rpts <- liftIO $ do
    res <- readJSONReports jsonFile
    case 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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Report]
rs
         Maybe String
_      -> String -> IO ()
removeFile String
jsonFile IO () -> IO [Report] -> IO [Report]
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Report] -> IO [Report]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Report]
rs

  rawReport rpts
  report rpts
  json rpts
  junit 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
  mbRawFile <- (Config -> Maybe String) -> Criterion (Maybe String)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Config -> Maybe String
rawDataFile
  case mbRawFile of
    Maybe String
Nothing   -> () -> Criterion ()
forall a. a -> Criterion a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just String
file -> IO () -> Criterion ()
forall a. IO a -> Criterion a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Criterion ()) -> IO () -> Criterion ()
forall a b. (a -> b) -> a -> b
$ do
      handle <- String -> IOMode -> IO Handle
openBinaryFile String
file IOMode
ReadWriteMode
      L.hPut handle header
      forM_ reports $ \Report
rpt ->
        Handle -> ByteString -> IO ()
L.hPut Handle
handle (Report -> ByteString
forall a. Binary a => a -> ByteString
Binary.encode Report
rpt)
      hClose 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
    _ <- String -> String -> Criterion (ZonkAny 1)
forall r. CritHPrintfType r => String -> r
note String
"benchmarking %s\n" String
desc
    liftIO $ runBenchmarkable_ bm 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) m Int -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> m ()
forall a. a -> m a
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
        e <- IO env -> m env
forall a. IO a -> m a
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
          ee <- IO env
mkenv
          evaluate (rnf ee)
          return ee
        go idx (pfx, mkbench e) `finally` liftIO (cleanenv e)
      | Bool
otherwise = Int -> m Int
forall a. a -> m a
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 a. a -> m a
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 a. a -> m a
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 jsonOpt <- (Config -> Maybe String) -> Criterion (Maybe String)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Config -> Maybe String
jsonFile
       case jsonOpt of
         Just String
fn -> IO () -> Criterion ()
forall a. IO a -> Criterion a
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 a. a -> Criterion a
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 junitOpt <- (Config -> Maybe String) -> Criterion (Maybe String)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Config -> Maybe String
junitFile
       case junitOpt of
         Just String
fn -> IO () -> Criterion ()
forall a. IO a -> Criterion a
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 a. a -> Criterion a
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 a. [a] -> 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 :: Report -> [KDE]
reportOutliers :: Report -> Outliers
reportAnalysis :: Report -> SampleAnalysis
reportMeasured :: Report -> Vector Measured
reportKeys :: Report -> [String]
reportName :: Report -> String
reportNumber :: Report -> Int
reportNumber :: Int
reportName :: String
reportKeys :: [String]
reportMeasured :: Vector Measured
reportAnalysis :: SampleAnalysis
reportOutliers :: Outliers
reportKDEs :: [KDE]
..} = 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]