    {-# 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
    confInterval :: CL Double
    timeLimit :: Double
    resamples :: Int
    regressions :: [([String], String)]
    rawDataFile :: Maybe String
    reportFile :: Maybe String
    csvFile :: Maybe String
    jsonFile :: Maybe String
    junitFile :: Maybe String
    verbosity :: Verbosity
    template :: String
    confInterval :: Config -> CL Double
    timeLimit :: Config -> Double
    resamples :: Config -> Int
    regressions :: Config -> [([String], String)]
    rawDataFile :: Config -> Maybe String
    reportFile :: Config -> Maybe String
    csvFile :: Config -> Maybe String
    jsonFile :: Config -> Maybe String
    junitFile :: Config -> Maybe String
    verbosity :: Config -> Verbosity
    template :: Config -> String
    ..} <- 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 a. IO a -> Criterion a
    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 a. a -> Criterion a
    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
    confInterval :: Config -> CL Double
    timeLimit :: Config -> Double
    resamples :: Config -> Int
    regressions :: Config -> [([String], String)]
    rawDataFile :: Config -> Maybe String
    reportFile :: Config -> Maybe String
    csvFile :: Config -> Maybe String
    jsonFile :: Config -> Maybe String
    junitFile :: Config -> Maybe String
    verbosity :: Config -> Verbosity
    template :: Config -> String
    confInterval :: CL Double
    timeLimit :: Double
    resamples :: Int
    regressions :: [([String], String)]
    rawDataFile :: Maybe String
    reportFile :: Maybe String
    csvFile :: Maybe String
    jsonFile :: Maybe String
    junitFile :: Maybe String
    verbosity :: Verbosity
    template :: String
    ..} <- 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
    reportNumber :: Int
    reportName :: String
    reportKeys :: [String]
    reportMeasured :: Vector Measured
    reportAnalysis :: SampleAnalysis
    reportOutliers :: Outliers
    reportKDEs :: [KDE]
    reportNumber :: Report -> Int
    reportName :: Report -> String
    reportKeys :: Report -> [String]
    reportMeasured :: Report -> Vector Measured
    reportAnalysis :: Report -> SampleAnalysis
    reportOutliers :: Report -> Outliers
    reportKDEs :: Report -> [KDE]
    ..} -> do
          let SampleAnalysis{[Regression]
    Estimate ConfInt Double
    OutlierVariance
    anRegress :: [Regression]
    anMean :: Estimate ConfInt Double
    anStdDev :: Estimate ConfInt Double
    anOutlierVar :: OutlierVariance
    anRegress :: SampleAnalysis -> [Regression]
    anMean :: SampleAnalysis -> Estimate ConfInt Double
    anStdDev :: SampleAnalysis -> Estimate ConfInt Double
    anOutlierVar :: SampleAnalysis -> OutlierVariance
    ..} = SampleAnalysis
    reportAnalysis
              OutlierVariance{Double
    String
    OutlierEffect
    ovEffect :: OutlierEffect
    ovDesc :: String
    ovFraction :: Double
    ovEffect :: OutlierVariance -> OutlierEffect
    ovDesc :: OutlierVariance -> String
    ovFraction :: OutlierVariance -> Double
    ..} = 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
    regResponder :: Regression -> String
    regCoeffs :: Regression -> Map String (Estimate ConfInt Double)
    regRSquare :: Regression -> Estimate ConfInt Double
    ..} ->
            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
    regResponder :: Regression -> String
    regCoeffs :: Regression -> Map String (Estimate ConfInt Double)
    regRSquare :: Regression -> Estimate ConfInt Double
    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
            [(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 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
            () -> Criterion ()
    forall a. a -> Criterion a
    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 a. a -> Criterion a
    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
    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 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 a. IO a -> Criterion a
    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 a. a -> IO a
    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 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
    $ 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 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
    $ Handle -> String -> IO ()
    hPutStr Handle
    handle String
    ", "
        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
    $ Handle -> ByteString -> IO ()
    L.hPut Handle
    handle (Report -> ByteString
    forall a. ToJSON a => a -> ByteString
    Aeson.encode (Report
    rpt::Report))

      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
    $ Handle -> String -> IO ()
    hPutStr Handle
    handle String
    " ] ]\n"
      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
    $ Handle -> IO ()
    hClose Handle
    handle

      [Report]
    rpts <- IO [Report] -> Criterion [Report]
    forall a. IO a -> Criterion a
    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 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

      [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 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
    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 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
    $ 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) 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
            env
    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
              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 a. a -> IO a
    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 a. 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 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 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 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 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 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
    reportNumber :: Report -> Int
    reportName :: Report -> String
    reportKeys :: Report -> [String]
    reportMeasured :: Report -> Vector Measured
    reportAnalysis :: Report -> SampleAnalysis
    reportOutliers :: Report -> Outliers
    reportKDEs :: Report -> [KDE]
    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]